53
54
55
57 USE elbufdef_mod
61 USE multi_fvm_mod
64 use element_mod , only : nixs,nixq,nixtg
65
66
67
68#include "implicit_f.inc"
69
70
71
72#include "vect01_c.inc"
73#include "mvsiz_p.inc"
74#include "com01_c.inc"
75#include "com04_c.inc"
76#include "scr14_c.inc"
77#include "param_c.inc"
78
79
80
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(,NGROUP),IXS(NIXS,NUMELS),(NIXTG,NUMELTG),EL2FA(*),
85 . IXQ(NIXQ,NUMELQ),IFUNC,,
86 . IADP(*),NBF_L, NBPART,IADG(NSPMD,*),IPM(NPROPMI,NUMMAT),
87 . IGEO(NPROPGI,NUMGEO),INVERT(*), NV46,ID_ELEM(*),ITY_ELEM(*),IPARTS(*),
88 . H3D_PART(*),IS_WRITTEN_SOLID(*),INFO1,LAYER_INPUT,IR_INPUT,IS_INPUT,IT_INPUT,
89 . IUVAR_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
96
97
98
100 INTEGER I,NG,NEL,NPTR,NPTS,NPTT,NLAY,ILAY,,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 ::
106
107 DO i=1,numels
108 is_written_solid(i) = 0
109 ENDDO
110
111
112 DO ng=1,ngroup
113
115 2 mlw ,nel ,nft ,iad
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 )
121 IF (mlw /= 13) THEN
122 nft = iparg(3,ng)
123 isolnod = iparg(28,ng)
124 ivisc = iparg(61,ng)
125 iok_part(1:nel) = 0
126 lft=1
127 llt=nel
128
129 DO i=1,6
130 jj(i) = nel*(i-1)
131 ENDDO
132
133 value(1:3) = zero
134 DO i=1,nel
135 is_written_value(i) = 0
136 ENDDO
137
138 IF (ity == 1) THEN
139
140 IF (jcvt==1.AND.isorth/=0) jcvt=2
141
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
150 tshell = 0
151 tsh_ort = 0
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
155
156 DO i=1,nel
157 IF (ity == 1) THEN
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(i) = 1
161 ENDIF
162 ENDDO
163
164 ilay = layer_input
165 iuvar = iuvar_input
166 ir = ir_input
167 is = is_input
168 it = it_input
169 IF (ilay == -2) ilay = 1
170 IF (ilay == -3) ilay = nlay
171
172 IF (keyword == 'VECT/VEL') THEN
173
174 IF (mlw == 151) THEN
175 DO i = 1, nel
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)
179 CALL h3d_write_vector(iok_part,is_written_solid,solid_vector,i,offset,nft,
VALUE)
180 ENDDO
181 ELSE
182 DO i=1,nel
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)
187 CALL h3d_write_vector(iok_part,is_written_solid,solid_vector,i,offset,nft,
VALUE)
188 ENDIF
189 ENDDO
190 ENDIF
191 ENDIF
192
193 IF (keyword == 'VECT/CONT') THEN
194
195 IF (mlw == 151) THEN
196 DO i = 1, nel
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)
201 ENDDO
202 ENDIF
203 ENDIF
204
205 IF (keyword == 'VECT/ACC') THEN
206
207 IF (mlw == 151 .AND. ALLOCATED(multi_fvm%ACC)) THEN
208 DO i = 1, nel
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)
213 ENDDO
214 ENDIF
215 ENDIF
216
217 ENDIF
218 ENDIF
219
220 enddo
221
222 RETURN
subroutine h3d_write_vector(iok_part, is_written, vector, i, offset, nft, value)
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