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

Go to the source code of this file.

Functions/Subroutines

subroutine velvec (v, v_temp, ivois, al, nodcut, nnwl, nnsrg, nodglob, weight, nfvnod, ifunc, nfnod_pxfem, nod, indx, nfnod_crkxfemg, itab)
subroutine velvec2 (ivois, v_temp, al, nodcut, fopt, npby, nnwl, nnsrg, nodglob, weight, fr_sec, nfvnod, nfnod_pxfem, nfnod_pxfemg, nfnod_crkxfemg)
subroutine velvecc (v, v_temp, ivois, al, nodcut, nnwl, nnsrg, nodglob, weight, nfvnod, nfnod_pxfem, nfnod_pxfemg, nfnod_crkxfemg)
subroutine velvecc21 (v, v_temp, ivois, al, nodcut, nnwl, nnsrg, nodglob, weight, nfvnod, nfnod_pxfem, nfnod_pxfemg, vg21, nfnod_crkxfemg)
subroutine velvecc_max (vmax, nodcut, nnwl, nnsrg, nfvnod, nfnod_pxfemg, nfnod_crkxfemg)
subroutine velvec3 (v, v_temp, vale, ivois, al, nodcut, nnwl, nnsrg, nodglob, weight, nfvnod, nfnod_pxfem, nfnod_pxfemg, nfnod_crkxfemg)
subroutine velvecc22 (elbuf_tab, iparg, iflg, ixs, ixq, itab)

Function/Subroutine Documentation

◆ velvec()

subroutine velvec ( v,
v_temp,
integer, dimension(2,*) ivois,
al,
integer nodcut,
integer nnwl,
integer nnsrg,
integer, dimension(*) nodglob,
integer, dimension(*) weight,
integer nfvnod,
integer ifunc,
integer nfnod_pxfem,
integer, dimension(*) nod,
integer, dimension(*) indx,
integer nfnod_crkxfemg,
integer, dimension(numnod), intent(in) itab )

Definition at line 34 of file velvec.F.

37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE plyxfem_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "task_c.inc"
49#include "com01_c.inc"
50#include "com04_c.inc"
51#include "scr14_c.inc"
52#include "spmd_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER NODGLOB(*),WEIGHT(*),NOD(*),INDX(*)
57 INTEGER,INTENT(IN) :: ITAB(NUMNOD)
58 my_real
59 . v(3,numnod),al(*),v_temp(3,*)
60 my_real
61 . s3000,s
62 REAL R4
63 REAL, DIMENSION(:,:), ALLOCATABLE :: PLYVELVEC
64 INTEGER I,IVOIS(2,*),NODCUT,NNWL,K,P,BUF
65 INTEGER NNSRG,NFVNOD,IFUNC,NFNOD_PXFEM,ND,EMPL,NFNOD_CRKXFEMG
66C-----------------------------------------------
67 INTEGER N,IPLY,JJ,EMPSIZPL
68C-----------------------------------------------
69C S o u r c e L i n e s
70C-----------------------------------------------
71 s3000 = 3000.
72 s = zero
73C
74 IF (nspmd == 1) THEN
75 DO i=1,numnod
76 r4 = v(1,i)
77 CALL write_r_c(r4,1)
78 r4 = v(2,i)
79 CALL write_r_c(r4,1)
80 r4 = v(3,i)
81 CALL write_r_c(r4,1)
82 ENDDO
83 IF (numelig3d /= 0)THEN
84 DO i=1,64*numelig3d
85 r4 = v_temp(1,i)
86 CALL write_r_c(r4,1)
87 r4 = v_temp(2,i)
88 CALL write_r_c(r4,1)
89 r4 = v_temp(3,i)
90 CALL write_r_c(r4,1)
91 ENDDO
92 ENDIF
93 ELSE
94 IF (ispmd==0) THEN
95 buf = numnodg
96 ELSE
97 buf = 1
98 ENDIF
99 CALL spmd_vgath(v,nodglob,weight,buf)
100 ENDIF
101 IF(nodcut>0)THEN
102 IF (nspmd > 1) THEN
103 IF (ispmd==0) THEN
104 print *, '** NODCUT NON PARALLELIZED OPTION!'
105 END IF
106 GO TO 211
107 END IF
108 DO i=1,nodcut
109 r4 =al(i)*v(1,ivois(2,i))+(one-al(i))*v(1,ivois(1,i))
110 CALL write_r_c(r4,1)
111 r4 =al(i)*v(2,ivois(2,i))+(one -al(i))*v(2,ivois(1,i))
112 CALL write_r_c(r4,1)
113 r4 =al(i)*v(3,ivois(2,i))+(one-al(i))*v(3,ivois(1,i))
114 CALL write_r_c(r4,1)
115 ENDDO !next I
116 211 CONTINUE
117 ENDIF
118C
119 IF (ispmd==0) THEN
120 r4 = 0.
121 DO i=1,nsect+nrwall+nnwl+nnsrg
122 CALL write_r_c(r4,1)
123 CALL write_r_c(r4,1)
124 CALL write_r_c(r4,1)
125 ENDDO
126 ENDIF
127C
128C node ply xfem
129C
130 IF(anim_ply > 0 ) THEN
131 IF (nspmd == 1) THEN
132 IF (nfnod_pxfem>0) THEN
133 IF(ifunc == 1) THEN
134 ALLOCATE(plyvelvec(3,nfnod_pxfem))
135 DO jj =1,nplypart
136 iply = indx(jj)
137 DO nd=1,plynod(iply)%PLYNUMNODS
138 i = plynod(iply)%NODES(nd)
139 empl = plynod(iply)%PLYNODID(nd)
140 n = nod(i)
141 plyvelvec(1,empl) = ply(iply)%V(1,n)
142 plyvelvec(2,empl) = ply(iply)%V(2,n)
143 plyvelvec(3,empl) = ply(iply)%V(3,n)
144 ENDDO
145 ENDDO
146 CALL write_r_c(plyvelvec,3*nfnod_pxfem)
147 DEALLOCATE(plyvelvec)
148C
149 ELSEIF(ifunc == 2)THEN
150 ALLOCATE(plyvelvec(3,nfnod_pxfem))
151 DO jj =1,nplypart
152 iply = indx(jj)
153 DO nd=1,plynod(iply)%PLYNUMNODS
154 i = plynod(iply)%NODES(nd)
155 empl = plynod(iply)%PLYNODID(nd)
156 n = nod(i)
157 plyvelvec(1,empl) = ply(iply)%U(1,n)
158 plyvelvec(2,empl) = ply(iply)%U(2,n)
159 plyvelvec(3,empl) = ply(iply)%U(3,n)
160 ENDDO
161 ENDDO
162 CALL write_r_c(plyvelvec,3*nfnod_pxfem)
163 DEALLOCATE(plyvelvec)
164
165 ELSEIF(ifunc == 3) THEN
166 ALLOCATE(plyvelvec(3,nfnod_pxfem))
167 DO jj =1,nplypart
168 iply = indx(jj)
169 DO nd=1,plynod(iply)%PLYNUMNODS
170 i = plynod(iply)%NODES(nd)
171 empl = plynod(iply)%PLYNODID(nd)
172 n = nod(i)
173 plyvelvec(1,empl) = ply(iply)%A(1,n)
174 plyvelvec(2,empl) = ply(iply)%A(2,n)
175 plyvelvec(3,empl) = ply(iply)%A(3,n)
176 ENDDO
177 ENDDO
178 CALL write_r_c(plyvelvec,3*nfnod_pxfem)
179 DEALLOCATE(plyvelvec)
180 ELSE
181 r4 = zero
182 DO i=1,nfnod_pxfem
183 CALL write_r_c(r4,1)
184 CALL write_r_c(r4,1)
185 CALL write_r_c(r4,1)
186 ENDDO
187 ENDIF
188 ENDIF
189 ELSE
190C
191 empsizpl = 0
192 DO jj =1,nplypart
193 iply = indx(jj)
194 CALL spmd_anim_ply_velvec( nodglob,iply,
195 * nod, ifunc,empsizpl )
196 ENDDO
197 ENDIF
198 ENDIF
199c----------------------------
200C nodes crk xfem
201c----------------------------
202 IF (anim_crk > 0 ) THEN
203 IF (ispmd == 0) THEN
204 r4 = zero
205 DO i=1,nfnod_crkxfemg
206 CALL write_r_c(r4,1)
207 CALL write_r_c(r4,1)
208 CALL write_r_c(r4,1)
209 ENDDO
210 ENDIF
211 ENDIF
212c----------------------------
213 IF (ispmd==0)THEN
214 IF (nfvnod>0) THEN
215 r4 = 0.
216 DO i=1,nfvnod+3
217 CALL write_r_c(r4,1)
218 CALL write_r_c(r4,1)
219 CALL write_r_c(r4,1)
220 ENDDO
221 ENDIF
222 ENDIF
223C-------------
224 300 CONTINUE
225 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
plyxfem_mod
Definition plyxfem_mod.F:31
plyxfem_mod::plynod
type(plynods), dimension(:), allocatable plynod
Definition plyxfem_mod.F:44
plyxfem_mod::ply
type(ply_data), dimension(:), allocatable ply
Definition plyxfem_mod.F:91
plyxfem_mod::nplypart
integer nplypart
Definition plyxfem_mod.F:59
spmd_anim_ply_velvec
subroutine spmd_anim_ply_velvec(nodglob, iply, nod_pxfem, ifunc, empsizpl)
Definition spmd_anim_ply_velvec.F:36
spmd_vgath
subroutine spmd_vgath(x, nodglob, weight, num)
Definition spmd_vgath.F:35
write_r_c
void write_r_c(float *w, int *len)
Definition write_routtines.c:519

◆ velvec2()

subroutine velvec2 ( integer, dimension(2,*) ivois,
v_temp,
al,
integer nodcut,
fopt,
integer, dimension(nnpby,*) npby,
integer nnwl,
integer nnsrg,
integer, dimension(*) nodglob,
integer, dimension(*) weight,
integer, dimension(nspmd+1,*) fr_sec,
integer nfvnod,
integer nfnod_pxfem,
integer nfnod_pxfemg,
integer nfnod_crkxfemg )

Definition at line 239 of file velvec.F.

242C-----------------------------------------------
243C I m p l i c i t T y p e s
244C-----------------------------------------------
245 USE my_alloc_mod
246#include "implicit_f.inc"
247C-----------------------------------------------
248C C o m m o n B l o c k s
249C-----------------------------------------------
250#include "param_c.inc"
251#include "task_c.inc"
252#include "com01_c.inc"
253#include "com04_c.inc"
254#include "scr14_c.inc"
255#include "spmd_c.inc"
256C-----------------------------------------------
257C D u m m y A r g u m e n t s
258C-----------------------------------------------
259C REAL
260 my_real
261 . al(*),fopt(6,*),v_temp(3,*)
262
263 REAL R4
264 INTEGER IVOIS(2,*),NPBY(NNPBY,*),NODCUT,NNWL
265 INTEGER NNSRG,NFNOD_PXFEM,NFNOD_PXFEMG
266 INTEGER I,N,WEIGHT(*),FR_SEC(NSPMD+1,*)
267
268 INTEGER NODGLOB(*),K,P,RBUF,NNG
269 INTEGER NFVNOD,NFNOD_CRKXFEMG
270C-----------------------------------------------
271C L o c a l V a r i a b l e s
272C----------------------------------------------
273 my_real, DIMENSION(:,:),ALLOCATABLE :: rwa
274 my_real, DIMENSION(:,:),ALLOCATABLE :: rwal
275 my_real, DIMENSION(:,:),ALLOCATABLE :: v
276 INTEGER LOC_PROC,PMAIN
277C=======================================================================
278 CALL my_alloc(rwa,3,nsect)
279 CALL my_alloc(rwal,3,nrwall)
280 CALL my_alloc(v,3,numnod)
281 loc_proc = ispmd + 1
282C
283 DO i=1,numnod
284 v(1,i) = zero
285 v(2,i) = zero
286 v(3,i) = zero
287 ENDDO
288C
289 IF (nspmd==1) THEN
290 DO n=1,nrbody
291 i = npby(1,n)
292 v(1,i) = fopt(1,nsect+n)
293 v(2,i) = fopt(2,nsect+n)
294 v(3,i) = fopt(3,nsect+n)
295 ENDDO
296C
297 ELSE
298 DO n=1,nrbody
299 i = npby(1,n)
300 IF (i>0) THEN
301 IF (weight(i)==1) THEN
302 v(1,i) = fopt(1,nsect+n)
303 v(2,i) = fopt(2,nsect+n)
304 v(3,i) = fopt(3,nsect+n)
305 ENDIF
306 ENDIF
307 ENDDO
308
309 ENDIF
310C
311 IF (nspmd == 1) THEN
312 DO i=1,numnod
313 r4 = v(1,i)
314 CALL write_r_c(r4,1)
315 r4 = v(2,i)
316 CALL write_r_c(r4,1)
317 r4 = v(3,i)
318 CALL write_r_c(r4,1)
319 ENDDO
320 IF (numelig3d /= 0)THEN
321 DO i=1,64*numelig3d
322 r4 = v_temp(1,i)
323 CALL write_r_c(r4,1)
324 r4 = v_temp(2,i)
325 CALL write_r_c(r4,1)
326 r4 = v_temp(3,i)
327 CALL write_r_c(r4,1)
328 ENDDO
329 ENDIF
330 ELSE
331 IF (ispmd==0) THEN
332 rbuf = numnodm
333 nng = numnodg
334 ELSE
335 rbuf = 1
336 nng = 1
337 ENDIF
338 CALL spmd_velvec2(v,nodglob,rbuf,nng)
339 ENDIF
340
341C
342C nodcut non parallelises
343 IF(nodcut>0)THEN
344 IF (nspmd > 1) THEN
345 IF (ispmd==0)THEN
346 print *, '** NODCUT NON PARALLELIZED OPTION'
347 ENDIF
348 GOTO 211
349 END IF
350 DO 210 i=1,nodcut
351 r4 =al(i)*v(1,ivois(2,i))+(one -al(i))*v(1,ivois(1,i))
352 CALL write_r_c(r4,1)
353 r4 =al(i)*v(2,ivois(2,i))+(one -al(i))*v(2,ivois(1,i))
354 CALL write_r_c(r4,1)
355 r4 =al(i)*v(3,ivois(2,i))+(one -al(i))*v(3,ivois(1,i))
356 CALL write_r_c(r4,1)
357 210 CONTINUE
358 211 CONTINUE
359 ENDIF
360C
361 IF (nspmd==1) THEN
362 DO i=1,nsect
363 r4 = fopt(1,i)
364 CALL write_r_c(r4,1)
365 r4 = fopt(2,i)
366 CALL write_r_c(r4,1)
367 r4 = fopt(3,i)
368 CALL write_r_c(r4,1)
369 ENDDO
370 ELSE
371 DO i=1,nsect
372 pmain = fr_sec(nspmd+1,i)
373 IF (pmain ==loc_proc) THEN
374 rwa(1,i) = fopt(1,i)
375 rwa(2,i) = fopt(2,i)
376 rwa(3,i) = fopt(3,i)
377 ELSE
378 rwa(1,i) = zero
379 rwa(2,i) = zero
380 rwa(3,i) = zero
381 ENDIF
382 ENDDO
383 IF(nsect>0)
384 . CALL spmd_glob_dsum9(rwa,3*nsect)
385 IF (ispmd==0) THEN
386 DO i=1,nsect
387 r4 = rwa(1,i)
388 CALL write_r_c(r4,1)
389 r4 = rwa(2,i)
390 CALL write_r_c(r4,1)
391 r4 = rwa(3,i)
392 CALL write_r_c(r4,1)
393 ENDDO
394 ENDIF
395 ENDIF
396C
397 IF (nspmd==1) THEN
398 DO i=1,nrwall
399 r4 = fopt(1,nsect+nrbody+i)
400 CALL write_r_c(r4,1)
401 r4 = fopt(2,nsect+nrbody+i)
402 CALL write_r_c(r4,1)
403 r4 = fopt(3,nsect+nrbody+i)
404 CALL write_r_c(r4,1)
405 ENDDO
406 ELSE
407 DO i=1,nrwall
408 rwal(1,i) = fopt(1,nsect+nrbody+i)
409 rwal(2,i) = fopt(2,nsect+nrbody+i)
410 rwal(3,i) = fopt(3,nsect+nrbody+i)
411 ENDDO
412 IF (nrwall>0)
413 . CALL spmd_glob_dsum9(rwal,3*nrwall)
414 IF (ispmd==0) THEN
415 DO i=1,nrwall
416 r4 = rwal(1,i)
417 CALL write_r_c(r4,1)
418 r4 = rwal(2,i)
419 CALL write_r_c(r4,1)
420 r4 = rwal(3,i)
421 CALL write_r_c(r4,1)
422 ENDDO
423 ENDIF
424 ENDIF
425 IF (ispmd/=0) GO TO 300
426 r4 = 0.
427 DO i=1,nnwl
428 CALL write_r_c(r4,1)
429 CALL write_r_c(r4,1)
430 CALL write_r_c(r4,1)
431 ENDDO
432 r4=zero
433 DO i=1,nnsrg
434 CALL write_r_c(r4,1)
435 CALL write_r_c(r4,1)
436 CALL write_r_c(r4,1)
437 ENDDO
438C
439 IF(anim_ply > 0 ) THEN
440 IF(ispmd==0 .AND. nfnod_pxfemg>0) THEN
441 r4 = zero
442 DO i=1,nfnod_pxfemg
443 CALL write_r_c(r4,1)
444 CALL write_r_c(r4,1)
445 CALL write_r_c(r4,1)
446 ENDDO
447 ENDIF
448 ENDIF
449c----------------------------
450C nodes crk xfem
451c----------------------------
452 IF (anim_crk > 0 ) THEN
453 IF (ispmd == 0) THEN
454 r4 = zero
455 DO i=1,nfnod_crkxfemg
456 CALL write_r_c(r4,1)
457 CALL write_r_c(r4,1)
458 CALL write_r_c(r4,1)
459 ENDDO
460 ENDIF
461 ENDIF
462c----------------------------
463 IF (nfvnod>0) THEN
464 r4=zero
465 DO i=1,nfvnod+3
466 CALL write_r_c(r4,1)
467 CALL write_r_c(r4,1)
468 CALL write_r_c(r4,1)
469 ENDDO
470 ENDIF
471 300 CONTINUE
472C-----------
473 DEALLOCATE(rwa)
474 DEALLOCATE(rwal)
475 DEALLOCATE(v)
476 RETURN
spmd_glob_dsum9
subroutine spmd_glob_dsum9(v, len)
Definition spmd_th.F:380
spmd_velvec2
subroutine spmd_velvec2(v, nodglob, rbuf, numpog)
Definition spmd_velvec2.F:33

◆ velvec3()

subroutine velvec3 ( v,
v_temp,
vale,
integer, dimension(2,*) ivois,
al,
integer nodcut,
integer nnwl,
integer nnsrg,
integer, dimension(*) nodglob,
integer, dimension(*) weight,
integer nfvnod,
integer nfnod_pxfem,
integer nfnod_pxfemg,
integer nfnod_crkxfemg )

Definition at line 927 of file velvec.F.

930C-----------------------------s------------------
931C I m p l i c i t T y p e s
932C-----------------------------------------------
933 USE my_alloc_mod
934#include "implicit_f.inc"
935C-----------------------------------------------
936C C o m m o n B l o c k s
937C-----------------------------------------------
938#include "task_c.inc"
939#include "com01_c.inc"
940#include "com04_c.inc"
941#include "spmd_c.inc"
942#include "scr14_c.inc"
943C-----------------------------------------------
944C D u m m y A r g u m e n t s
945C-----------------------------------------------
946 INTEGER NODGLOB(*),WEIGHT(*)
947C REAL
948 my_real
949 . v(3,*),vale(3,*),al(*),v_temp(3,*)
950C REAL
951 my_real
952 . s3000,s
953 REAL R4
954 INTEGER I,IVOIS(2,*),NODCUT,NNWL,K,P,BUF
955 INTEGER NNSRG,NFVNOD,NFNOD_PXFEM,NFNOD_PXFEMG,NFNOD_CRKXFEMG
956C-----------------------------------------------
957C L o c a l V a r i a b l e s
958C-----------------------------------------------
959 my_real, DIMENSION(:,:), ALLOCATABLE :: vglobal
960C-----------------------------------------------
961 CALL my_alloc(vglobal,3,numnod)
962 s3000 = 3000.
963 s = 0.
964C
965 IF (ispmd==0) THEN
966 buf = numnodg
967 ELSE
968 buf = 1
969 ENDIF
970
971 IF (nspmd == 1)THEN
972 DO i=1,numnod
973 r4 = v(1,i)+vale(1,i)
974 CALL write_r_c(r4,1)
975 r4 = v(2,i)+vale(2,i)
976 CALL write_r_c(r4,1)
977 r4 = v(3,i)+vale(3,i)
978 CALL write_r_c(r4,1)
979 ENDDO
980 IF (numelig3d /= 0)THEN
981 DO i=1,64*numelig3d
982 r4 = v_temp(1,i)
983 CALL write_r_c(r4,1)
984 r4 = v_temp(2,i)
985 CALL write_r_c(r4,1)
986 r4 = v_temp(3,i)
987 CALL write_r_c(r4,1)
988 ENDDO
989 ENDIF
990 ELSE
991 DO i=1,numnod
992 vglobal(1,i)=v(1,i)+vale(1,i)
993 vglobal(2,i)=v(2,i)+vale(2,i)
994 vglobal(3,i)=v(3,i)+vale(3,i)
995 ENDDO
996 CALL spmd_vgath(vglobal,nodglob,weight,buf)
997 ENDIF
998C
999C option non parallelisee !
1000 IF(nodcut>0)THEN
1001 IF (ispmd==0) THEN
1002 print *, '** NODCUT NON PARALLELIZED OPTION'
1003 END IF
1004 ENDIF
1005C
1006 IF (ispmd/=0) GOTO 300
1007 r4 = 0.
1008 DO i=1,nsect+nrwall+nnwl+nnsrg
1009 CALL write_r_c(r4,1)
1010 CALL write_r_c(r4,1)
1011 CALL write_r_c(r4,1)
1012 ENDDO
1013C
1014 IF(anim_ply > 0 ) THEN
1015 IF(ispmd==0 .AND. nfnod_pxfemg>0) THEN
1016 r4 = zero
1017 DO i=1,nfnod_pxfemg
1018 CALL write_r_c(r4,1)
1019 CALL write_r_c(r4,1)
1020 CALL write_r_c(r4,1)
1021 ENDDO
1022 ENDIF
1023 ENDIF
1024c----------------------------
1025C nodes crk xfem
1026c----------------------------
1027 IF (anim_crk > 0 ) THEN
1028 IF (ispmd == 0) THEN
1029 r4 = zero
1030 DO i=1,nfnod_crkxfemg
1031 CALL write_r_c(r4,1)
1032 CALL write_r_c(r4,1)
1033 CALL write_r_c(r4,1)
1034 ENDDO
1035 ENDIF
1036 ENDIF
1037c----------------------------
1038 IF (ispmd==0.AND.nfvnod>0) THEN
1039 r4 = 0.
1040 DO i=1,nfvnod+3
1041 CALL write_r_c(r4,1)
1042 CALL write_r_c(r4,1)
1043 CALL write_r_c(r4,1)
1044 ENDDO
1045 ENDIF
1046C-------------
1047 300 CONTINUE
1048 DEALLOCATE(vglobal)
1049 RETURN

◆ velvecc()

subroutine velvecc ( v,
v_temp,
integer, dimension(2,*) ivois,
al,
integer nodcut,
integer nnwl,
integer nnsrg,
integer, dimension(*) nodglob,
integer, dimension(*) weight,
integer nfvnod,
integer nfnod_pxfem,
integer nfnod_pxfemg,
integer nfnod_crkxfemg )

Definition at line 489 of file velvec.F.

492C-----------------------------s------------------
493C I m p l i c i t T y p e s
494C-----------------------------------------------
495 USE my_alloc_mod
496#include "implicit_f.inc"
497C-----------------------------------------------
498C C o m m o n B l o c k s
499C-----------------------------------------------
500#include "task_c.inc"
501#include "com01_c.inc"
502#include "com04_c.inc"
503#include "scr14_c.inc"
504#include "spmd_c.inc"
505C-----------------------------------------------
506C D u m m y A r g u m e n t s
507C-----------------------------------------------
508 INTEGER NODGLOB(*),WEIGHT(*)
509C REAL
510 my_real
511 . v(3,*),al(*),v_temp(3,*)
512C REAL
513 my_real
514 . s3000,s
515 REAL R4
516 INTEGER I,IVOIS(2,*),NODCUT,NNWL,K,P,BUF
517 INTEGER NNSRG,NFVNOD,NFNOD_PXFEM,NFNOD_PXFEMG,NFNOD_CRKXFEMG
518C-----------------------------------------------
519C L o c a l V a r i a b l e s
520C-----------------------------------------------
521 REAL, DIMENSION(:,:), ALLOCATABLE :: VG
522C-----------------------------------------------
523 CALL my_alloc(vg,3,numnodg)
524 s3000 = 3000.
525 s = zero
526
527 IF (nspmd == 1) THEN
528 DO i=1,numnod
529 r4 = v(1,i)
530 CALL write_r_c(r4,1)
531 r4 = v(2,i)
532 CALL write_r_c(r4,1)
533 r4 = v(3,i)
534 CALL write_r_c(r4,1)
535 ENDDO
536 IF (numelig3d /= 0)THEN
537 DO i=1,64*numelig3d
538 r4 = v_temp(1,i)
539 CALL write_r_c(r4,1)
540 r4 = v_temp(2,i)
541 CALL write_r_c(r4,1)
542 r4 = v_temp(3,i)
543 CALL write_r_c(r4,1)
544 ENDDO
545 ENDIF
546 ELSE
547 DO i=1,numnodg
548 vg(1,i)=zero
549 vg(2,i)=zero
550 vg(3,i)=zero
551 ENDDO
552 DO k=1,numnod
553 i=nodglob(k)
554 vg(1,i)=v(1,k)
555 vg(2,i)=v(2,k)
556 vg(3,i)=v(3,k)
557 ENDDO
558
559 CALL spmd_glob_fsum9(vg,3*numnodg)
560
561 IF (ispmd==0) THEN
562 DO i=1,numnodg
563 CALL write_r_c(vg(1,i),1)
564 CALL write_r_c(vg(2,i),1)
565 CALL write_r_c(vg(3,i),1)
566 ENDDO
567 ENDIF
568 ENDIF
569
570C
571C option non parallelisee !
572 IF(nodcut>0)THEN
573 IF (nspmd > 1) THEN
574 IF (ispmd==0) THEN
575 print *, '** NODCUT NON PARALLELIZED OPTION'
576 END IF
577 GO TO 211
578 END IF
579 DO 210 i=1,nodcut
580 r4 =al(i)*v(1,ivois(2,i))+(one-al(i))*v(1,ivois(1,i))
581 CALL write_r_c(r4,1)
582 r4 =al(i)*v(2,ivois(2,i))+(one -al(i))*v(2,ivois(1,i))
583 CALL write_r_c(r4,1)
584 r4 =al(i)*v(3,ivois(2,i))+(one-al(i))*v(3,ivois(1,i))
585 CALL write_r_c(r4,1)
586 210 CONTINUE
587 211 CONTINUE
588 ENDIF
589C
590 IF(anim_ply > 0 ) THEN
591
592 IF(ispmd==0 .AND. nfnod_pxfemg>0) THEN
593 r4 = zero
594 DO i=1,nfnod_pxfemg
595 CALL write_r_c(r4,1)
596 CALL write_r_c(r4,1)
597 CALL write_r_c(r4,1)
598 ENDDO
599 ENDIF
600 ENDIF
601c----------------------------
602C nodes crk xfem
603c----------------------------
604 IF (anim_crk > 0 ) THEN
605 IF (ispmd == 0) THEN
606 r4 = zero
607 DO i=1,nfnod_crkxfemg
608 CALL write_r_c(r4,1)
609 CALL write_r_c(r4,1)
610 CALL write_r_c(r4,1)
611 ENDDO
612 ENDIF
613 ENDIF
614c----------------------------
615 IF (ispmd==0) THEN
616 r4 = 0.
617 DO i=1,nsect+nrwall+nnwl+nnsrg
618 CALL write_r_c(r4,1)
619 CALL write_r_c(r4,1)
620 CALL write_r_c(r4,1)
621 ENDDO
622 IF (nfvnod>0) THEN
623 r4 = 0.
624 DO i=1,nfvnod+3
625 CALL write_r_c(r4,1)
626 CALL write_r_c(r4,1)
627 CALL write_r_c(r4,1)
628 ENDDO
629 ENDIF
630 endif!(ISPMD==0)
631c----------------------------
632 300 CONTINUE
633 DEALLOCATE(vg)
634 RETURN
spmd_glob_fsum9
subroutine spmd_glob_fsum9(v, len)
Definition spmd_th.F:302

◆ velvecc21()

subroutine velvecc21 ( v,
v_temp,
integer, dimension(2,*) ivois,
al,
integer nodcut,
integer nnwl,
integer nnsrg,
integer, dimension(*) nodglob,
integer, dimension(*) weight,
integer nfvnod,
integer nfnod_pxfem,
integer nfnod_pxfemg,
vg21,
integer nfnod_crkxfemg )

Definition at line 645 of file velvec.F.

648C-----------------------------s------------------
649C I m p l i c i t T y p e s
650C-----------------------------------------------
651#include "implicit_f.inc"
652C-----------------------------------------------
653C C o m m o n B l o c k s
654C-----------------------------------------------
655#include "task_c.inc"
656#include "com01_c.inc"
657#include "com04_c.inc"
658#include "scr14_c.inc"
659#include "spmd_c.inc"
660C-----------------------------------------------
661C D u m m y A r g u m e n t s
662C-----------------------------------------------
663 INTEGER NODGLOB(*),WEIGHT(*)
664C REAL
665 my_real
666 . v(3,*),al(*),vg21(3,*),v_temp(3,*)
667C REAL
668 my_real
669 . s3000,s
670 REAL R4
671 INTEGER I,IVOIS(2,*),NODCUT,NNWL,K,P,BUF
672 INTEGER NNSRG,NFVNOD,NFNOD_PXFEM,NFNOD_PXFEMG,NFNOD_CRKXFEMG
673 my_real
674 . , DIMENSION(:,:), ALLOCATABLE :: v_tmp
675C-----------------------------------------------
676 s3000 = 3000.
677 s = zero
678C
679 IF (nspmd == 1) THEN
680 DO k=1,numnod
681 i=nodglob(k)
682 r4 = vg21(1,i)+v(1,k)
683 CALL write_r_c(r4,1)
684 r4 = vg21(2,i)+v(2,k)
685 CALL write_r_c(r4,1)
686 r4 = vg21(3,i)+v(3,k)
687 CALL write_r_c(r4,1)
688 ENDDO
689 IF (numelig3d /= 0)THEN
690 DO i=1,64*numelig3d
691 r4 = v_temp(1,i)
692 CALL write_r_c(r4,1)
693 r4 = v_temp(2,i)
694 CALL write_r_c(r4,1)
695 r4 = v_temp(3,i)
696 CALL write_r_c(r4,1)
697 ENDDO
698 ENDIF
699 ELSE
700 ALLOCATE(v_tmp(3,numnodg))
701 DO i=1,numnodg
702 v_tmp(1,i) =vg21(1,i)
703 v_tmp(2,i) =vg21(2,i)
704 v_tmp(3,i) =vg21(3,i)
705 ENDDO
706
707 DO k=1,numnod
708 i=nodglob(k)
709 v_tmp(1,i)=v_tmp(1,i)+v(1,k)
710 v_tmp(2,i)=v_tmp(2,i)+v(2,k)
711 v_tmp(3,i)=v_tmp(3,i)+v(3,k)
712 ENDDO
713
714 CALL spmd_glob_dsum9(v_tmp,3*numnodg)
715
716 IF(ispmd==0)THEN
717 DO i=1,numnodg
718 r4 = v_tmp(1,i)
719 CALL write_r_c(r4,1)
720 r4 = v_tmp(2,i)
721 CALL write_r_c(r4,1)
722 r4 = v_tmp(3,i)
723 CALL write_r_c(r4,1)
724 ENDDO
725 ENDIF
726 DEALLOCATE(v_tmp)
727 ENDIF
728C
729C option non parallelisee !
730 IF(nodcut>0)THEN
731 IF (nspmd > 1) THEN
732 IF (ispmd==0) THEN
733 print *, '** NODCUT NON PARALLELIZED OPTION'
734 END IF
735 GO TO 211
736 END IF
737 DO 210 i=1,nodcut
738 r4 =al(i)*v(1,ivois(2,i))+(one-al(i))*v(1,ivois(1,i))
739 CALL write_r_c(r4,1)
740 r4 =al(i)*v(2,ivois(2,i))+(one -al(i))*v(2,ivois(1,i))
741 CALL write_r_c(r4,1)
742 r4 =al(i)*v(3,ivois(2,i))+(one-al(i))*v(3,ivois(1,i))
743 CALL write_r_c(r4,1)
744 210 CONTINUE
745 211 CONTINUE
746 ENDIF
747C
748 IF(anim_ply > 0 ) THEN
749
750 IF(ispmd==0 .AND. nfnod_pxfemg>0) THEN
751 r4 = zero
752 DO i=1,nfnod_pxfemg
753 CALL write_r_c(r4,1)
754 CALL write_r_c(r4,1)
755 CALL write_r_c(r4,1)
756 ENDDO
757 ENDIF
758 ENDIF
759c----------------------------
760C nodes crk xfem
761c----------------------------
762 IF (anim_crk > 0 ) THEN
763 IF (ispmd == 0) THEN
764 r4 = zero
765 DO i=1,nfnod_crkxfemg
766 CALL write_r_c(r4,1)
767 CALL write_r_c(r4,1)
768 CALL write_r_c(r4,1)
769 ENDDO
770 ENDIF
771 ENDIF
772c----------------------------
773 IF (ispmd/=0) GOTO 300
774 r4 = 0.
775 DO i=1,nsect+nrwall+nnwl+nnsrg
776 CALL write_r_c(r4,1)
777 CALL write_r_c(r4,1)
778 CALL write_r_c(r4,1)
779 ENDDO
780C
781 IF (nfvnod>0) THEN
782 r4 = 0.
783 DO i=1,nfvnod+3
784 CALL write_r_c(r4,1)
785 CALL write_r_c(r4,1)
786 CALL write_r_c(r4,1)
787 ENDDO
788 ENDIF
789C
790 300 CONTINUE
791 RETURN

◆ velvecc22()

subroutine velvecc22 ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*), intent(in) iparg,
integer, intent(in) iflg,
integer, dimension(nixs,numels), intent(in) ixs,
integer, dimension(nixq,numelq), intent(in) ixq,
integer, dimension(numnod), intent(in) itab )

Definition at line 1067 of file velvec.F.

1068C-----------------------------------------------
1069C D e s c r i p t i o n
1070C-----------------------------------------------
1071C This subroutines writes at polyedra centroids :
1072C velocities (IFLG=1),
1073C momentum density (IFLG=2)
1074C internal forces (IFLG=3),
1075C for coupling interface 22. Free nodes are used
1076C as marker to plot centroid vectors
1077C(see input card for grnod_id)
1078C-----------------------------------------------
1079C M o d u l e s
1080C-----------------------------------------------
1081 USE initbuf_mod
1082 USE elbufdef_mod
1083 USE i22bufbric_mod
1084 USE i22edge_mod
1085 USE i22tri_mod
1086C-----------------------------------------------
1087C I m p l i c i t T y p e s
1088C-----------------------------------------------
1089#include "implicit_f.inc"
1090C-----------------------------------------------
1091C C o m m o n B l o c k s
1092C-----------------------------------------------
1093#include "com01_c.inc"
1094#include "com04_c.inc"
1095#include "param_c.inc"
1096C-----------------------------------------------
1097C D u m m y A r g u m e n t s
1098C-----------------------------------------------
1099 INTEGER, INTENT(IN) :: IPARG(NPARG,*), IFLG,IXS(NIXS,NUMELS),IXQ(NIXQ,NUMELQ),ITAB(NUMNOD)
1100 REAL R4
1101 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
1102 TYPE(BUF_MAT_),POINTER :: MBUF
1103 TYPE(G_BUFEL_),POINTER :: GBUF
1104C-----------------------------------------------
1105C L o c a l A r g u m e n t s
1106C-----------------------------------------------
1107 INTEGER :: NGM, IDLOCM, IBM,ICELLM,MLW,NCELL,NELm,NBF,NBL,ICELL,NIN,NODE_ID,IB,NG,I
1108 my_real :: rho_cell, rho(4), vfrac(4)
1109 REAL,DIMENSION(:,:),ALLOCATABLE :: BUFFER
1110C-----------------------------------------------
1111
1112 !---------------------------------------------------------!
1113 nbf = 1
1114 nbl = nb
1115 nin = 1
1116 !---------------------------------------------------------!
1117 ALLOCATE(buffer(3,numnod))
1118 buffer(:,:) = zero
1119
1120 DO ib=nbf,nbl
1121 icell = 0
1122 ncell = brick_list(nin,ib)%NBCUT
1123 DO WHILE (icell<=ncell) ! loop on polyhedron {1:NCELL} U {9}
1124 icell = icell +1
1125 IF (icell>ncell .AND. ncell/=0)icell=9
1126 ibm = brick_list(nin,ib)%POLY(icell)%WhereIsMain(4)
1127 icellm = brick_list(nin,ibm)%mainID
1128 IF(ibm==0)THEN
1129 ibm = ib
1130 icellm = 1
1131 ENDIF
1132 ngm = brick_list(nin,ibm)%NG
1133 idlocm = brick_list(nin,ibm)%IDLOC
1134 gbuf =>elbuf_tab(ngm)%GBUF
1135 mbuf =>elbuf_tab(ngm)%BUFLY(1)%MAT(1,1,1)
1136 nelm = iparg(2,ngm)
1137 mlw = iparg(1,ngm)
1138 IF(mlw==37)THEN
1139 !UVAR(I,1) : massic percentage of liquid * global density (rho1*V1/V : it needs to give liquid mass multiplying by element volume in aleconve.F)
1140 !UVAR(I,2) : density of gas
1141 !UVAR(I,3) : density of liquid
1142 !UVAR(I,4) : volumetric fraction of liquid
1143 !UVAR(I,5) : volumetric fraction of gas
1144 rho(1) = mbuf%VAR((3-1)*nelm+idlocm)
1145 rho(2) = mbuf%VAR((2-1)*nelm+idlocm)
1146 vfrac(1) = mbuf%VAR((4-1)*nelm+idlocm)
1147 vfrac(2) = mbuf%VAR((5-1)*nelm+idlocm)
1148 rho_cell = rho(1)*vfrac(1) + rho(2)*vfrac(2)
1149 ELSEIF(mlw==51)THEN
1150 rho(1) = zero
1151 rho(2) = zero
1152 rho_cell = zero
1153 ELSE
1154 rho_cell = gbuf%RHO(idlocm)
1155 ENDIF
1156 node_id = brick_list(nin,ib)%POLY(icell)%ID_FREE_NODE
1157 IF(node_id<=0)cycle ! not enough nodes in the group or SMP disabling
1158 IF(iflg==1)THEN
1159 !velocity vector : U
1160 buffer(1,node_id) = gbuf%MOM(nelm*(1-1) + idlocm) / rho_cell
1161 buffer(2,node_id) = gbuf%MOM(nelm*(2-1) + idlocm) / rho_cell
1162 buffer(3,node_id) = gbuf%MOM(nelm*(3-1) + idlocm) / rho_cell
1163 ELSEIF(iflg==2)THEN
1164 !momentum density vector : rho.U
1165 buffer(1,node_id) = gbuf%MOM(nelm*(1-1) + idlocm)
1166 buffer(2,node_id) = gbuf%MOM(nelm*(2-1) + idlocm)
1167 buffer(3,node_id) = gbuf%MOM(nelm*(3-1) + idlocm)
1168 ELSEIF(iflg==3)THEN
1169 !internal force at centroid = sum(integral(P.dS))
1170 buffer(1,node_id) = brick_list(nin,ibm)%FCELL(1)
1171 buffer(2,node_id) = brick_list(nin,ibm)%FCELL(2)
1172 buffer(3,node_id) = brick_list(nin,ibm)%FCELL(3)
1173 ELSE
1174 buffer(1,node_id) = zero
1175 buffer(2,node_id) = zero
1176 buffer(3,node_id) = zero
1177 ENDIF
1178 ENDDO !next ICELL
1179 enddo!next IB
1180
1181 DO i=1,numnod
1182 r4 = buffer(1,i)
1183 CALL write_r_c(r4,1)
1184 r4 = buffer(2,i)
1185 CALL write_r_c(r4,1)
1186 r4 = buffer(3,i)
1187 CALL write_r_c(r4,1)
1188 enddo!next I
1189
1190 DEALLOCATE(buffer)
1191 !---------------------------------------------------------!
1192
1193 RETURN
i22bufbric_mod
Definition cut-cell-search_mod.F:95
i22bufbric_mod::brick_list
type(brick_entity), dimension(:,:), allocatable, target brick_list
Definition cut-cell-search_mod.F:105
i22edge_mod
Definition cut-cell-buffer_mod.F:48
i22tri_mod
Definition cut-cell-search_mod.F:212
i22tri_mod::nb
integer nb
Definition cut-cell-search_mod.F:487
initbuf_mod
Definition initbuf.F:160

◆ velvecc_max()

subroutine velvecc_max ( vmax,
integer nodcut,
integer nnwl,
integer nnsrg,
integer nfvnod,
integer nfnod_pxfemg,
integer nfnod_crkxfemg )

Definition at line 801 of file velvec.F.

803C-----------------------------s------------------
804C I m p l i c i t T y p e s
805C-----------------------------------------------
806#include "implicit_f.inc"
807C-----------------------------------------------
808C C o m m o n B l o c k s
809C-----------------------------------------------
810#include "task_c.inc"
811#include "com01_c.inc"
812#include "com04_c.inc"
813#include "scr14_c.inc"
814#include "spmd_c.inc"
815C-----------------------------------------------
816C D u m m y A r g u m e n t s
817C-----------------------------------------------
818 my_real
819 . vmax(3,*)
820 REAL R4
821 INTEGER I,K,NODCUT,NNWL
822 INTEGER NNSRG,NFVNOD,NFNOD_PXFEM,NFNOD_PXFEMG,NFNOD_CRKXFEMG
823C-----------------------------------------------
824
825 IF (nspmd == 1) THEN
826 DO i=1,numnod
827 r4 = vmax(1,i)
828 CALL write_r_c(r4,1)
829 r4 = vmax(2,i)
830 CALL write_r_c(r4,1)
831 r4 = vmax(3,i)
832 CALL write_r_c(r4,1)
833 ENDDO
834 ELSE
835
836 IF (ispmd==0) THEN
837
838 DO i=1,numnodg
839 r4 = vmax(1,i)
840 CALL write_r_c(r4,1)
841 r4 = vmax(2,i)
842 CALL write_r_c(r4,1)
843 r4 = vmax(3,i)
844 CALL write_r_c(r4,1)
845 ENDDO
846 ENDIF
847 ENDIF
848
849C
850C option non parallelisee !
851 IF(nodcut>0)THEN
852 IF (nspmd > 1) THEN
853 IF (ispmd==0) THEN
854 print *, '** NODCUT NON PARALLELIZED OPTION'
855 END IF
856 GO TO 211
857 END IF
858 DO 210 i=1,nodcut ! put to zero for the moment option not supported
859 r4 =0.
860 CALL write_r_c(r4,1)
861 r4 =0.
862 CALL write_r_c(r4,1)
863 r4 =0.
864 CALL write_r_c(r4,1)
865 210 CONTINUE
866 211 CONTINUE
867 ENDIF
868C
869 IF(anim_ply > 0 ) THEN
870
871 IF(ispmd==0 .AND. nfnod_pxfemg>0) THEN
872 r4 = zero
873 DO i=1,nfnod_pxfemg
874 CALL write_r_c(r4,1)
875 CALL write_r_c(r4,1)
876 CALL write_r_c(r4,1)
877 ENDDO
878 ENDIF
879 ENDIF
880c----------------------------
881C nodes crk xfem
882c----------------------------
883 IF (anim_crk > 0 ) THEN
884 IF (ispmd == 0) THEN
885 r4 = zero
886 DO i=1,nfnod_crkxfemg
887 CALL write_r_c(r4,1)
888 CALL write_r_c(r4,1)
889 CALL write_r_c(r4,1)
890 ENDDO
891 ENDIF
892 ENDIF
893c----------------------------
894 IF (ispmd/=0) GOTO 300
895 r4 = 0.
896 DO i=1,nsect+nrwall+nnwl+nnsrg
897 CALL write_r_c(r4,1)
898 CALL write_r_c(r4,1)
899 CALL write_r_c(r4,1)
900 ENDDO
901C
902 IF (nfvnod>0) THEN
903 r4 = 0.
904 DO i=1,nfvnod+3
905 CALL write_r_c(r4,1)
906 CALL write_r_c(r4,1)
907 CALL write_r_c(r4,1)
908 ENDDO
909 ENDIF
910C
911 300 CONTINUE
912
913c----------------------------
914 RETURN