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 (output, 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 (output, 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 ( type(output_), intent(inout) output,
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(output%data%ninefric,output%data%s_efricint), intent(inout) csefric,
dimension(output%data%s_efric), intent(inout) csefricg,
integer, intent(in) sz_npcont2,
dimension(3,sz_npcont2), intent(in) npcont2 )

Definition at line 34 of file ani_pcont.F.

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

Definition at line 891 of file ani_pcont.F.

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