34 SUBROUTINE velvec(V,V_TEMP,IVOIS,AL,NODCUT,NNWL,NNSRG,
35 . NODGLOB,WEIGHT,NFVNOD,IFUNC,
36 . NFNOD_PXFEM,NOD,INDX,NFNOD_CRKXFEMG,ITAB)
44#include "implicit_f.inc"
56 INTEGER NODGLOB(*),WEIGHT(*),NOD(
57INTEGER,
INTENT(IN) :: ITAB(NUMNOD)
59 . v(3,numnod),al(*),v_temp(3,*)
63 REAL,
DIMENSION(:,:),
ALLOCATABLE :: PLYVELVEC
64 INTEGER I,IVOIS(2,*),NODCUT,NNWL,,P,BUF
65 INTEGER NNSRG,NFVNOD,IFUNC,NFNOD_PXFEM,ND,EMPL,NFNOD_CRKXFEMG
67 INTEGER N,IPLY,JJ,EMPSIZPL
83 IF (numelig3d /= 0)
THEN
104 print *,
'** NODCUT NON PARALLELIZED OPTION!'
109 r4 =al(i)*v(1,ivois(2,i))+(one-al(i))*v(1,ivois(1,i))
111 r4 =al(i)*v(2,ivois(2,i))+(one -al(i))*v(2,ivois(1,i))
113 r4 =al(i)*v(3,ivois(2,i))+(one-al(i))*v(3,ivois(1,i))
121 DO i=1,nsect+nrwall+nnwl+nnsrg
130 IF(anim_ply > 0 )
THEN
132 IF (nfnod_pxfem>0)
THEN
134 ALLOCATE(plyvelvec(3,nfnod_pxfem))
137 DO nd=1,
plynod(iply)%PLYNUMNODS
138 i =
plynod(iply)%NODES(nd)
139 empl =
plynod(iply)%PLYNODID(nd)
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)
147 DEALLOCATE(plyvelvec)
149 ELSEIF(ifunc == 2)
THEN
150 ALLOCATE(plyvelvec(3,nfnod_pxfem))
153 DO nd=1,
plynod(iply)%PLYNUMNODS
154 i =
plynod(iply)%NODES(nd)
155 empl =
plynod(iply)%PLYNODID(nd)
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)
163 DEALLOCATE(plyvelvec)
165 ELSEIF(ifunc == 3)
THEN
166 ALLOCATE(plyvelvec(3,nfnod_pxfem))
169 DO nd=1,
plynod(iply)%PLYNUMNODS
170 i =
plynod(iply)%NODES(nd)
171 empl =
plynod(iply)%PLYNODID(nd)
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)
179 DEALLOCATE(plyvelvec)
195 * nod, ifunc,empsizpl )
202 IF (anim_crk > 0 )
THEN
205 DO i=1,nfnod_crkxfemg
239 SUBROUTINE velvec2(IVOIS,V_TEMP,AL ,NODCUT,FOPT,
240 . NPBY,NNWL ,NNSRG,NODGLOB,WEIGHT,FR_SEC,
241 . NFVNOD,NFNOD_PXFEM,NFNOD_PXFEMG,NFNOD_CRKXFEMG)
246#include "implicit_f.inc"
250#include "param_c.inc"
252#include "com01_c.inc"
253#include "com04_c.inc"
254#include "scr14_c.inc"
261 . al(*),fopt(6,*),v_temp(3,*)
264 INTEGER IVOIS(2,*),NPBY(NNPBY,*),NODCUT,NNWL
265 INTEGER NNSRG,NFNOD_PXFEM,NFNOD_PXFEMG
266 INTEGER I,N,WEIGHT(*),FR_SEC(NSPMD+1,*)
268 INTEGER NODGLOB(*),K,P,RBUF,NNG
269 INTEGER NFVNOD,NFNOD_CRKXFEMG
273 my_real,
DIMENSION(:,:),
ALLOCATABLE :: rwa
274 my_real,
DIMENSION(:,:),
ALLOCATABLE :: rwal
275 my_real,
DIMENSION(:,:),
ALLOCATABLE :: v
276 INTEGER LOC_PROC,PMAIN
278 CALL my_alloc(rwa,3,nsect)
279 CALL my_alloc(rwal,3,nrwall)
280 CALL my_alloc(v,3,numnod)
292 v(1,i) = fopt(1,nsect+n)
293 v(2,i) = fopt(2,nsect+n)
294 v(3,i) = fopt(3,nsect+n)
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)
320 IF (numelig3d /= 0)
THEN
346 print *,
'** NODCUT NON PARALLELIZED OPTION'
351 r4 =al(i)*v(1,ivois(2,i))+(one -al(i))*v(1,ivois(1,i))
353 r4 =al(i)*v(2,ivois(2,i))+(one -al(i))*v(2,ivois(1,i))
355 r4 =al(i)*v(3,ivois(2,i))+(one -al(i))*v(3,ivois(1,i))
372 pmain = fr_sec(nspmd+1,i)
373 IF (pmain ==loc_proc)
THEN
399 r4 = fopt(1,nsect+nrbody+i)
401 r4 = fopt(2,nsect+nrbody+i)
403 r4 = fopt(3,nsect+nrbody+i)
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)
425 IF (ispmd/=0)
GO TO 300
439 IF(anim_ply > 0 )
THEN
440 IF(ispmd==0 .AND. nfnod_pxfemg>0)
THEN
452 IF (anim_crk > 0 )
THEN
455 DO i=1,nfnod_crkxfemg
489 SUBROUTINE velvecc(V,V_TEMP,IVOIS,AL,NODCUT,NNWL,NNSRG,
490 . NODGLOB,WEIGHT,NFVNOD,NFNOD_PXFEM,
491 . NFNOD_PXFEMG,NFNOD_CRKXFEMG)
496#include "implicit_f.inc"
501#include "com01_c.inc"
502#include "com04_c.inc"
503#include
"scr14_c.inc"
508 INTEGER NODGLOB(*),WEIGHT(*)
511 . V(3,*),AL(*),V_TEMP(3,*)
516 INTEGER I,IVOIS(2,*),NODCUT,NNWL,K,P,BUF
517 INTEGER NNSRG,NFVNOD,NFNOD_PXFEM,NFNOD_PXFEMG,NFNOD_CRKXFEMG
521 REAL,
DIMENSION(:,:),
ALLOCATABLE :: VG
523 CALL my_alloc(vg,3,numnodg)
536 IF (numelig3d /= 0)
THEN
575 print *,
'** NODCUT NON PARALLELIZED OPTION'
580 r4 =al(i)*v(1,ivois(2,i))+(one-al(i))*v(1,ivois(1,i))
582 r4 =al(i)*v(2,ivois(2,i))+(one -al(i))*v(2,ivois(1,i))
584 r4 =al(i)*v(3,ivois(2,i))+(one-al(i))*v(3,ivois(1,i))
590 IF(anim_ply > 0 )
THEN
592 IF(ispmd==0 .AND. nfnod_pxfemg>0)
THEN
604 IF (anim_crk > 0 )
THEN
607 DO i=1,nfnod_crkxfemg
617 DO i=1,nsect+nrwall+nnwl+nnsrg
646 . NNSRG,NODGLOB,WEIGHT,NFVNOD,NFNOD_PXFEM,
647 . NFNOD_PXFEMG,VG21,NFNOD_CRKXFEMG)
651#include "implicit_f.inc"
656#include "com01_c.inc"
657#include "com04_c.inc"
658#include "scr14_c.inc"
663 INTEGER NODGLOB(*),WEIGHT(*)
666 . V(3,*),AL(*),VG21(3,*),V_TEMP(3,*)
671 INTEGER I,IVOIS(2,*),NODCUT,NNWL,K,P,BUF
672 INTEGER NNSRG,,NFNOD_PXFEM,NFNOD_PXFEMG,NFNOD_CRKXFEMG
674 . ,
DIMENSION(:,:),
ALLOCATABLE :: v_tmp
682 r4 = vg21(1,i)+v(1,k)
684 r4 = vg21(2,i)+v(2,k)
686 r4 = vg21(3,i)+v(3,k)
689 IF (numelig3d /= 0)
THEN
700 ALLOCATE(v_tmp(3,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)
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)
733 print *,
'** NODCUT NON PARALLELIZED OPTION'
738 r4 =al(i)*v(1,ivois(2,i))+(one-al(i))*v(1,ivois(1,i))
740 r4 =al(i)*v(2,ivois(2,i))+(one -al(i))*v(2,ivois(1,i))
742 r4 =al(i)*v(3,ivois(2,i))+(one-al(i))*v(3,ivois(1,i))
748 IF(anim_ply > 0 )
THEN
750 IF(ispmd==0 .AND. nfnod_pxfemg>0)
THEN
762 IF (anim_crk > 0 )
THEN
765 DO i=1,nfnod_crkxfemg
773 IF (ispmd/=0)
GOTO 300
775 DO i=1,nsect+nrwall+nnwl+nnsrg
802 . NFNOD_PXFEMG,NFNOD_CRKXFEMG)
806#include "implicit_f.inc"
811#include "com01_c.inc"
812#include "com04_c.inc"
813#include "scr14_c.inc"
821 INTEGER I,K,NODCUT,NNWL
822 INTEGER NNSRG,NFVNOD,NFNOD_PXFEM,NFNOD_PXFEMG,NFNOD_CRKXFEMG
854 print *,
'** NODCUT NON PARALLELIZED OPTION'
869 IF(anim_ply > 0 )
THEN
871 IF(ispmd==0 .AND. nfnod_pxfemg>0)
THEN
883 IF (anim_crk > 0 )
THEN
886 DO i=1,nfnod_crkxfemg
894 IF (ispmd/=0)
GOTO 300
896 DO i=1,nsect+nrwall+nnwl+nnsrg
927 SUBROUTINE velvec3(V,V_TEMP,VALE,IVOIS,AL,NODCUT,NNWL,NNSRG,
928 . NODGLOB,WEIGHT,NFVNOD,NFNOD_PXFEM,NFNOD_PXFEMG,
934#include "implicit_f.inc"
939#include "com01_c.inc"
940#include "com04_c.inc"
942#include "scr14_c.inc"
946 INTEGER NODGLOB(*),WEIGHT(*)
949 . V(3,*),VALE(3,*),AL(*),V_TEMP(3,*)
954 INTEGER ,IVOIS(2,*),NODCUT,NNWL,K
955INTEGER NNSRG,NFVNOD,NFNOD_PXFEM,NFNOD_PXFEMG
959 my_real,
DIMENSION(:,:),
ALLOCATABLE :: vglobal
961 CALL my_alloc(vglobal,3,numnod)
975 r4 = v(2,i)+vale(2,i)
977 r4 = v(3,i)+vale(3,i)
980 IF (numelig3d /= 0)
THEN
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)
1002 print *,
'** NODCUT NON PARALLELIZED OPTION'
1006 IF (ispmd/=0)
GOTO 300
1008 DO i=1,nsect+nrwall+nnwl+nnsrg
1014 IF(anim_ply > 0 )
THEN
1015 IF(ispmd==0 .AND. nfnod_pxfemg>0)
THEN
1027 IF (anim_crk > 0 )
THEN
1028 IF (ispmd == 0)
THEN
1030 DO i=1,nfnod_crkxfemg
1038 IF (ispmd==0.AND.nfvnod>0)
THEN
1058!||--- calls -----------------------------------------------------
1089#include "implicit_f.inc"
1093#include "com01_c.inc"
1094#include "com04_c.inc"
1095#include "param_c.inc"
1099 INTEGER,
INTENT(IN) :: IPARG(NPARG,*), IFLG,IXS(NIXS,NUMELS),IXQ(NIXQ,NUMELQ),ITAB(NUMNOD)
1101 TYPE (ELBUF_STRUCT_),
DIMENSION(NGROUP),
TARGET :: ELBUF_TAB
1102 TYPE(BUF_MAT_),
POINTER :: MBUF
1103 TYPE(G_BUFEL_),
POINTER :: GBUF
1107 INTEGER :: NGM, IDLOCM, ,ICELLM,MLW,NCELL,NELm,NBF,NBL,ICELL,NIN,NODE_ID
1109 REAL,
DIMENSION(:,:),
ALLOCATABLE
1117 ALLOCATE(buffer(3,numnod))
1123 DO WHILE (icell<=ncell)
1125 IF (icell>ncell .AND. ncell/=0)icell=9
1126 ibm =
brick_list(nin,ib)%POLY(icell)%WhereIsMain(4)
1134 gbuf =>elbuf_tab(ngm)%GBUF
1135 mbuf =>elbuf_tab(ngm)%BUFLY(1)%MAT(1,1,1)
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)
1154 rho_cell = gbuf%RHO(idlocm)
1156 node_id =
brick_list(nin,ib)%POLY(icell)%ID_FREE_NODE
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
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)
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)
1174 buffer(1,node_id) = zero
1175 buffer(2,node_id) = zero
1176 buffer(3,node_id) = zero
subroutine velvecc(v, v_temp, ivois, al, nodcut, nnwl, nnsrg, nodglob, weight, nfvnod, nfnod_pxfem, nfnod_pxfemg, nfnod_crkxfemg)
subroutine velvecc_max(vmax, nodcut, nnwl, nnsrg, nfvnod, nfnod_pxfemg, nfnod_crkxfemg)
subroutine velvecc22(elbuf_tab, iparg, iflg, ixs, ixq, itab)
subroutine velvec(v, v_temp, ivois, al, nodcut, nnwl, nnsrg, nodglob, weight, nfvnod, ifunc, nfnod_pxfem, nod, indx, nfnod_crkxfemg, itab)
subroutine velvec3(v, v_temp, vale, 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 velvec2(ivois, v_temp, al, nodcut, fopt, npby, nnwl, nnsrg, nodglob, weight, fr_sec, nfvnod, nfnod_pxfem, nfnod_pxfemg, nfnod_crkxfemg)
type(brick_entity), dimension(:,:), allocatable, target brick_list
type(plynods), dimension(:), allocatable plynod
type(ply_data), dimension(:), allocatable ply
subroutine spmd_anim_ply_velvec(nodglob, iply, nod_pxfem, ifunc, empsizpl)
subroutine spmd_glob_dsum9(v, len)
subroutine spmd_glob_fsum9(v, len)
subroutine spmd_velvec2(v, nodglob, rbuf, numpog)
subroutine spmd_vgath(x, nodglob, weight, num)
void write_r_c(float *w, int *len)