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