OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ani_pcont.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "spmd_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine ani_pcont (ixs, ixc, ixtg, fasolfr, x, contn, contt, iad_elem, fr_elem, weight, ixq, segquadfr, ixs10, fncontp2, ftcontp2, h3d_data, csefric, csefricg, sz_npcont2, npcont2)
subroutine ani_pcont21 (ixs, ixc, ixtg, fasolfr, x, contn, contt, iad_elem, fr_elem, weight, nodglob, fncontg, ftcontg, fncontp2, ftcontp2, h3d_data, csefric_stamp, csefricg_stamp, sz_npcont2, npcont2)

Function/Subroutine Documentation

◆ ani_pcont()

subroutine ani_pcont ( integer, dimension(nixs,*) ixs,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer, dimension(2,*) fasolfr,
x,
contn,
contt,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) weight,
integer, dimension(7,*) ixq,
integer, dimension(2,*) segquadfr,
integer, dimension(6,*) ixs10,
fncontp2,
ftcontp2,
type (h3d_database) h3d_data,
dimension(ninefric,s_efricint), intent(inout) csefric,
dimension(s_efric), intent(inout) csefricg,
integer, intent(in) sz_npcont2,
dimension(3,sz_npcont2), intent(in) npcont2 )

Definition at line 33 of file ani_pcont.F.

37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE h3d_mod
41 USE outputs_mod
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46#include "comlock.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "com01_c.inc"
51#include "com04_c.inc"
52#include "scr14_c.inc"
53#include "scr16_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57C REAL
58 INTEGER
59 . IXS(NIXS,*), IXC(NIXC,*), IXTG(NIXTG,*), FASOLFR(2,*),
60 . IAD_ELEM(2,*), FR_ELEM(*), WEIGHT(*),IXQ(7,*),SEGQUADFR(2,*),
61 . IXS10(6,*)
62 INTEGER , INTENT(IN) :: SZ_NPCONT2
63 my_real
64 . x(3,*), contn(3,*), contt(3,*),fncontp2(3,*),ftcontp2(3,*)
65 my_real , INTENT(INOUT) :: csefric(ninefric,s_efricint),csefricg(s_efric)
66 my_real , INTENT(IN) :: npcont2(3,sz_npcont2)
67 TYPE (H3D_DATABASE) :: H3D_DATA
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER N1,N2,N3,N4,NN1,NN2,NN3,J,
72 . I,N,IFAC,ILINE,
73 . IERROR, LENR, NI,NNOUT
74 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAGN
75 my_real
76 . area,
77 . x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4,
78 . x31,y31,z31,x42,y42,z42,x32,y32,z32,e3x,e3y,e3z,
79 . fs2, fs3, ft2, ft3, e, f, g, rayon,ay1,ay2,ay3,ay4,
80 . areainv,normal(3),nnn,f_total(1:3),fn_proj
81 INTEGER FACES(4,6),LINES(2,4),FACES10(3,24)
82 my_real, DIMENSION(:), ALLOCATABLE :: nodarea
83 my_real, DIMENSION(:,:), ALLOCATABLE :: norm_n
84C REAL
85 DATA faces/1,2,3,4,
86 . 2,1,5,6,
87 . 1,5,8,4,
88 . 5,6,7,8,
89 . 3,4,8,7,
90 . 2,6,7,3/
91 DATA lines/1,2,
92 . 2,3,
93 . 3,4,
94 . 4,1/
95 DATA faces10/0,0,0,
96 . 0,0,0,
97 . 0,0,0,
98 . 0,0,0,
99 . 1,13,14,
100 . 5,14,16,
101 . 6,13,16,
102 . 13,14,16,
103 . 1,11,13,
104 . 3,11,15,
105 . 5,14,15,
106 . 11,14,15,
107 . 0,0,0,
108 . 0,0,0,
109 . 0,0,0,
110 . 0,0,0,
111 . 3,12,15,
112 . 5,15,16,
113 . 6,12,16,
114 . 12,15,16,
115 . 1,11,13,
116 . 3,11,12,
117 . 6,12,13,
118 . 11,12,13/
119C-----------------------------------------------
120C
121 ALLOCATE(nodarea(numnod))
122 DO n=1,numnod
123 nodarea(n)=zero
124 END DO
125C
126! do normal dependent only for CONTN(1:3)>0
127 IF(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT /=0) THEN
128 nnout = 0
129 DO n=1,numnod
130 normal(1:3) = contn(1:3,n)
131 nnn = normal(1)**2+normal(2)**2+normal(3)**2
132 IF(nnn > em14) nnout = nnout + 1
133 END DO
134 IF(nnout >0) THEN
135 ALLOCATE(itagn(numnod))
136 ALLOCATE(norm_n(3,nnout))
137 itagn = 0
138 ni = 0
139 DO n=1,numnod
140 normal(1:3) = contn(1:3,n)
141 nnn = normal(1)**2+normal(2)**2+normal(3)**2
142 IF(nnn > em14) THEN
143 nnn = one/sqrt(nnn)
144 normal(1:3) = normal(1:3)*nnn
145 ni = ni + 1
146 itagn(n) = ni
147 norm_n(1:3,ni) = normal(1:3)
148 END IF
149 END DO
150 DO i=1,nfasolfr
151 n =fasolfr(1,i)
152 ifac=fasolfr(2,i)
153C
154 IF( n <= numels8 ) THEN
155
156 n1=ixs(faces(1,ifac)+1,n)
157 n2=ixs(faces(2,ifac)+1,n)
158 n3=ixs(faces(3,ifac)+1,n)
159 n4=ixs(faces(4,ifac)+1,n)
160 IF((itagn(n1)+itagn(n2)+itagn(n3)+itagn(n4))==0 ) cycle
161 x1=x(1,n1)
162 y1=x(2,n1)
163 z1=x(3,n1)
164 x2=x(1,n2)
165 y2=x(2,n2)
166 z2=x(3,n2)
167 x3=x(1,n3)
168 y3=x(2,n3)
169 z3=x(3,n3)
170 x4=x(1,n4)
171 y4=x(2,n4)
172 z4=x(3,n4)
173C
174 x31=x3-x1
175 y31=y3-y1
176 z31=z3-z1
177 x42=x4-x2
178 y42=y4-y2
179 z42=z4-z2
180C
181 e3x=y31*z42-z31*y42
182 e3y=z31*x42-x31*z42
183 e3z=x31*y42-y31*x42
184C
185 IF( n4/=n3
186 . .AND.n3/=n2
187 . .AND.n2/=n1
188 . .AND.n1/=n4)THEN
189 e3x=one_over_8*e3x
190 e3y=one_over_8*e3y
191 e3z=one_over_8*e3z
192! AREA=SQRT(E3X*E3X+E3Y*E3Y+E3Z*E3Z)
193 ni= itagn(n1)
194 IF (ni > 0 ) THEN
195 normal(1:3)= norm_n(1:3,ni)
196 nodarea(n1)=nodarea(n1)+normal(1)*e3x+normal(2)*e3y+normal(3)*e3z
197 ENDIF
198 ni= itagn(n2)
199 IF (ni > 0 ) THEN
200 normal(1:3)= norm_n(1:3,ni)
201 nodarea(n2)=nodarea(n2)+normal(1)*e3x+normal(2)*e3y+normal(3)*e3z
202 ENDIF
203 ni= itagn(n3)
204 IF (ni > 0 ) THEN
205 normal(1:3)= norm_n(1:3,ni)
206 nodarea(n3)=nodarea(n3)+normal(1)*e3x+normal(2)*e3y+normal(3)*e3z
207 ENDIF
208 ni= itagn(n4)
209 IF (ni > 0 ) THEN
210 normal(1:3)= norm_n(1:3,ni)
211 nodarea(n4)=nodarea(n4)+normal(1)*e3x+normal(2)*e3y+normal(3)*e3z
212 ENDIF
213 ELSE
214 e3x=one_over_6*e3x
215 e3y=one_over_6*e3y
216 e3z=one_over_6*e3z
217! AREA=SQRT(E3X*E3X+E3Y*E3Y+E3Z*E3Z)
218 ni= itagn(n1)
219 IF (ni > 0 ) THEN
220 normal(1:3)= norm_n(1:3,ni)
221 nodarea(n1)=nodarea(n1)+normal(1)*e3x+normal(2)*e3y+normal(3)*e3z
222 ENDIF
223 IF (n2 /= n1 ) THEN
224 ni= itagn(n2)
225 IF (ni > 0 ) THEN
226 normal(1:3)= norm_n(1:3,ni)
227 nodarea(n2)=nodarea(n2)+normal(1)*e3x+normal(2)*e3y+normal(3)*e3z
228 ENDIF
229 ENDIF
230 IF (n3 /= n2 .AND. n3 /= n1 ) THEN
231 ni= itagn(n3)
232 IF (ni > 0 ) THEN
233 normal(1:3)= norm_n(1:3,ni)
234 nodarea(n3)=nodarea(n3)+normal(1)*e3x+normal(2)*e3y+normal(3)*e3z
235 ENDIF
236 ENDIF
237 IF (n4 /= n3 .AND. n4 /= n2 .AND. n4 /= n1 ) THEN
238 ni= itagn(n4)
239 IF (ni > 0 ) THEN
240 normal(1:3)= norm_n(1:3,ni)
241 nodarea(n4)=nodarea(n4)+normal(1)*e3x+normal(2)*e3y+normal(3)*e3z
242 ENDIF
243 ENDIF
244 END IF
245!
246 ELSEIF( n <= numels8+numels10 ) THEN
247!
248 n1=0
249 n2=0
250 n3=0
251
252
253 DO j=1,4
254 nn1=faces10(1,4*(ifac-1)+j)
255 nn2=faces10(2,4*(ifac-1)+j)
256 nn3=faces10(3,4*(ifac-1)+j)
257
258 IF(nn1 > 0 ) THEN
259 IF(nn1 >0.AND.nn1 < 10) THEN
260 n1=ixs(nn1+1,n)
261 ELSE
262 n1=ixs10(nn1-10,n-numels8)
263 ENDIF
264 ENDIF
265
266 IF(nn2 > 0 ) THEN
267 IF(nn2 < 10) THEN
268 n2=ixs(nn2+1,n)
269 ELSE
270 n2=ixs10(nn2-10,n-numels8)
271 ENDIF
272 ENDIF
273
274 IF(nn3 > 0 ) THEN
275 IF(nn3 < 10) THEN
276 n3=ixs(nn3+1,n)
277 ELSE
278 n3=ixs10(nn3-10,n-numels8)
279 ENDIF
280 ENDIF
281
282
283 IF(n1 > 0 .AND. n2 > 0 .AND.n3 > 0) THEN
284 IF((itagn(n1)+itagn(n2)+itagn(n3))==0 ) cycle
285 x1=x(1,n1)
286 y1=x(2,n1)
287 z1=x(3,n1)
288 x2=x(1,n2)
289 y2=x(2,n2)
290 z2=x(3,n2)
291 x3=x(1,n3)
292 y3=x(2,n3)
293 z3=x(3,n3)
294C
295 x31=x3-x1
296 y31=y3-y1
297 z31=z3-z1
298 x32=x3-x2
299 y32=y3-y2
300 z32=z3-z2
301C
302 e3x=y31*z32-z31*y32
303 e3y=z31*x32-x31*z32
304 e3z=x31*y32-y31*x32
305C
306 e3x=one_over_6*e3x
307 e3y=one_over_6*e3y
308 e3z=one_over_6*e3z
309! AREA=SQRT(E3X*E3X+E3Y*E3Y+E3Z*E3Z)
310 ni= itagn(n1)
311 IF (ni > 0 ) THEN
312 normal(1:3)= norm_n(1:3,ni)
313 nodarea(n1)=nodarea(n1)+normal(1)*e3x+normal(2)*e3y+normal(3)*e3z
314 ENDIF
315 ni= itagn(n2)
316 IF (ni > 0 ) THEN
317 normal(1:3)= norm_n(1:3,ni)
318 nodarea(n2)=nodarea(n2)+normal(1)*e3x+normal(2)*e3y+normal(3)*e3z
319 ENDIF
320 ni= itagn(n3)
321 IF (ni > 0 ) THEN
322 normal(1:3)= norm_n(1:3,ni)
323 nodarea(n3)=nodarea(n3)+normal(1)*e3x+normal(2)*e3y+normal(3)*e3z
324 ENDIF
325 ENDIF
326 ENDDO
327 ENDIF
328 END DO
329C
330 DO n=1,numelc
331 n1=ixc(2,n)
332 n2=ixc(3,n)
333 n3=ixc(4,n)
334 n4=ixc(5,n)
335 IF((itagn(n1)+itagn(n2)+itagn(n3)+itagn(n4))==0 ) cycle
336 IF(n4/=n3)THEN
337 x1=x(1,n1)
338 y1=x(2,n1)
339 z1=x(3,n1)
340 x2=x(1,n2)
341 y2=x(2,n2)
342 z2=x(3,n2)
343 x3=x(1,n3)
344 y3=x(2,n3)
345 z3=x(3,n3)
346 x4=x(1,n4)
347 y4=x(2,n4)
348 z4=x(3,n4)
349C
350 x31=x3-x1
351 y31=y3-y1
352 z31=z3-z1
353 x42=x4-x2
354 y42=y4-y2
355 z42=z4-z2
356C
357 e3x=y31*z42-z31*y42
358 e3y=z31*x42-x31*z42
359 e3z=x31*y42-y31*x42
360C
361 e3x=one_over_8*e3x
362 e3y=one_over_8*e3y
363 e3z=one_over_8*e3z
364C
365! AREA=SQRT(E3X*E3X+E3Y*E3Y+E3Z*E3Z)
366 IF (ni > 0 ) THEN
367 normal(1:3)= norm_n(1:3,ni)
368 nodarea(n1)=nodarea(n1)+normal(1)*e3x+normal(2)*e3y+normal(3)*e3z
369 ENDIF
370 ni= itagn(n2)
371 IF (ni > 0 ) THEN
372 normal(1:3)= norm_n(1:3,ni)
373 nodarea(n2)=nodarea(n2)+normal(1)*e3x+normal(2)*e3y+normal(3)*e3z
374 ENDIF
375 ni= itagn(n3)
376 IF (ni > 0 ) THEN
377 normal(1:3)= norm_n(1:3,ni)
378 nodarea(n3)=nodarea(n3)+normal(1)*e3x+normal(2)*e3y+normal(3)*e3z
379 ENDIF
380 ni= itagn(n4)
381 IF (ni > 0 ) THEN
382 normal(1:3)= norm_n(1:3,ni)
383 nodarea(n4)=nodarea(n4)+normal(1)*e3x+normal(2)*e3y+normal(3)*e3z
384 ENDIF
385C
386 ELSE
387 x1=x(1,n1)
388 y1=x(2,n1)
389 z1=x(3,n1)
390 x2=x(1,n2)
391 y2=x(2,n2)
392 z2=x(3,n2)
393 x3=x(1,n3)
394 y3=x(2,n3)
395 z3=x(3,n3)
396 x31=x3-x1
397 y31=y3-y1
398 z31=z3-z1
399 x32=x3-x2
400 y32=y3-y2
401 z32=z3-z2
402C
403 e3x=y31*z32-z31*y32
404 e3y=z31*x32-x31*z32
405 e3z=x31*y32-y31*x32
406 e3x=one_over_6*e3x
407 e3y=one_over_6*e3y
408 e3z=one_over_6*e3z
409C
410! AREA=SQRT(E3X*E3X+E3Y*E3Y+E3Z*E3Z)
411 IF (ni > 0 ) THEN
412 normal(1:3)= norm_n(1:3,ni)
413 nodarea(n1)=nodarea(n1)+normal(1)*e3x+normal(2)*e3y+normal(3)*e3z
414 ENDIF
415 ni= itagn(n2)
416 IF (ni > 0 ) THEN
417 normal(1:3)= norm_n(1:3,ni)
418 nodarea(n2)=nodarea(n2)+normal(1)*e3x+normal(2)*e3y+normal(3)*e3z
419 ENDIF
420 ni= itagn(n3)
421 IF (ni > 0 ) THEN
422 normal(1:3)= norm_n(1:3,ni)
423 nodarea(n3)=nodarea(n3)+normal(1)*e3x+normal(2)*e3y+normal(3)*e3z
424 ENDIF
425 END IF
426 END DO
427C
428 DO n=1,numeltg
429 n1=ixtg(2,n)
430 n2=ixtg(3,n)
431 n3=ixtg(4,n)
432 x1=x(1,n1)
433 y1=x(2,n1)
434 z1=x(3,n1)
435 x2=x(1,n2)
436 y2=x(2,n2)
437 z2=x(3,n2)
438 x3=x(1,n3)
439 y3=x(2,n3)
440 z3=x(3,n3)
441 x31=x3-x1
442 y31=y3-y1
443 z31=z3-z1
444 x32=x3-x2
445 y32=y3-y2
446 z32=z3-z2
447C
448 e3x=y31*z32-z31*y32
449 e3y=z31*x32-x31*z32
450 e3z=x31*y32-y31*x32
451 e3x=one_over_6*e3x
452 e3y=one_over_6*e3y
453 e3z=one_over_6*e3z
454C
455! AREA=SQRT(E3X*E3X+E3Y*E3Y+E3Z*E3Z)
456 IF (ni > 0 ) THEN
457 normal(1:3)= norm_n(1:3,ni)
458 nodarea(n1)=nodarea(n1)+normal(1)*e3x+normal(2)*e3y+normal(3)*e3z
459 ENDIF
460 ni= itagn(n2)
461 IF (ni > 0 ) THEN
462 normal(1:3)= norm_n(1:3,ni)
463 nodarea(n2)=nodarea(n2)+normal(1)*e3x+normal(2)*e3y+normal(3)*e3z
464 ENDIF
465 ni= itagn(n3)
466 IF (ni > 0 ) THEN
467 normal(1:3)= norm_n(1:3,ni)
468 nodarea(n3)=nodarea(n3)+normal(1)*e3x+normal(2)*e3y+normal(3)*e3z
469 ENDIF
470 END DO
471C
472 DO i=1,nsegquadfr
473 n =segquadfr(1,i)
474 iline=segquadfr(2,i)
475
476 n1=ixq(lines(1,iline)+1,n)
477 n2=ixq(lines(2,iline)+1,n)
478
479 y1=x(2,n1)
480 z1=x(3,n1)
481 y2=x(2,n2)
482 z2=x(3,n2)
483
484 area = sqrt((y2-y1)*(y2-y1)+(z2-z1)*(z2-z1))
485 area = area*half
486
487
488 nodarea(n1)=nodarea(n1)+area
489 nodarea(n2)=nodarea(n2)+area
490
491 ENDDO
492 END IF !(NNOUT >0) THEN
493!
494 IF(nspmd > 1)THEN
495 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
496 CALL spmd_exch_nodarea(nodarea,iad_elem,fr_elem,lenr,weight)
497 END IF
498C
499 DO n=1,numnod
500 IF (nodarea(n) <= em20) THEN
501 contn(1,n)=zero
502 contn(2,n)=zero
503 contn(3,n)=zero
504 contt(1,n)=zero
505 contt(2,n)=zero
506 contt(3,n)=zero
507 ELSE
508 areainv = one/max(em20,nodarea(n))
509 contn(1,n)=areainv*contn(1,n)
510 contn(2,n)=areainv*contn(2,n)
511 contn(3,n)=areainv*contn(3,n)
512 contt(1,n)=areainv*contt(1,n)
513 contt(2,n)=areainv*contt(2,n)
514 contt(3,n)=areainv*contt(3,n)
515 ENDIF
516 END DO
517 IF (nnout >0) THEN
518 DEALLOCATE(itagn)
519 DEALLOCATE(norm_n)
520 nodarea(1:numnod)=zero
521 END IF !(NNOUT >0) THEN
522 ENDIF
523!
524 DO i=1,nfasolfr
525 n =fasolfr(1,i)
526 ifac=fasolfr(2,i)
527C
528 IF( n <= numels8 ) THEN
529
530 n1=ixs(faces(1,ifac)+1,n)
531 n2=ixs(faces(2,ifac)+1,n)
532 n3=ixs(faces(3,ifac)+1,n)
533 n4=ixs(faces(4,ifac)+1,n)
534 x1=x(1,n1)
535 y1=x(2,n1)
536 z1=x(3,n1)
537 x2=x(1,n2)
538 y2=x(2,n2)
539 z2=x(3,n2)
540 x3=x(1,n3)
541 y3=x(2,n3)
542 z3=x(3,n3)
543 x4=x(1,n4)
544 y4=x(2,n4)
545 z4=x(3,n4)
546C
547 x31=x3-x1
548 y31=y3-y1
549 z31=z3-z1
550 x42=x4-x2
551 y42=y4-y2
552 z42=z4-z2
553C
554 e3x=y31*z42-z31*y42
555 e3y=z31*x42-x31*z42
556 e3z=x31*y42-y31*x42
557C
558 IF( n4/=n3
559 . .AND.n3/=n2
560 . .AND.n2/=n1
561 . .AND.n1/=n4)THEN
562 e3x=one_over_8*e3x
563 e3y=one_over_8*e3y
564 e3z=one_over_8*e3z
565 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
566 nodarea(n1)=nodarea(n1)+area
567 nodarea(n2)=nodarea(n2)+area
568 nodarea(n3)=nodarea(n3)+area
569 nodarea(n4)=nodarea(n4)+area
570 ELSE
571 e3x=one_over_6*e3x
572 e3y=one_over_6*e3y
573 e3z=one_over_6*e3z
574 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
575 IF(n4==n3)THEN
576 IF(n2/=n1) THEN
577 nodarea(n1)=nodarea(n1)+area
578 nodarea(n2)=nodarea(n2)+area
579 nodarea(n3)=nodarea(n3)+area
580 ENDIF
581 ELSEIF(n3==n2)THEN
582 IF(n4/=n1) THEN
583 nodarea(n1)=nodarea(n1)+area
584 nodarea(n2)=nodarea(n2)+area
585 nodarea(n4)=nodarea(n4)+area
586 ENDIF
587 ELSEIF(n2==n1)THEN
588 IF(n4/=n3) THEN
589 nodarea(n2)=nodarea(n2)+area
590 nodarea(n3)=nodarea(n3)+area
591 nodarea(n4)=nodarea(n4)+area
592 ENDIF
593 ELSEIF(n1==n4)THEN
594 IF(n2/=n3) THEN
595 nodarea(n2)=nodarea(n2)+area
596 nodarea(n3)=nodarea(n3)+area
597 nodarea(n4)=nodarea(n4)+area
598 ENDIF
599 END IF
600 END IF
601
602 ELSEIF( n <= numels8+numels10 ) THEN
603
604C SubFac1
605 DO j=1,4
606 nn1=faces10(1,4*(ifac-1)+j)
607 nn2=faces10(2,4*(ifac-1)+j)
608 nn3=faces10(3,4*(ifac-1)+j)
609
610 IF(nn1 > 0 ) THEN
611 IF(nn1 >0.AND.nn1 < 10) THEN
612 n1=ixs(nn1+1,n)
613 ELSE
614 n1=ixs10(nn1-10,n-numels8)
615 ENDIF
616 ENDIF
617
618 IF(nn2 > 0 ) THEN
619 IF(nn2 < 10) THEN
620 n2=ixs(nn2+1,n)
621 ELSE
622 n2=ixs10(nn2-10,n-numels8)
623 ENDIF
624 ENDIF
625
626 IF(nn3 > 0 ) THEN
627 IF(nn3 < 10) THEN
628 n3=ixs(nn3+1,n)
629 ELSE
630 n3=ixs10(nn3-10,n-numels8)
631 ENDIF
632 ENDIF
633
634
635 IF(nn1 > 0 .AND. nn2 > 0 .AND.nn3 > 0) THEN
636 x1=x(1,n1)
637 y1=x(2,n1)
638 z1=x(3,n1)
639 x2=x(1,n2)
640 y2=x(2,n2)
641 z2=x(3,n2)
642 x3=x(1,n3)
643 y3=x(2,n3)
644 z3=x(3,n3)
645C
646 x31=x3-x1
647 y31=y3-y1
648 z31=z3-z1
649 x32=x3-x2
650 y32=y3-y2
651 z32=z3-z2
652C
653 e3x=y31*z32-z31*y32
654 e3y=z31*x32-x31*z32
655 e3z=x31*y32-y31*x32
656C
657 e3x=one_over_6*e3x
658 e3y=one_over_6*e3y
659 e3z=one_over_6*e3z
660 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
661
662 nodarea(n1)=nodarea(n1)+area
663 nodarea(n2)=nodarea(n2)+area
664 nodarea(n3)=nodarea(n3)+area
665 ENDIF
666 ENDDO
667 ENDIF
668 END DO
669C
670 DO n=1,numelc
671 n1=ixc(2,n)
672 n2=ixc(3,n)
673 n3=ixc(4,n)
674 n4=ixc(5,n)
675 IF(n4/=n3)THEN
676 x1=x(1,n1)
677 y1=x(2,n1)
678 z1=x(3,n1)
679 x2=x(1,n2)
680 y2=x(2,n2)
681 z2=x(3,n2)
682 x3=x(1,n3)
683 y3=x(2,n3)
684 z3=x(3,n3)
685 x4=x(1,n4)
686 y4=x(2,n4)
687 z4=x(3,n4)
688C
689 x31=x3-x1
690 y31=y3-y1
691 z31=z3-z1
692 x42=x4-x2
693 y42=y4-y2
694 z42=z4-z2
695C
696 e3x=y31*z42-z31*y42
697 e3y=z31*x42-x31*z42
698 e3z=x31*y42-y31*x42
699C
700 e3x=one_over_8*e3x
701 e3y=one_over_8*e3y
702 e3z=one_over_8*e3z
703C
704 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
705 nodarea(n1)=nodarea(n1)+area
706 nodarea(n2)=nodarea(n2)+area
707 nodarea(n3)=nodarea(n3)+area
708 nodarea(n4)=nodarea(n4)+area
709C
710 ELSE
711 x1=x(1,n1)
712 y1=x(2,n1)
713 z1=x(3,n1)
714 x2=x(1,n2)
715 y2=x(2,n2)
716 z2=x(3,n2)
717 x3=x(1,n3)
718 y3=x(2,n3)
719 z3=x(3,n3)
720 x31=x3-x1
721 y31=y3-y1
722 z31=z3-z1
723 x32=x3-x2
724 y32=y3-y2
725 z32=z3-z2
726C
727 e3x=y31*z32-z31*y32
728 e3y=z31*x32-x31*z32
729 e3z=x31*y32-y31*x32
730 e3x=one_over_6*e3x
731 e3y=one_over_6*e3y
732 e3z=one_over_6*e3z
733C
734 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
735 nodarea(n1)=nodarea(n1)+area
736 nodarea(n2)=nodarea(n2)+area
737 nodarea(n3)=nodarea(n3)+area
738 END IF
739 END DO
740C
741 DO n=1,numeltg
742 n1=ixtg(2,n)
743 n2=ixtg(3,n)
744 n3=ixtg(4,n)
745 x1=x(1,n1)
746 y1=x(2,n1)
747 z1=x(3,n1)
748 x2=x(1,n2)
749 y2=x(2,n2)
750 z2=x(3,n2)
751 x3=x(1,n3)
752 y3=x(2,n3)
753 z3=x(3,n3)
754 x31=x3-x1
755 y31=y3-y1
756 z31=z3-z1
757 x32=x3-x2
758 y32=y3-y2
759 z32=z3-z2
760C
761 e3x=y31*z32-z31*y32
762 e3y=z31*x32-x31*z32
763 e3z=x31*y32-y31*x32
764 e3x=one_over_6*e3x
765 e3y=one_over_6*e3y
766 e3z=one_over_6*e3z
767C
768 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
769 nodarea(n1)=nodarea(n1)+area
770 nodarea(n2)=nodarea(n2)+area
771 nodarea(n3)=nodarea(n3)+area
772 END DO
773C
774 DO i=1,nsegquadfr
775 n =segquadfr(1,i)
776 iline=segquadfr(2,i)
777
778 n1=ixq(lines(1,iline)+1,n)
779 n2=ixq(lines(2,iline)+1,n)
780
781 y1=x(2,n1)
782 z1=x(3,n1)
783 y2=x(2,n2)
784 z2=x(3,n2)
785
786 area = sqrt((y2-y1)*(y2-y1)+(z2-z1)*(z2-z1))
787 area = area*half
788
789
790 nodarea(n1)=nodarea(n1)+area
791 nodarea(n2)=nodarea(n2)+area
792
793 ENDDO
794C
795 IF(nspmd > 1)THEN
796 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
797 CALL spmd_exch_nodarea(nodarea,iad_elem,fr_elem,lenr,weight)
798 END IF
799C
800 IF(anim_v(27)+h3d_data%N_VECT_PCONT2 /=0) THEN
801 DO n=1,numnod
802 IF (nodarea(n) == zero) THEN
803 fncontp2(1,n)=zero
804 fncontp2(2,n)=zero
805 fncontp2(3,n)=zero
806 ftcontp2(1,n)=zero
807 ftcontp2(2,n)=zero
808 ftcontp2(3,n)=zero
809 ELSE
810C-- computation of normal and tangent contribution for PCONT2
811C-- total force stored in FNCONTP2
812 areainv = one/max(em20,nodarea(n))
813 normal(1:3) = npcont2(1:3,n)
814 nnn = sqrt(max(em20,normal(1)**2+normal(2)**2+normal(3)**2))
815 normal(1:3) = normal(1:3)/nnn
816 fn_proj = fncontp2(1,n)*normal(1)+fncontp2(2,n)*normal(2)+fncontp2(3,n)*normal(3)
817 f_total(1:3) = fncontp2(1:3,n)
818 fncontp2(1,n)=areainv*fn_proj*normal(1)
819 fncontp2(2,n)=areainv*fn_proj*normal(2)
820 fncontp2(3,n)=areainv*fn_proj*normal(3)
821 ftcontp2(1,n)=areainv*(f_total(1)-fn_proj*normal(1))
822 ftcontp2(2,n)=areainv*(f_total(2)-fn_proj*normal(2))
823 ftcontp2(3,n)=areainv*(f_total(3)-fn_proj*normal(3))
824 ENDIF
825 END DO
826 ENDIF
827C
828 IF(ninefric > 0) THEN
829 DO ni=1,ninefric
830 DO n=1,numnod
831 IF (nodarea(n) == zero) THEN
832 csefric(ni,n)=zero
833 ELSE
834 areainv = one/max(em30,nodarea(n))
835 csefric(ni,n)=areainv*efric(ni,n)
836 ENDIF
837 END DO
838 ENDDO
839 ENDIF
840C
841 IF(h3d_data%N_SCAL_CSE_FRIC >0)THEN
842 DO n=1,numnod
843 IF (nodarea(n) == zero) THEN
844 csefricg(n)=zero
845 ELSE
846 areainv = one/max(em30,nodarea(n))
847 csefricg(n)=areainv*efricg(n)
848 ENDIF
849 END DO
850 ENDIF
851C
852 DEALLOCATE(nodarea)
853C
854 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
max
#define max(a, b)
Definition macros.h:21
h3d_mod
Definition h3d_mod.F:308
outputs_mod
Definition outputs_mod.F:59
outputs_mod::ninefric
integer ninefric
Definition outputs_mod.F:65
outputs_mod::s_efric
integer s_efric
Definition outputs_mod.F:64
outputs_mod::s_efricint
integer s_efricint
Definition outputs_mod.F:64
spmd_exch_nodarea
subroutine spmd_exch_nodarea(nodarea, iad_elem, fr_elem, lenr, weight)
Definition spmd_exch_nodarea.F:41

◆ ani_pcont21()

subroutine ani_pcont21 ( integer, dimension(nixs,*) ixs,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer, dimension(2,*) fasolfr,
x,
contn,
contt,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) weight,
integer, dimension(*) nodglob,
fncontg,
ftcontg,
fncontp2,
ftcontp2,
type (h3d_database) h3d_data,
dimension(ninefric_stamp,s_efricintg), intent(inout) csefric_stamp,
dimension(s_efricg), intent(inout) csefricg_stamp,
integer, intent(in) sz_npcont2,
dimension(3,sz_npcont2), intent(in) npcont2 )

Definition at line 867 of file ani_pcont.F.

871C-----------------------------------------------
872C M o d u l e s
873C-----------------------------------------------
874 USE h3d_mod
875 USE outputs_mod
876C-----------------------------------------------
877C I m p l i c i t T y p e s
878C-----------------------------------------------
879#include "implicit_f.inc"
880#include "comlock.inc"
881C-----------------------------------------------
882C C o m m o n B l o c k s
883C-----------------------------------------------
884#include "com01_c.inc"
885#include "com04_c.inc"
886#include "spmd_c.inc"
887#include "task_c.inc"
888#include "scr14_c.inc"
889#include "scr16_c.inc"
890C-----------------------------------------------
891C D u m m y A r g u m e n t s
892C-----------------------------------------------
893C REAL
894 INTEGER
895 . IXS(NIXS,*), IXC(NIXC,*), IXTG(NIXTG,*), FASOLFR(2,*),
896 . IAD_ELEM(2,*), FR_ELEM(*), WEIGHT(*), NODGLOB(*)
897 INTEGER , INTENT(IN) :: SZ_NPCONT2
898 my_real
899 . x(3,*), contn(3,*), contt(3,*), fncontg(3,*), ftcontg(3,*),
900 . fncontp2(3,*),ftcontp2(3,*)
901 my_real , INTENT(INOUT) :: csefric_stamp(ninefric_stamp,s_efricintg),
902 . csefricg_stamp(s_efricg)
903 my_real , INTENT(IN) :: npcont2(3,sz_npcont2)
904 TYPE (H3D_DATABASE) :: H3D_DATA
905C-----------------------------------------------
906C L o c a l V a r i a b l e s
907C-----------------------------------------------
908 INTEGER N1,N2,N3,N4,
909 . I,K,N,IFAC,
910 . IERROR, LENR, NI
911 my_real
912 . area,
913 . x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4,
914 . x31,y31,z31,x42,y42,z42,x32,y32,z32,e3x,e3y,e3z,
915 . tmp,areainv,normal(3),nnn,f_total(1:3),fn_proj
916 INTEGER FACES(4,6)
917 my_real, DIMENSION(:), ALLOCATABLE :: nodarea,nodareag
918C REAL
919 DATA faces/1,2,3,4,
920 . 2,1,5,6,
921 . 1,5,8,4,
922 . 5,6,7,8,
923 . 3,4,8,7,
924 . 2,6,7,3/
925C-----------------------------------------------
926C
927 ALLOCATE(nodarea(numnod))
928 DO n=1,numnod
929 nodarea(n)=zero
930 END DO
931C
932 DO i=1,nfasolfr
933 n =fasolfr(1,i)
934 ifac=fasolfr(2,i)
935C
936 n1=ixs(faces(1,ifac)+1,n)
937 n2=ixs(faces(2,ifac)+1,n)
938 n3=ixs(faces(3,ifac)+1,n)
939 n4=ixs(faces(4,ifac)+1,n)
940 x1=x(1,n1)
941 y1=x(2,n1)
942 z1=x(3,n1)
943 x2=x(1,n2)
944 y2=x(2,n2)
945 z2=x(3,n2)
946 x3=x(1,n3)
947 y3=x(2,n3)
948 z3=x(3,n3)
949 x4=x(1,n4)
950 y4=x(2,n4)
951 z4=x(3,n4)
952C
953 x31=x3-x1
954 y31=y3-y1
955 z31=z3-z1
956 x42=x4-x2
957 y42=y4-y2
958 z42=z4-z2
959C
960 e3x=y31*z42-z31*y42
961 e3y=z31*x42-x31*z42
962 e3z=x31*y42-y31*x42
963C
964 IF( n4/=n3
965 . .AND.n3/=n2
966 . .AND.n2/=n1
967 . .AND.n1/=n4)THEN
968 e3x=one_over_8*e3x
969 e3y=one_over_8*e3y
970 e3z=one_over_8*e3z
971 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
972 nodarea(n1)=nodarea(n1)+area
973 nodarea(n2)=nodarea(n2)+area
974 nodarea(n3)=nodarea(n3)+area
975 nodarea(n4)=nodarea(n4)+area
976 ELSE
977 e3x=one_over_6*e3x
978 e3y=one_over_6*e3y
979 e3z=one_over_6*e3z
980 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
981 IF(n4==n3)THEN
982 IF(n2/=n1) THEN
983 nodarea(n1)=nodarea(n1)+area
984 nodarea(n2)=nodarea(n2)+area
985 nodarea(n3)=nodarea(n3)+area
986 ENDIF
987 ELSEIF(n3==n2)THEN
988 IF(n4/=n1) THEN
989 nodarea(n1)=nodarea(n1)+area
990 nodarea(n2)=nodarea(n2)+area
991 nodarea(n4)=nodarea(n4)+area
992 ENDIF
993 ELSEIF(n2==n1)THEN
994 IF(n4/=n3) THEN
995 nodarea(n2)=nodarea(n2)+area
996 nodarea(n3)=nodarea(n3)+area
997 nodarea(n4)=nodarea(n4)+area
998 ENDIF
999 ELSEIF(n1==n4)THEN
1000 IF(n2/=n3) THEN
1001 nodarea(n2)=nodarea(n2)+area
1002 nodarea(n3)=nodarea(n3)+area
1003 nodarea(n4)=nodarea(n4)+area
1004 ENDIF
1005 END IF
1006 END IF
1007 END DO
1008C
1009 DO n=1,numelc
1010 n1=ixc(2,n)
1011 n2=ixc(3,n)
1012 n3=ixc(4,n)
1013 n4=ixc(5,n)
1014 IF(n4/=n3)THEN
1015 x1=x(1,n1)
1016 y1=x(2,n1)
1017 z1=x(3,n1)
1018 x2=x(1,n2)
1019 y2=x(2,n2)
1020 z2=x(3,n2)
1021 x3=x(1,n3)
1022 y3=x(2,n3)
1023 z3=x(3,n3)
1024 x4=x(1,n4)
1025 y4=x(2,n4)
1026 z4=x(3,n4)
1027C
1028 x31=x3-x1
1029 y31=y3-y1
1030 z31=z3-z1
1031 x42=x4-x2
1032 y42=y4-y2
1033 z42=z4-z2
1034C
1035 e3x=y31*z42-z31*y42
1036 e3y=z31*x42-x31*z42
1037 e3z=x31*y42-y31*x42
1038C
1039 e3x=one_over_8*e3x
1040 e3y=one_over_8*e3y
1041 e3z=one_over_8*e3z
1042C
1043 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
1044 nodarea(n1)=nodarea(n1)+area
1045 nodarea(n2)=nodarea(n2)+area
1046 nodarea(n3)=nodarea(n3)+area
1047 nodarea(n4)=nodarea(n4)+area
1048C
1049 ELSE
1050 x1=x(1,n1)
1051 y1=x(2,n1)
1052 z1=x(3,n1)
1053 x2=x(1,n2)
1054 y2=x(2,n2)
1055 z2=x(3,n2)
1056 x3=x(1,n3)
1057 y3=x(2,n3)
1058 z3=x(3,n3)
1059 x31=x3-x1
1060 y31=y3-y1
1061 z31=z3-z1
1062 x32=x3-x2
1063 y32=y3-y2
1064 z32=z3-z2
1065C
1066 e3x=y31*z32-z31*y32
1067 e3y=z31*x32-x31*z32
1068 e3z=x31*y32-y31*x32
1069 e3x=one_over_6*e3x
1070 e3y=one_over_6*e3y
1071 e3z=one_over_6*e3z
1072C
1073 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
1074 nodarea(n1)=nodarea(n1)+area
1075 nodarea(n2)=nodarea(n2)+area
1076 nodarea(n3)=nodarea(n3)+area
1077 END IF
1078 END DO
1079C
1080 DO n=1,numeltg
1081 n1=ixtg(2,n)
1082 n2=ixtg(3,n)
1083 n3=ixtg(4,n)
1084 x1=x(1,n1)
1085 y1=x(2,n1)
1086 z1=x(3,n1)
1087 x2=x(1,n2)
1088 y2=x(2,n2)
1089 z2=x(3,n2)
1090 x3=x(1,n3)
1091 y3=x(2,n3)
1092 z3=x(3,n3)
1093 x31=x3-x1
1094 y31=y3-y1
1095 z31=z3-z1
1096 x32=x3-x2
1097 y32=y3-y2
1098 z32=z3-z2
1099C
1100 e3x=y31*z32-z31*y32
1101 e3y=z31*x32-x31*z32
1102 e3z=x31*y32-y31*x32
1103 e3x=one_over_6*e3x
1104 e3y=one_over_6*e3y
1105 e3z=one_over_6*e3z
1106C
1107 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
1108 nodarea(n1)=nodarea(n1)+area
1109 nodarea(n2)=nodarea(n2)+area
1110 nodarea(n3)=nodarea(n3)+area
1111 END DO
1112C
1113 IF(nspmd > 1)THEN
1114 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
1115 CALL spmd_exch_nodarea(nodarea,iad_elem,fr_elem,lenr,weight)
1116 END IF
1117C-----
1118
1119 IF(nspmd > 1)THEN
1120 IF(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT+ninefric_stamp
1121 . +h3d_data%N_SCAL_CSE_FRIC /=0) THEN
1122
1123 ALLOCATE(nodareag(numnodg))
1124 DO i=1,numnodg
1125 nodareag(i)=zero
1126 ENDDO
1127 DO k=1,numnod
1128 i=nodglob(k)
1129 nodareag(i)=nodarea(k)*weight(k)
1130 ENDDO
1131
1132 CALL spmd_glob_dsum9(nodareag,numnodg)
1133
1134 IF(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT/=0) THEN
1135 CALL spmd_glob_dsum9(fncontg,3*numnodg)
1136 CALL spmd_glob_dsum9(ftcontg,3*numnodg)
1137 ENDIF
1138 IF(ninefric_stamp > 0) THEN
1139 DO ni=1,ninefric_stamp
1140 DO i=1,numnodg
1141 csefric_stamp(ni,i)=efric_stamp(ni,i)
1142 ENDDO
1143 CALL spmd_glob_dsum9(csefric_stamp(ni,1),numnodg)
1144 ENDDO
1145 ENDIF
1146
1147 IF(h3d_data%N_SCAL_CSE_FRIC > 0) THEN
1148 DO i=1,numnodg
1149 csefricg_stamp(i)=efricg_stamp(i)
1150 ENDDO
1151 CALL spmd_glob_dsum9(csefricg_stamp,numnodg)
1152 ENDIF
1153
1154 ENDIF
1155
1156 ENDIF
1157
1158 IF(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT /=0) THEN
1159C INTER == 21
1160 IF (nspmd == 1) THEN
1161 DO n=1,numnod
1162 i=nodglob(n)
1163 IF (nodarea(n) == zero) THEN
1164 fncontg(1,i)=zero
1165 fncontg(2,i)=zero
1166 fncontg(3,i)=zero
1167 ftcontg(1,i)=zero
1168 ftcontg(2,i)=zero
1169 ftcontg(3,i)=zero
1170 ELSE
1171 tmp=one/max(em30,nodarea(n))
1172 fncontg(1,i)=fncontg(1,i)*tmp
1173 fncontg(2,i)=fncontg(2,i)*tmp
1174 fncontg(3,i)=fncontg(3,i)*tmp
1175 ftcontg(1,i)=ftcontg(1,i)*tmp
1176 ftcontg(2,i)=ftcontg(2,i)*tmp
1177 ftcontg(3,i)=ftcontg(3,i)*tmp
1178 ENDIF
1179 END DO
1180 ELSE
1181 IF(ispmd==0)THEN
1182 DO n=1,numnodg
1183 IF (nodareag(n) == zero) THEN
1184 fncontg(1,n)=zero
1185 fncontg(2,n)=zero
1186 fncontg(3,n)=zero
1187 ftcontg(1,n)=zero
1188 ftcontg(2,n)=zero
1189 ftcontg(3,n)=zero
1190 ELSE
1191 tmp=one/max(em30,nodareag(n))
1192 fncontg(1,n)=fncontg(1,n)*tmp
1193 fncontg(2,n)=fncontg(2,n)*tmp
1194 fncontg(3,n)=fncontg(3,n)*tmp
1195 ftcontg(1,n)=ftcontg(1,n)*tmp
1196 ftcontg(2,n)=ftcontg(2,n)*tmp
1197 ftcontg(3,n)=ftcontg(3,n)*tmp
1198 ENDIF
1199 END DO
1200 ELSE
1201 DO n=1,numnodg
1202 fncontg(1,n)=zero
1203 fncontg(2,n)=zero
1204 fncontg(3,n)=zero
1205 ftcontg(1,n)=zero
1206 ftcontg(2,n)=zero
1207 ftcontg(3,n)=zero
1208 END DO
1209 END IF
1210
1211 END IF
1212 ENDIF
1213C
1214 IF(anim_v(27)+h3d_data%N_VECT_PCONT2 /=0) THEN
1215 DO n=1,numnod
1216 IF (nodarea(n) == zero) THEN
1217 fncontp2(1,n)=zero
1218 fncontp2(2,n)=zero
1219 fncontp2(3,n)=zero
1220 ftcontp2(1,n)=zero
1221 ftcontp2(2,n)=zero
1222 ftcontp2(3,n)=zero
1223 ELSE
1224C-- computation of normal and tangent contribution for PCONT2
1225C-- total force stored in FNCONTP2
1226 areainv = one/max(em20,nodarea(n))
1227 normal(1:3) = npcont2(1:3,n)
1228 nnn = sqrt(max(em20,normal(1)**2+normal(2)**2+normal(3)**2))
1229 normal(1:3) = normal(1:3)/nnn
1230 fn_proj = fncontp2(1,n)*normal(1)+fncontp2(2,n)*normal(2)+fncontp2(3,n)*normal(3)
1231 f_total(1:3) = fncontp2(1:3,n)
1232 fncontp2(1,n)=areainv*fn_proj*normal(1)
1233 fncontp2(2,n)=areainv*fn_proj*normal(2)
1234 fncontp2(3,n)=areainv*fn_proj*normal(3)
1235 ftcontp2(1,n)=areainv*(f_total(1)-fn_proj*normal(1))
1236 ftcontp2(2,n)=areainv*(f_total(2)-fn_proj*normal(2))
1237 ftcontp2(3,n)=areainv*(f_total(3)-fn_proj*normal(3))
1238 ENDIF
1239 END DO
1240 ENDIF
1241C
1242 IF(ninefric_stamp > 0) THEN
1243 IF (nspmd == 1) THEN
1244 DO ni=1,ninefric_stamp
1245 DO n=1,numnod
1246 i=nodglob(n)
1247 IF (nodarea(n) == zero) THEN
1248 csefric_stamp(ni,i)=zero
1249 ELSE
1250 tmp=one/max(em30,nodarea(n))
1251 csefric_stamp(ni,i)=tmp*efric_stamp(ni,i)
1252 ENDIF
1253 END DO
1254 ENDDO
1255 ELSE
1256 IF(ispmd==0)THEN
1257 DO ni=1,ninefric_stamp
1258 DO n=1,numnodg
1259 IF (nodareag(n) == zero) THEN
1260 csefric_stamp(ni,n)=zero
1261 ELSE
1262 tmp=one/max(em30,nodareag(n))
1263 csefric_stamp(ni,n)=tmp*csefric_stamp(ni,n)
1264 ENDIF
1265 END DO
1266 ENDDO
1267 ELSE
1268 DO ni=1,ninefric_stamp
1269 DO n=1,numnodg
1270 csefric_stamp(ni,n)=zero
1271 END DO
1272 ENDDO
1273 ENDIF
1274 ENDIF
1275 ENDIF
1276C
1277 IF(h3d_data%N_SCAL_CSE_FRIC > 0) THEN
1278 IF (nspmd == 1) THEN
1279 DO n=1,numnod
1280 i=nodglob(n)
1281 IF (nodarea(n) == zero) THEN
1282 csefricg_stamp(i)=zero
1283 ELSE
1284 tmp=one/max(em30,nodarea(n))
1285 csefricg_stamp(i)=tmp*efricg_stamp(i)
1286 ENDIF
1287 ENDDO
1288 ELSE
1289 IF(ispmd==0)THEN
1290 DO n=1,numnodg
1291 IF (nodareag(n) == zero) THEN
1292 csefricg_stamp(n)=zero
1293 ELSE
1294 tmp=one/max(em30,nodareag(n))
1295 csefricg_stamp(n)=tmp*csefricg_stamp(n)
1296 ENDIF
1297 ENDDO
1298 ELSE
1299 DO n=1,numnodg
1300 csefricg_stamp(n)=zero
1301 END DO
1302 ENDIF
1303 ENDIF
1304 ENDIF
1305C
1306 IF(nspmd > 1)THEN
1307 IF(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT+ninefric_stamp
1308 . +h3d_data%N_SCAL_CSE_FRIC /=0) DEALLOCATE(nodareag)
1309 ENDIF
1310
1311 DEALLOCATE(nodarea)
1312C
1313 RETURN
outputs_mod::s_efricg
integer s_efricg
Definition outputs_mod.F:64
outputs_mod::s_efricintg
integer s_efricintg
Definition outputs_mod.F:64
outputs_mod::ninefric_stamp
integer ninefric_stamp
Definition outputs_mod.F:65
spmd_glob_dsum9
subroutine spmd_glob_dsum9(v, len)
Definition spmd_th.F:380