60
61
62
63 USE elbufdef_mod
65 USE multi_fvm_mod
69 USE matparam_def_mod, ONLY : matparam_struct_
70 use glob_therm_mod
71 use element_mod , only : nixs
72
73
74
75#include "implicit_f.inc"
76
77
78
79#include "mvsiz_p.inc"
80
81
82
83#include "com01_c.inc"
84#include "com04_c.inc"
85#include "param_c.inc"
86#include "scr03_c.inc"
87#include "scr17_c.inc"
88#include "scry_c.inc"
89#include "sphcom.inc"
90#include "vect01_c.inc"
91
92
93
94 INTEGER IXS(NIXS,*),IPARG(NPARG,NGROUP),
95 . IPARG_GR(NPARG),IPARTS(*),IGEO(NPROPGI,*),
96 . IPM(NPROPMI,NUMMAT),IPART(LIPART1,*),PTSOL(*),
97 . NG, NSIGI ,NVC,NEL,IUSER, NSIGS, NPF(*),
98 . STRSGLOB(*),STRAGLOB(*),FAIL_INI(*),
99 . KXSP(NISP,*), IPARTSP(*), NOD2SP(*)
100
101 . mas(*), pm(npropm,nummat), x(3,*), geo(npropg,*),
102 . dtelem(*),sigi(nsigs,*),skew(lskew,*),stifn(*),
103 . partsav(20,*), v(3, *), mss(8,*),
104 . sigsp(nsigi,*),msnf(*), mssf(8,*), wma(*),
105 . volnod(*), bvolnod(*), vns(8,*), bns(8,*),
106 . in(*),vr(*), ins(8,*),bufmat(*),
107 . mcp(*), mcps(8,*), temp(*),
108 . xrefs(8,3,*), tf(*), mssa(*),
109 . spbuf(nspbuf,*)
110 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
111 INTEGER,INTENT(IN) :: ILOADP(SIZLOADP,*)
112 my_real,
INTENT(IN) :: facload(lfacload,*)
113 TYPE(MULTI_FVM_STRUCT) :: MULTI_FVM
114 LOGICAL :: ERROR_THROWN
115 TYPE(DETONATORS_STRUCT_) :: DETONATORS
116 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
117 TYPE(MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(IN) :: MAT_PARAM
118 type (glob_therm_) ,intent(in) :: glob_therm
119
120
121
122 INTEGER I, NF1, IBID, JHBE, IREP,IGTYP, NUVAR, IDEF,
123 . IPT,LVLOC,IPID1,NPTR,NPTS,NPTT,NLAY,
124 . L_PLA
125 INTEGER MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ),
126 . IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ),
127 . IX5(MVSIZ),IX6(MVSIZ),IX7(MVSIZ),IX8(MVSIZ)
129 . volu(mvsiz),dtx(mvsiz),
130 . x1(mvsiz),x2(mvsiz),x3(mvsiz),x4(mvsiz),x5(mvsiz),x6(mvsiz),
131 . x7(mvsiz),x8(mvsiz),y1(mvsiz),y2(mvsiz),y3(mvsiz),y4(mvsiz),
132 . y5(mvsiz),y6(mvsiz),y7(mvsiz),y8(mvsiz),z1(mvsiz),z2(mvsiz),
133 . z3(mvsiz),z4(mvsiz),z5(mvsiz),z6(mvsiz),z7(mvsiz),z8(mvsiz),
134 . rx(mvsiz) ,ry(mvsiz) ,rz(mvsiz) ,sx(mvsiz) ,
135 . sy(mvsiz) ,sz(mvsiz) ,tx(mvsiz) ,ty(mvsiz) ,tz(mvsiz) ,
136 . e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),
137 . e2x(mvsiz),e2y(mvsiz),e2z(mvsiz),
138 . e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),
139 . f1x(mvsiz) ,f1y(mvsiz) ,f1z(mvsiz) ,
140 . f2x(mvsiz) ,f2y(mvsiz) ,f2z(mvsiz),rhocp(mvsiz),temp0(mvsiz),
141 . px1(mvsiz),px2(mvsiz),px3(mvsiz),px4(mvsiz),
142 . py1(mvsiz),py2(mvsiz),py3(mvsiz),py4(mvsiz),
143 . pz1(mvsiz),pz2(mvsiz),pz3(mvsiz),pz4(mvsiz),
144 . rhof(mvsiz),
alpha(mvsiz), deltax(mvsiz), aire(mvsiz), dummy, pres, vfrac
147 . bid, fv, sti
148 double precision
149 . xd1(mvsiz), xd2(mvsiz), xd3(mvsiz), xd4(mvsiz),
150 . xd5(mvsiz), xd6(mvsiz), xd7(mvsiz), xd8(mvsiz),
151 . yd1(mvsiz), yd2(mvsiz), yd3(mvsiz), yd4(mvsiz),
152 . yd5(mvsiz), yd6(mvsiz), yd7(mvsiz), yd8(mvsiz),
153 . zd1(mvsiz), zd2(mvsiz), zd3(mvsiz), zd4(mvsiz),
154 . zd5(mvsiz), zd6(mvsiz), zd7(mvsiz), zd8(mvsiz),voldp(mvsiz)
155 INTEGER :: ILAY, MATLAW
156
157 CHARACTER(LEN=NCHARTITLE) :: TITR1
158 parameter(lvloc = 51)
159
160 TYPE(L_BUFEL_) ,POINTER :: LBUF
161 TYPE(G_BUFEL_) ,POINTER :: GBUF
162 TYPE(BUF_MAT_) ,POINTER :: MBUF
163 TYPE(BUF_LAY_) ,POINTER :: BUFLY
164
165
166
167
168 gbuf => elbuf_str%GBUF
169
170 nlay = elbuf_str%NLAY
171
172 nf1=nft+1
173
174 jhbe = iparg_gr(23)
175 irep = iparg_gr(35)
176 jcvt = iparg_gr(37)
177 igtyp = iparg_gr(38)
178 IF (jcvt==1.AND.isorth/=0) jcvt=2
179 idef = 0
180 bid = zero
181 ibid = 0
182 nptr = elbuf_str%NPTR
183 npts = elbuf_str%NPTS
184 nptt = elbuf_str%NPTT
185
186 tempel(:) = zero
187 DO i=1,nel
188 rhocp(i) = pm(69,ixs(1,nft+i))
189 temp0(i) = pm(79,ixs(1,nft+i))
190
191 rhof(i) = pm(192,ixs(1,nft+i))
192 alpha(i) = pm(193,ixs(1,nft+i))
193 ENDDO
194
195 IF (ismstr==10.OR.ismstr==12) THEN
196 CALL scoor3(x,xrefs(1,1,nf1),ixs(1,nf1), geo ,mat ,pid ,ngl ,
197 . ix1 ,ix2 ,ix3 ,ix4 ,ix5 ,ix6 ,ix7 ,ix8 ,
198 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
199 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
200 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
201 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
202 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
203 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,temp0,temp ,glob_therm%NINTEMP,
204 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
205 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
206 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 )
208 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
209 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
210 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
211 . gbuf%JAC_I ,nel)
212 END IF
213
214 IF (jcvt == 0) THEN
215 CALL scoor3(x,xrefs(1,1,nf1),ixs(1,nf1),geo ,mat ,pid ,ngl ,
216 . ix1 ,ix2 ,ix3 ,ix4 ,ix5 ,ix6 ,ix7 ,ix8 ,
217 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
218 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
219 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
220 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
221 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
222 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,temp0,temp ,glob_therm%NINTEMP,
223 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
224 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
225 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 )
226 ELSE
227 CALL srcoor3(x,xrefs(1,1,nf1),ixs(1,nf1),geo ,mat ,pid ,ngl ,jhbe ,
228 . ix1 ,ix2 ,ix3 ,ix4 ,ix5 ,ix6 ,ix7 ,ix8 ,
229 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
230 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
231 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
232 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
233 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
234 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,temp0,temp ,glob_therm%NINTEMP,
235 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
236 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
237 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 )
238
239 ENDIF
240
241
242 IF (isorth == 1)
243 .
CALL smorth3(pid ,geo ,igeo ,skew ,irep ,gbuf%GAMA ,
244 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
245 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
246 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,nsigi,sigsp,nsigs,
247 . sigi ,ixs ,x ,jhbe ,ptsol,nel ,iparg_gr(28))
248
249
250 CALL sveok3(nvc,8, ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8)
251
253 . gbuf%VOL ,dummy ,geo ,igeo ,
254 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
255 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
256 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 ,
257 . rx ,ry ,rz ,sx ,sy ,sz ,ngl ,pid ,
258 . px1 ,px2 ,px3 ,px4 ,py1 ,py2 ,py3 ,py4 ,
259 . pz1 ,pz2 ,pz3 ,pz4 ,volu ,voldp,nel ,jeul ,
260 . nxref,imulti_fvm )
262 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
263 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
264 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8,
265 . deltax, volu)
266
267 gbuf%RHO(:) = zero
268 pm(104,ixs(1, 1 + nft)) = zero
269
270 DO ilay = 1, nlay
271 lbuf => elbuf_str%BUFLY(ilay)%LBUF(1,1,1)
272 mbuf => elbuf_str%BUFLY(ilay)%MAT(1,1,1)
273 bufly => elbuf_str%BUFLY(ilay)
274 nuvar = elbuf_str%BUFLY(ilay)%NVAR_MAT
275 l_pla = elbuf_str%BUFLY(ilay)%L_PLA
276 DO i = 1, nel
277 mat(i) = mat_param( ixs(1,i+nft) )%MULTIMAT%MID(ilay)
278
279 lbuf%VOL(i) = mat_param( ixs(1,i+nft) )%MULTIMAT%VFRAC(ilay) * gbuf%VOL(i)
280 ENDDO
281
282
283 ipt=1
284 CALL matini(pm ,ixs ,nixs ,x ,
285 2 geo ,ale_connectivity ,detonators,iparg_gr ,
286 3 sigi ,nel ,skew ,igeo ,
287 4 ipart ,iparts ,
288 5 mat ,ipm ,nsigs ,numsol ,ptsol ,
289 6 ipt ,ngl ,npf ,tf ,bufmat ,
290 7 gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
291 8 facload, deltax ,tempel ,mat_param )
292
293 vfrac = mat_param( ixs(1,1+nft) )%MULTIMAT%VFRAC(ilay)
294 pres = pm(104, mat_param( ixs(1,1+nft) )%MULTIMAT%MID(ilay))
295 pm(104,ixs(1, 1 + nft)) = pm(104,ixs(1, 1 + nft)) + vfrac * pres
296
297 matlaw = ipm(2, mat(1))
298 IF (matlaw == 5) THEN
299
300 IF (.NOT. error_thrown) THEN
301 IF (pm(44, mat(1)) == zero) THEN
302 CALL ancmsg(msgid = 1623, msgtype = msgerror, anmode = aninfo,
303 . i1 = ipm(1, ixs(1, 1 + nft)), i2 = ipm(1, mat(1)))
304 ENDIF
305 error_thrown = .true.
306 ENDIF
307 CALL m5in3(pm, mat, ipm(1, ixs(1,1+nft)), detonators, lbuf%TB, iparg, x, ixs, nixs)
308 ENDIF
309 IF (matlaw == 6) THEN
310 IF (pm(24, mat(1)) > zero) THEN
311 multi_fvm%NS_DIFF = .true.
312 ENDIF
313 ENDIF
314
315 ENDDO
316
317 IF (nlay > 1) THEN
318
319
320 DO ilay = 1, nlay
321 lbuf => elbuf_str%BUFLY(ilay)%LBUF(1,1,1)
322 DO i = 1, nel
323 gbuf%RHO(i) = gbuf%RHO(i) + lbuf%RHO(i) * mat_param( ixs(1,i+nft) )%MULTIMAT%VFRAC(ilay)
324 ENDDO
325 ENDDO
326
327
328 gbuf%TEMP(1:nel)=zero
329 DO ilay = 1, nlay
330 lbuf => elbuf_str%BUFLY(ilay)%LBUF(1,1,1)
331 DO i = 1, nel
332 gbuf%TEMP(i) = gbuf%TEMP(i) + lbuf%TEMP(i) * mat_param( ixs(1,i+nft) )%MULTIMAT%VFRAC(ilay)*lbuf%RHO(i)/gbuf%RHO(i)
333 ENDDO
334 ENDDO
335
336 ENDIF
337
338
339
340 IF(jthe /=0)
CALL atheri(mat,pm ,gbuf%TEMP)
341 IF(jtur /=0)
CALL aturi3(iparg ,gbuf%RHO,pm,ixs,x,
342 . gbuf%RK ,gbuf%RE,volu)
343
344
345
346 IF(jlag+jale+jeul/=0) THEN
348 . gbuf%RHO ,mas ,partsav ,x ,v ,
349 . iparts(nf1),mss(1,nf1) ,volu ,
350 . msnf ,mssf(1,nf1),in ,
351 . vr ,ins(1,nf1) ,wma ,rhocp ,mcp ,
352 . mcps(1,nf1),mssa ,rhof ,
alpha ,gbuf%FILL,
353 . ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8)
354 ENDIF
355
356
357
358 aire(:) = zero
359 CALL dtmain(geo , pm , ipm , pid , mat , fv ,
360 . gbuf%EINT, gbuf%TEMP, gbuf%DELTAX, gbuf%RK, gbuf%RE, bufmat, deltax, aire, volu, dtx, igeo,igtyp)
361
362 DO i=1,nel
363 IF(ixs(10,i+nft)/=0) THEN
364 IF( igtyp/=0 .AND.igtyp/=6 .AND. igtyp/=14
365 . .AND.igtyp/=15.AND. igtyp/=29) THEN
366 ipid1=ixs(nixs-1,i+nft)
367 CALL fretitl2(titr1,igeo(npropgi-ltitr+1,ipid1),ltitr)
369 . msgtype=msgerror,
370 . anmode=aninfo_blind_1,
371 . i1=igeo(1,ipid1),
372 . c1=titr1,
373 . i2=igtyp)
374 ENDIF
375 ENDIF
376 dtelem(nft+i)=dtx(i)
377
378
379 sti = fourth * gbuf%FILL(i) * gbuf%RHO(i) * volu(i) /
380 .
max(em20,dtx(i)*dtx(i))
381 stifn(ixs(2,i+nft))=stifn(ixs(2,i+nft))+sti
382 stifn(ixs(3,i+nft))=stifn(ixs(3,i+nft))+sti
383 stifn(ixs(4,i+nft))=stifn(ixs(4,i+nft))+sti
384 stifn(ixs(5,i+nft))=stifn(ixs(5,i+nft))+sti
385 stifn(ixs(6,i+nft))=stifn(ixs(6,i+nft))+sti
386 stifn(ixs(7,i+nft))=stifn(ixs(7,i+nft))+sti
387 stifn(ixs(8,i+nft))=stifn(ixs(8,i+nft))+sti
388 stifn(ixs(9,i+nft))=stifn(ixs(9,i+nft))+sti
389 ENDDO
390 RETURN
subroutine atheri(mat, pm, temp)
subroutine aturi3(iparg, rho, pm, ix, x, rk, re, volu)
subroutine dtmain(geo, pm, ipm, pid, mat, fv, eint, temp, deltax, rk, re, bufmat, ddeltax, aire, vol, dtx, igeo, igtyp)
subroutine m5in3(pm, mat, m151_id, detonators, tb, iparg, x, ix, nix)
subroutine matini(pm, ix, nix, x, geo, ale_connectivity, detonators, iparg, sigi, nel, skew, igeo, ipart, ipartel, mat, ipm, nsig, nums, pt, ipt, ngl, npf, tf, bufmat, gbuf, lbuf, mbuf, elbuf_str, iloadp, facload, ddeltax, tempel, mat_param)
integer, parameter nchartitle
subroutine smass3(rho, ms, partsav, x, v, ipart, mss, volu, msnf, mssf, in, vr, ins, wma, rhocp, mcp, mcps, mssa, rhof, frac, fill, nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8)
subroutine smorth3(pid, geo, igeo, skew, irep, gama, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, f1x, f1y, f1z, f2x, f2y, f2z, nsigi, sigsp, nsigs, sigi, ixs, x, jhbe, pt, nel, isolnod)
subroutine scoor3(x, xrefs, ixs, geo, mxt, ngeo, ngl, ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, f1x, f1y, f1z, f2x, f2y, f2z, temp0, temp, nintemp, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8)
subroutine sderi3(vol, veul, geo, igeo, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8, jac1, jac2, jac3, jac4, jac5, jac6, ngl, ngeo, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, det, voldp, nel, jeul, nxref, imulti_fvm)
subroutine sjac_i(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, jac_i, nel)
subroutine sdlen3(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, deltax, voln)
subroutine srcoor3(x, xrefs, ixs, geo, mxt, ngeo, ngl, jhbe, ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, f1x, f1y, f1z, f2x, f2y, f2z, temp0, temp, nintemp, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8)
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
subroutine sveok3(nvc, nod, ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8)