35
36
37
38 use element_mod , only : nixs,nixq,nixc,nixp,nixtg
39
40
41
42#include "implicit_f.inc"
43#include "comlock.inc"
44
45
46
47#include "com01_c.inc"
48#include "com04_c.inc"
49#include "scr14_c.inc"
50#include "scr16_c.inc"
51#include "tabsiz_c.inc"
52
53
54
55 INTEGER , INTENT(IN) ::
56 . IXS(NIXS,NUMELS) , IXC(NIXC,NUMELC) , IXTG(NIXTG,NUMELTG), FASOLFR(2,NFASOLFR),
57 . IAD_ELEM(2,NSPMD+1), FR_ELEM(SFR_ELEM), WEIGHT(*) ,IXQ(NIXQ,NUMELQ),(2,NSEGQUADFR),
58 . IXS10(6,)
60 . x(3,numnod)
61 my_real,
INTENT(INOUT) :: intarean(numnod)
62
63
64
65 INTEGER N1, N2, N3, N4, NN1, NN2, NN3, J, I, , IFAC, ILINE,
66 . LENR
69 . x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4,
70 . x31,y31,z31,x42,y42,z42,x32,y32,z32,e3x,e3y,e3z
71 INTEGER FACES(4,6),LINES(2,4),FACES10(3,24)
72
73 DATA faces/1,2,3,4,
74 . 2,1,5,6,
75 . 1,5,8,4,
76 . 5,6,7,8,
77 . 3,4,8,7,
78 . 2,6,7,3/
79 DATA lines/1,2,
80 . 2,3,
81 . 3,4,
82 . 4,1/
83 DATA faces10/0,0,0,
84 . 0,0,0,
85 . 0,0,0,
86 . 0,0,0,
87 . 1,13,14,
88 . 5,14,16,
89 . 6,13,16,
90 . 13,14,16,
91 . 1,11,13,
92 . 3,11,15,
93 . 5,14,15,
94 . 11,14,15,
95 . 0,0,0,
96 . 0,0,0,
97 . 0,0,0,
98 . 0,0,0,
99 . 3,12,15,
100 . 5,15,16,
101 . 6,12,16,
102 . 12,15,16,
103 . 1,11,13,
104 . 3,11,12,
105 . 6,12,13,
106 . 11,12,13/
107
108
109 DO n=1,numnod
110 intarean(n)=zero
111 END DO
112
113 DO i=1,nfasolfr
114 n =fasolfr(1,i)
115 ifac=fasolfr(2,i)
116
117 IF( n <= numels8 ) THEN
118
119 n1=ixs(faces(1,ifac)+1,n)
120 n2=ixs(faces(2,ifac)+1,n)
121 n3=ixs(faces(3,ifac)+1,n)
122 n4=ixs(faces(4,ifac)+1,n)
123 x1=x(1,n1)
124 y1=x(2,n1)
125 z1=x(3,n1)
126 x2=x(1,n2)
127 y2=x(2,n2)
128 z2=x(3,n2)
129 x3=x(1,n3)
130 y3=x(2,n3)
131 z3=x(3,n3)
132 x4=x(1,n4)
133 y4=x(2,n4)
134 z4=x(3,n4)
135
136 x31=x3-x1
137 y31=y3-y1
138 z31=z3-z1
139 x42=x4-x2
140 y42=y4-y2
141 z42=z4-z2
142
143 e3x=y31*z42-z31*y42
144 e3y=z31*x42-x31*z42
145 e3z=x31*y42-y31*x42
146
147 IF( n4/=n3
148 . .AND.n3/=n2
149 . .AND.n2/=n1
150 . .AND.n1/=n4)THEN
151 area=one_over_8*sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
152 intarean(n1)=intarean(n1)+
area
153 intarean(n2)=intarean(n2)+
area
154 intarean(n3)=intarean(n3)+
area
155 intarean(n4)=intarean(n4)+
area
156 ELSE
157 area=one_over_6*sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
158 IF(n4==n3)THEN
159 IF(n2/=n1) THEN
160 intarean(n1)=intarean(n1)+
area
161 intarean(n2)=intarean(n2)+
area
162 intarean(n3)=intarean(n3)+
area
163 ENDIF
164 ELSEIF(n3==n2)THEN
165 IF(n4/=n1) THEN
166 intarean(n1)=intarean(n1)+
area
167 intarean(n2)=intarean(n2)+
area
168 intarean(n4)=intarean(n4)+
area
169 ENDIF
170 ELSEIF(n2==n1)THEN
171 IF(n4/=n3) THEN
172 intarean(n2)=intarean(n2)+
area
173 intarean(n3)=intarean(n3)+
area
174 intarean(n4)=intarean(n4)+
area
175 ENDIF
176 ELSEIF(n1==n4)THEN
177 IF(n2/=n3) THEN
178 intarean(n2)=intarean(n2)+
area
179 intarean(n3)=intarean(n3)+
area
180 intarean(n4)=intarean(n4)+
area
181 ENDIF
182 END IF
183 END IF
184
185 ELSEIF( n <= numels8+numels10 ) THEN
186
187
188 DO j=1,4
189 nn1=faces10(1,4*(ifac-1)+j)
190 nn2=faces10(2,4*(ifac-1)+j)
191 nn3=faces10(3,4*(ifac-1)+j)
192
193 IF(nn1 > 0 ) THEN
194 IF(nn1 >0.AND.nn1 < 10) THEN
195 n1=ixs(nn1+1,n)
196 ELSE
197 n1=ixs10(nn1-10,n-numels8)
198 ENDIF
199 ENDIF
200
201 IF(nn2 > 0 ) THEN
202 IF(nn2 < 10) THEN
203 n2=ixs(nn2+1,n)
204 ELSE
205 n2=ixs10(nn2-10,n-numels8)
206 ENDIF
207 ENDIF
208
209 IF(nn3 > 0 ) THEN
210 IF(nn3 < 10) THEN
211 n3=ixs(nn3+1,n)
212 ELSE
213 n3=ixs10(nn3-10,n-numels8)
214 ENDIF
215 ENDIF
216
217
218 IF(nn1 > 0 .AND. nn2 > 0 .AND.nn3 > 0) THEN
219 x1=x(1,n1)
220 y1=x(2,n1)
221 z1=x(3,n1)
222 x2=x(1,n2)
223 y2=x(2,n2)
224 z2=x(3,n2)
225 x3=x(1,n3)
226 y3=x(2,n3)
227 z3=x(3,n3)
228
229 x31=x3-x1
230 y31=y3-y1
231 z31=z3-z1
232 x32=x3-x2
233 y32=y3-y2
234 z32=z3-z2
235
236 e3x=y31*z32-z31*y32
237 e3y=z31*x32-x31*z32
238 e3z=x31*y32-y31*x32
239
240 area=one_over_6*sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
241
242 intarean(n1)=intarean(n1)+
area
243 intarean(n2)=intarean(n2)+
area
244 intarean(n3)=intarean(n3)+
area
245 ENDIF
246 ENDDO
247 ENDIF
248 END DO
249
250 DO n=1,numelc
251 n1=ixc(2,n)
252 n2=ixc(3,n)
253 n3=ixc(4,n)
254 n4=ixc(5,n)
255 IF(n4/=n3)THEN
256 x1=x(1,n1)
257 y1=x(2,n1)
258 z1=x(3,n1)
259 x2=x(1,n2)
260 y2=x(2,n2)
261 z2=x(3,n2)
262 x3=x(1,n3)
263 y3=x(2,n3)
264 z3=x(3,n3)
265 x4=x(1,n4)
266 y4=x(2,n4)
267 z4=x(3,n4)
268
269 x31=x3-x1
270 y31=y3-y1
271 z31=z3-z1
272 x42=x4-x2
273 y42=y4-y2
274 z42=z4-z2
275
276 e3x=y31*z42-z31*y42
277 e3y=z31*x42-x31*z42
278 e3z=x31*y42-y31*x42
279
280 area=one_over_8*sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
281 intarean(n1)=intarean(n1)+
area
282 intarean(n2)=intarean(n2)+
area
283 intarean(n3)=intarean(n3)+
area
284 intarean(n4)=intarean(n4)+
area
285
286 ELSE
287 x1=x(1,n1)
288 y1=x(2,n1)
289 z1=x(3,n1)
290 x2=x(1,n2)
291 y2=x(2,n2)
292 z2=x(3,n2)
293 x3=x(1,n3)
294 y3=x(2,n3)
295 z3=x(3,n3)
296 x31=x3-x1
297 y31=y3-y1
298 z31=z3-z1
299 x32=x3-x2
300 y32=y3-y2
301 z32=z3-z2
302
303 e3x=y31*z32-z31*y32
304 e3y=z31*x32-x31*z32
305 e3z=x31*y32-y31*x32
306
307 area=one_over_6*sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
308 intarean(n1)=intarean(n1)+
area
309 intarean(n2)=intarean(n2)+
area
310 intarean(n3)=intarean(n3)+
area
311 END IF
312 END DO
313
314 DO n=1,numeltg
315 n1=ixtg(2,n)
316 n2=ixtg(3,n)
317 n3=ixtg(4,n)
318 x1=x(1,n1)
319 y1=x(2,n1)
320 z1=x(3,n1)
321 x2=x(1,n2)
322 y2=x(2,n2)
323 z2=x(3,n2)
324 x3=x(1,n3)
325 y3=x(2,n3)
326 z3=x(3,n3)
327 x31=x3-x1
328 y31=y3-y1
329 z31=z3-z1
330 x32=x3-x2
331 y32=y3-y2
332 z32=z3-z2
333
334 e3x=y31*z32-z31*y32
335 e3y=z31*x32-x31*z32
336 e3z=x31*y32-y31*x32
337
338 area=one_over_6*sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
339 intarean(n1)=intarean(n1)+
area
340 intarean(n2)=intarean(n2)+
area
341 intarean(n3)=intarean(n3)+
area
342 END DO
343
344 DO i=1,nsegquadfr
345 n =segquadfr(1,i)
346 iline=segquadfr(2,i)
347
348 n1=ixq(lines(1,iline)+1,n)
349 n2=ixq(lines(2,iline)+1,n)
350
351 y1=x(2,n1)
352 z1=x(3,n1)
353 y2=x(2,n2)
354 z2=x(3,n2)
355
356 area = sqrt((y2-y1)*(y2-y1)+(z2-z1)*(z2-z1))
358
359
360 intarean(n1)=intarean(n1)+
area
361 intarean(n2)=intarean(n2)+
area
362
363 ENDDO
364
365 IF(nspmd > 1)THEN
366 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
368 END IF
369
370 RETURN
subroutine area(d1, x, x2, y, y2, eint, stif0)
subroutine spmd_exch_nodarea(nodarea, iad_elem, fr_elem, lenr, weight)