42 . ELBUF_TAB ,SOLID_VECTOR ,IFUNC ,IPARG ,GEO ,
43 . IXQ ,IXS ,IXTG ,PM ,
45 . NBF_L ,EHOUR ,ANIM ,NBPART ,IADG ,
46 . IPM ,IGEO ,THKE ,ERR_THK_SH4 ,ERR_THK_SH3 ,
48 . NV46 ,NERCVOIS ,NESDVOIS ,LERCVOIS ,LESDVOIS ,
49 . STACK ,ID_ELEM ,ITY_ELEM ,IPARTS ,LAYER_INPUT ,
50 . IR_INPUT ,IS_INPUT ,IT_INPUT ,IUVAR_INPUT ,H3D_PART ,
51 . IS_WRITTEN_SOLID,INFO1 ,KEYWORD ,FANI_CELL ,
52 . H3D_DATA ,MULTI_FVM)
64 use element_mod ,
only : nixs,nixq,nixtg
68#include "implicit_f.inc"
72#include "vect01_c.inc"
82 . solid_vector(3,*),x(3,numnod),v(3,numnod),w(3,numnod),thke(*),ehour(*),geo(npropg,numgeo),
83 . anim(*),pm(npropm,nummat),err_thk_sh4(*), err_thk_sh3(*)
84 INTEGER IPARG(NPARG,NGROUP),IXS(NIXS,NUMELS),IXTG(NIXTG,NUMELTG),EL2FA(*),
85 . IXQ(NIXQ,NUMELQ),IFUNC,NBF,
86 . IADP(*),NBF_L, NBPART,IADG(NSPMD,*),IPM(NPROPMI,NUMMAT),
87 . IGEO(NPROPGI,NUMGEO),INVERT(*), NV46,ID_ELEM(*),ITY_ELEM(*),IPARTS(*),
88 . (*),IS_WRITTEN_SOLID(*),INFO1,LAYER_INPUT,IR_INPUT,IS_INPUT,IT_INPUT,
90 TYPE (ELBUF_STRUCT_),
DIMENSION(NGROUP),
TARGET :: ELBUF_TAB
91 TYPE (STACK_PLY) :: STACK
92 CHARACTER(LEN=NCHARLINE100) :: KEYWORD
93 TYPE(FANI_CELL_),
INTENT(IN) :: FANI_CELL
94 TYPE (H3D_DATABASE) :: H3D_DATA
95 TYPE (MULTI_FVM_STRUCT),
INTENT(IN) :: MULTI_FVM
100 INTEGER I,NG,NEL,NPTR,NPTS,NPTT,NLAY,ILAY,IR,IS,IT,MLW,OFFSET,
101 . nercvois(*),nesdvois(*),lercvois(*),lesdvois(*),iuvar,
102 . isolnod,ivisc,nptg,tshell,tsh_ort,iok_part(mvsiz),jj(6),is_written_value(mvsiz)
103 TYPE(g_bufel_) ,
POINTER :: GBUF
104 TYPE(l_bufel_) ,
POINTER :: LBUF
105 TYPE(buf_mat_) ,
POINTER :: MBUF
108 is_written_solid(i) = 0
115 2 mlw ,nel ,nft ,iad ,ity ,
116 3 npt ,jale ,ismstr ,jeul ,jtur ,
117 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
118 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
119 6 irep ,iint ,igtyp ,israt ,isrot ,
120 7 icsen ,isorth ,isorthg ,ifailure,jsms )
123 isolnod = iparg(28,ng)
135 is_written_value(i) = 0
140 IF (jcvt==1.AND.isorth/=0) jcvt=2
142 gbuf => elbuf_tab(ng)%GBUF
143 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
144 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
145 nlay = elbuf_tab(ng)%NLAY
146 nptr = elbuf_tab(ng)%NPTR
147 npts = elbuf_tab(ng)%NPTS
148 nptt = elbuf_tab(ng)%NPTT
149 nptg = nptt*npts*nptr*nlay
152 IF (igtyp==20 .OR. igtyp==21 .OR. igtyp==22) tshell = 1
153 IF (igtyp==21 .OR. igtyp==22) tsh_ort = 1
154 IF (ity == 1) offset = 0
158 id_elem(offset+nft+i) = ixs(nixs,nft+i)
159 ity_elem(offset+nft+i) = 1
160 IF( h3d_part(iparts(nft+i)) == 1) iok_part
169 IF (ilay == -2) ilay = 1
170 IF (ilay == -3) ilay = nlay
172 IF (keyword ==
'VECT/VEL')
THEN
176 value(1) = multi_fvm%VEL(1, i + nft
177 value(2) = multi_fvm%VEL(2, i + nft)
178 value(3) = multi_fvm%VEL(3, i + nft)
183 IF(gbuf%G_MOM>0 )
THEN
184 value(1) = gbuf%MOM(jj(1) + i) / gbuf%RHO(i)
185 value(2) = gbuf%MOM(jj(2) + i) / gbuf%RHO(i)
186 value(3) = gbuf%MOM(jj(3) + i) / gbuf%RHO(i)
193 IF (keyword ==
'VECT/CONT')
THEN
197 value(1) = fani_cell%F18(1,i+nft)
198 value(2) = fani_cell%F18(2,i+nft)
199 value(3) = fani_cell%F18(3,i+nft)
200 CALL h3d_write_vector(iok_part,is_written_solid,solid_vector,i,offset,nft,
VALUE
205 IF (keyword ==
'VECT/ACC')
THEN
207 IF (mlw == 151 .AND.
ALLOCATED(multi_fvm%ACC))
THEN
209 value(1) = multi_fvm%ACC(1, i + nft)
210 value(2) = multi_fvm%ACC(2, i + nft)
211 value(3) = multi_fvm%ACC(3, i + nft)
212 CALL h3d_write_vector(iok_part,is_written_solid,solid_vector,i,offset,nft,
VALUE)
subroutine h3d_solid_vector(elbuf_tab, solid_vector, ifunc, iparg, geo, ixq, ixs, ixtg, pm, el2fa, nbf, iadp, nbf_l, ehour, anim, nbpart, iadg, ipm, igeo, thke, err_thk_sh4, err_thk_sh3, invert, x, v, w, nv46, nercvois, nesdvois, lercvois, lesdvois, stack, id_elem, ity_elem, iparts, layer_input, ir_input, is_input, it_input, iuvar_input, h3d_part, is_written_solid, info1, keyword, fani_cell, h3d_data, multi_fvm)
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)