52
53
54
56 USE elbufdef_mod
60 USE multi_fvm_mod
63
64
65
66#include "implicit_f.inc"
67
68
69
70#include "vect01_c.inc"
71#include "mvsiz_p.inc"
72#include "com01_c.inc"
73#include "com04_c.inc"
74#include "scr14_c.inc"
75#include "param_c.inc"
76
77
78
80 . solid_vector(3,*),x(3,numnod),v(3,numnod),w(3,numnod),thke(*),ehour(*),geo(npropg,numgeo),
81 . anim(*),pm(npropm,nummat),err_thk_sh4(*), err_thk_sh3(*)
82 INTEGER IPARG(NPARG,NGROUP),IXS(NIXS,NUMELS),IXTG(NIXTG,NUMELTG),EL2FA(*),
83 . IXQ(NIXQ,NUMELQ),IFUNC,NBF,
84 . IADP(*),NBF_L, NBPART,(NSPMD,*),IPM(NPROPMI,NUMMAT),
85 . IGEO(NPROPGI,NUMGEO),INVERT(*), NV46,ID_ELEM(*),ITY_ELEM(*),IPARTS(*),
86 . H3D_PART(*),IS_WRITTEN_SOLID(*),INFO1,LAYER_INPUT,IR_INPUT,IS_INPUT,IT_INPUT,
87 . IUVAR_INPUT
88 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
89 TYPE (STACK_PLY) :: STACK
90 CHARACTER(LEN=NCHARLINE100) :: KEYWORD
91 TYPE(FANI_CELL_), INTENT(IN) :: FANI_CELL
92 TYPE (H3D_DATABASE) :: H3D_DATA
93 TYPE (MULTI_FVM_STRUCT), INTENT(IN) :: MULTI_FVM
94
95
96
98 INTEGER I,NG,NEL,NPTR,NPTS,NPTT,NLAY,ILAY,IR,IS,IT,MLW,OFFSET,
99 . NERCVOIS(*),NESDVOIS(*),LERCVOIS(*),LESDVOIS(*),IUVAR,IDX,ILEN,IPOS,
100 . ISOLNOD,IVISC,NPTG,TSHELL,TSH_ORT,IOK_PART(MVSIZ),JJ(6),IS_WRITTEN_VALUE(MVSIZ)
101 TYPE(G_BUFEL_) ,POINTER :: GBUF
102 TYPE(L_BUFEL_) ,POINTER :: LBUF
103 TYPE(BUF_MAT_) ,POINTER :: MBUF
104
105 DO i=1,numels
106 is_written_solid(i) = 0
107 ENDDO
108
109
110 DO ng=1,ngroup
111
113 2 mlw ,nel ,nft ,iad ,ity ,
114 3 npt ,jale ,ismstr ,jeul ,jtur ,
115 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
116 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
117 6 irep ,iint ,igtyp ,israt ,isrot ,
118 7 icsen ,isorth ,isorthg ,ifailure,jsms )
119 IF (mlw /= 13) THEN
120 nft = iparg(3,ng)
121 isolnod = iparg(28,ng)
122 ivisc = iparg(61,ng)
123 iok_part(1:nel) = 0
124 lft=1
125 llt=nel
126
127 DO i=1,6
128 jj(i) = nel*(i-1)
129 ENDDO
130
131 value(1:3) = zero
132 DO i=1,nel
133 is_written_value(i) = 0
134 ENDDO
135
136 IF (ity == 1) THEN
137
138 IF (jcvt==1.AND.isorth/=0) jcvt=2
139
140 gbuf => elbuf_tab(ng)%GBUF
141 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
142 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
143 nlay = elbuf_tab(ng)%NLAY
144 nptr = elbuf_tab(ng)%NPTR
145 npts = elbuf_tab(ng)%NPTS
146 nptt = elbuf_tab(ng)%NPTT
147 nptg = nptt*npts*nptr*nlay
148 tshell = 0
149 tsh_ort = 0
150 IF (igtyp==20 .OR. igtyp==21 .OR. igtyp==22) tshell = 1
151 IF (igtyp==21 .OR. igtyp==22) tsh_ort = 1
152 IF (ity == 1) offset = 0
153
154 DO i=1,nel
155 IF (ity == 1) THEN
156 id_elem(offset+nft+i) = ixs(nixs,nft+i)
157 ity_elem(offset+nft+i) = 1
158 IF( h3d_part(iparts(nft+i)) == 1) iok_part(i) = 1
159 ENDIF
160 ENDDO
161
162 ilay = layer_input
163 iuvar = iuvar_input
164 ir = ir_input
165 is = is_input
166 it = it_input
167 IF (ilay == -2) ilay = 1
168 IF (ilay == -3) ilay = nlay
169
170 IF (keyword == 'VECT/VEL') THEN
171
172 IF (mlw == 151) THEN
173 DO i = 1, nel
174 value(1) = multi_fvm%VEL(1, i + nft)
175 value(2) = multi_fvm%VEL(2, i + nft)
176 value(3) = multi_fvm%VEL(3, i + nft)
177 CALL h3d_write_vector(iok_part,is_written_solid,solid_vector,i,offset,nft,
VALUE)
178 ENDDO
179 ELSE
180 DO i=1,nel
181 IF(gbuf%G_MOM>0 )THEN
182 value(1) = gbuf%MOM(jj(1) + i) / gbuf%RHO(i)
183 value(2) = gbuf%MOM(jj(2) + i) / gbuf%RHO(i)
184 value(3) = gbuf%MOM(jj(3) + i) / gbuf%RHO(i)
185 CALL h3d_write_vector(iok_part,is_written_solid,solid_vector,i,offset,nft,
VALUE)
186 ENDIF
187 ENDDO
188 ENDIF
189 ENDIF
190
191 IF (keyword == 'VECT/CONT') THEN
192
193 IF (mlw == 151) THEN
194 DO i = 1, nel
198 CALL h3d_write_vector(iok_part,is_written_solid,solid_vector,i,offset,nft,
VALUE)
199 ENDDO
200 ENDIF
201 ENDIF
202
203 IF (keyword == 'VECT/ACC') THEN
204
205 IF (mlw == 151 .AND. ALLOCATED(multi_fvm%ACC)) THEN
206 DO i = 1, nel
207 value(1) = multi_fvm%ACC(1, i + nft)
208 value(2) = multi_fvm%ACC(2, i + nft)
209 value(3) = multi_fvm%ACC(3, i + nft)
211 ENDDO
212 ENDIF
213 ENDIF
214
215 ENDIF
216 ENDIF
217
218 enddo
219
220 RETURN
subroutine h3d_write_vector(iok_part, is_written, vector, i, offset, nft, value)
type(fani_cell_) fani_cell
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)
integer, parameter ncharline100