43 use element_mod , only :nixs,nixq,nixtg
44
45
46
47#include "implicit_f.inc"
48
49
50
51 INTEGER,INTENT(IN) :: MVSIZ,NUMELS,NUMELTG,NUMELQ,NUMNOD,NPARG,NGROUP,NSURF,N2D
52 INTEGER IDC,NBCONTY,ITAGNSOL(*),NSOLTOSF(NBCONTY,*),KNOD2SURF(*),NNOD2SURF,TAGN(*),IDSURF,NSEG,
53 . INOD2SURF(NNOD2SURF,*),SURF_TYPE,SURF_ELTYP(NSEG),
54 . SURF_NODES(NSEG,4),IAD_BUFR,SWIFTSURF(NSURF),NSEG_SWIFT_SURF,
55 . (*),IVOLSURF(NSURF),NSURF_INVOL
56 my_real x(3,numnod),dis(nsurf_invol,*),bufsf(*),nod_normal(3,numnod)
57 INTEGER, INTENT(IN) :: NSEG_USED
58 INTEGER, INTENT(IN) :: LEADING_DIMENSION
59 INTEGER, INTENT(IN) :: NB_BOX_LIMIT
60 INTEGER, INTENT(IN) :: NB_CELL_X,NB_CELL_Y,NB_CELL_Z
61 INTEGER, DIMENSION(NPARG,NGROUP), INTENT(IN) :: IPARG
62 INTEGER, DIMENSION(NIXS,NUMELS),INTENT(IN), TARGET :: IXS
63 INTEGER, DIMENSION(NIXQ,NUMELQ),INTENT(IN), TARGET :: IXQ
64 INTEGER, DIMENSION(NIXTG,NUMELTG),INTENT(IN), TARGET :: IXTG
65 INTEGER, DIMENSION(NUMNOD), INTENT(INOUT) :: NODAL_PHASE
66 INTEGER, DIMENSION(3,NUMNOD), INTENT(IN) :: CELL_POSITION
67 INTEGER, DIMENSION(NB_CELL_X,NB_CELL_Y,NB_CELL_Z), INTENT(INOUT) :: CELL
68
69
70
71 INTEGER I,J,K,N,INOD,OK,OK1,OK2,FIRST,LAST
72 INTEGER IPL,IXPL1,IXPL2,IXPL3,IXPL4,OK3,IAD0,IN(4),ITYP,JJ
73 INTEGER IPASSN(NUMNOD),p,r,p1,p2,dd1(4),dd2(4)
74 INTEGER NULL_DIST,IX2,SIZE_X2
75
76 my_real nx,ny,nz,xfas(3,4),dist,dist_old,x0,y0,z0,dot,nsign(3),
77 . sum,xp1,yp1,zp1,xp2,yp2,zp2,aa,bb,cc,
78 . dist_pl(3),vx_nod_inod,vy_nod_inod,vz_nod_inod,xsign(3),
79 . v1x,v1y,v1z,v2x,v2y,v2z,v3x,v3y,v3z,v12x,v12y,v12z,xn(3),
80 . tmp(3),skw(9),xg,yg,zg,dgr,x_prime,y_prime,z_prime
81 DATA dd1/4,1,2,3/,dd2/2,3,4,1/
82 INTEGER , DIMENSION(:), ALLOCATABLE :: ID_X2_TAGN,CLOSEST_NODE_ID
83
84 IF(surf_type == 200) GOTO 950
85 IF(surf_type == 101) GOTO 951
86
87 ix2 = 0
88 ALLOCATE( id_x2_tagn(numnod) )
89 id_x2_tagn = 0
90
91
92
93! surface segment whom surface belongs
94
95 swiftsurf(idsurf) = nseg_swift_surf
96
97 ipassn(1:numnod) = 0
98 first = 1
99 last =
min(nseg,mvsiz)
100
101 DO
102
103 DO j=first,last
104 ityp = surf_eltyp(j)
105 in(1) = surf_nodes(j,1)
106 in(2) = surf_nodes(j,2)
107 in(3) = surf_nodes(j,3)
108 in(4) = surf_nodes(j,4)
109
110 xfas(1,1) = x(1,in(1))
111 xfas(2,1) = x(2,in(1))
112 xfas(3,1) = x(3,in(1))
113 xfas(1,2) = x(1,in(2))
114 xfas(2,2) = x(2,in(2))
115 xfas(3,2) = x(3,in(2))
116 xfas(1,3) = x(1,in(3))
117 xfas(2,3) = x(2,in(3))
118 xfas(3,3) = x(3,in(3))
119 xfas(1,4) = x(1,in(4))
120 xfas(2,4) = x(2,in(4))
121 xfas(3,4) = x(3,in(4))
122
124
125
126 IF (tagn(in(1)) == 0) THEN
127 tagn(in(1)) = 1
128 ix2 = ix2 + 1
129 id_x2_tagn(ix2) = in(1)
130 ENDIF
131 IF (tagn(in(2)) == 0) THEN
132 tagn(in(2)) = 1
133 ix2 = ix2 + 1
134 id_x2_tagn(ix2) = in(2)
135 ENDIF
136 IF (tagn(in(3)) == 0) THEN
137 tagn(in(3)) = 1
138 ix2 = ix2 + 1
139 id_x2_tagn(ix2) = in(3)
140 ENDIF
141 IF(tagn(in(4)) == 0)THEN
142 tagn(in(4)) = 1
143 ix2 = ix2 + 1
144 id_x2_tagn(ix2) = in(4)
145 ENDIF
146
147
148 IF (ityp == 3) THEN
149 DO k=1,4
150 n = in(k)
151 knod2surf(n) = knod2surf(n) + 1
152 inod2surf(knod2surf(n),n) = j + nseg_swift_surf
153 segtosurf(j + nseg_swift_surf) = idsurf
154 ENDDO
155 ELSEIF (ityp == 7) THEN
156 DO k=1,3
157 n = in(k)
158 knod2surf(n) = knod2surf(n) + 1
159 inod2surf(knod2surf(n),n) = j + nseg_swift_surf
160 segtosurf(j + nseg_swift_surf) = idsurf
161 ENDDO
162 ENDIF
163
165
166 ENDDO
167
168 IF(last >= nseg)EXIT
169 first = last + 1
170 last =
min(last+mvsiz,nseg)
171
172 ENDDO
173
174
175 nseg_swift_surf = nseg_swift_surf + nseg
176
177
178
179 DO n=1,numnod
180 IF (tagn(n) == 1 .AND. ipassn(n) == 0) THEN
181 aa=one/
max(em30,sqrt(nod_normal(1,n)*nod_normal(1,n)+nod_normal(2,n)*nod_normal(2,n)+nod_normal(3,n)*nod_normal(3,n)))
182 nod_normal(1,n)=nod_normal(1,n)*aa
183 nod_normal(2,n)=nod_normal(2,n)*aa
184 nod_normal(3,n)=nod_normal(3,n)*aa
185 ipassn(n) = 1
186 ENDIF
187 ENDDO
188
189
190
191
192
193
194 size_x2 = ix2
195 ALLOCATE( closest_node_id(numnod) )
196 closest_node_id(1:numnod) = -1
197 CALL phase_detection(nparg,ngroup,numels,numelq,numeltg,numnod,nsurf,n2d,
198 . leading_dimension,nb_cell_x,nb_cell_y,nb_cell_z,nb_box_limit,
199 . iparg,ixs,ixq,ixtg,x,idsurf,
200 . cell,cell_position,nodal_phase,closest_node_id,
201 . nnod2surf,knod2surf,inod2surf,
202 . nod_normal,nseg_used,segtosurf,nseg,surf_eltyp,surf_nodes,swiftsurf)
203
204
205 DO n=1,numnod
206 dist = zero
207 IF(tagn(n) == 0) THEN
208 dist = nodal_phase(n)
209 nsoltosf(idc,n) = closest_node_id(n)
210 ENDIF
211 dis(ivolsurf(idsurf),n) = dist
212 ENDDO
213 DEALLOCATE( closest_node_id )
214
215
216
217
218 950 CONTINUE
219
220 IF(surf_type /= 200) GOTO 951
221
222 iad0 = iad_bufr
223 xp1 = bufsf(iad0+1)
224 yp1 = bufsf(iad0+2)
225 zp1 = bufsf(iad0+3)
226 xp2 = bufsf(iad0+4)
227 yp2 = bufsf(iad0+5)
228 zp2 = bufsf(iad0+6)
229 aa = xp2 - xp1
230 bb = yp2 - yp1
231 cc = zp2 - zp1
232 DO n=1,numnod
233 IF (itagnsol(n) /= 1) cycle
234 dist = zero
235 dist = aa*(x(1,n)-xp1)+bb*(x(2,n)-yp1)+cc*(x(3,n)-zp1)
236 sum = sqrt(aa*aa+bb*bb+cc*cc)
237 sum = one/
max(em30,sum)
238 dist = dist*sum
239 dis(ivolsurf(idsurf),n) = dist
240 ENDDO
241
242
243 951 CONTINUE
244
245 IF(surf_type /= 101) GOTO 960
246
247 iad0 = iad_bufr
248 aa = bufsf(iad0+1)
249 bb = bufsf(iad0+2)
250 cc = bufsf(iad0+3)
251 xg = bufsf(iad0+4)
252 yg = bufsf(iad0+5)
253 zg = bufsf(iad0+6)
254 skw(1)=bufsf(iad0+7)
255 skw(2)=bufsf(iad0+8)
256 skw(3)=bufsf(iad0+9)
257 skw(4)=bufsf(iad0+10)
258 skw(5)=bufsf(iad0+11)
259 skw(6)=bufsf(iad0+12)
260 skw(7)=bufsf(iad0+13)
261 skw(8)=bufsf(iad0+14)
262 skw(9)=bufsf(iad0+15)
263 dgr=bufsf(iad0+36)
264 DO n=1,numnod
265 IF (itagnsol(n) /= 1) cycle
266 dist=zero
267
268 x_prime = skw(1)*(x(1,n)-xg) + skw(4)*(x(2,n)-yg) + skw(7)*(x(3,n)-zg)
269 y_prime = skw(2)*(x(1,n)-xg) + skw(5)*(x(2,n)-yg) + skw(8)*(x(3,n)-zg)
270 z_prime = skw(3)*(x(1,n)-xg) + skw(6)*(x(2,n)-yg) + skw(9)*(x(3,n)-zg)
271 tmp(1)= abs(x_prime)/aa
272 tmp(2)= abs(y_prime)/bb
273 tmp(3)= abs(z_prime)/cc
274 IF(tmp(1)/=zero)tmp(1)= exp(dgr*log(tmp(1)))
275 IF(tmp(2)/=zero)tmp(2)= exp(dgr*log(tmp(2)))
276 IF(tmp(3)/=zero)tmp(3)= exp(dgr*log(tmp(3)))
277 dist = (tmp(1)+tmp(2)+tmp(3))
278 dis(ivolsurf(idsurf),n) = one-dist
279 ENDDO
280
281 960 CONTINUE
282
283 IF (ALLOCATED (id_x2_tagn) ) DEALLOCATE (id_x2_tagn)
284
285 RETURN
subroutine mean_node_norm2(in, nod_normal, nx, ny, nz)
subroutine nfacette(xfas, nx, ny, nz)
subroutine phase_detection(nparg, ngroup, numels, numelq, numeltg, numnod, nsurf, n2d, leading_dimension, nb_cell_x, nb_cell_y, nb_cell_z, nb_box_limit, iparg, ixs, ixq, ixtg, x, id_surface, cell, cell_position, nodal_phase, closest_node_id, nnod2surf, knod2surf, inod2surf, nod_normal, nseg_used, segtosurf, nseg, surf_eltyp, surface_nodes, swiftsurf)