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