60
61
62
63
64
65
66 USE elbufdef_mod
70 USE matparam_def_mod
72 use glob_therm_mod
73
74
75
76#include "implicit_f.inc"
77
78
79
80#include "mvsiz_p.inc"
81
82
83
84#include "com04_c.inc"
85#include "param_c.inc"
86#include "scr03_c.inc"
87#include "scr12_c.inc"
88#include "scr17_c.inc"
89#include "scry_c.inc"
90#include "vect01_c.inc"
91
92
93
94 INTEGER IXS(NIXS,*), IPARG(*),IPARTS(*),
95 . NEL, IPART(LIPART1,*),PERTURB(NPERTURB),
96 . IPM(NPROPMI,*), PTSOL(*), NSIGI, IUSER, NSIGS, NPF(*)
97 INTEGER IGEO(NPROPGI,*),STRSGLOB(*),STRAGLOB(*),ORTHOGLOB(*),
98 . FAIL_INI(*)
100 . mas(*), pm(npropm,*), x(*), geo(npropg,*),
101 . veul(lveul,*), dtelem(*),sigi(nsigs,*),skew(lskew,*),stifn(*),
102 . partsav(20,*), v(*), mss(8,*),
103 . sigsp(nsigi,*),msnf(*), mssf(8,*), wma(*),rnoise(nperturb,*),
104 . volnod(*), bvolnod(*), vns(8,*), bns(8,*),bufmat(*),
105 . mcp(*), mcps(8,*),temp(*), tf(*),xrefs(8,3,*), mssa(*)
106 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
107 INTEGER,INTENT(IN) :: ILOADP(SIZLOADP,*)
108 my_real,
INTENT(IN) :: facload(lfacload,*)
109 TYPE(DETONATORS_STRUCT_)::DETONATORS
110 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
111 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
112 type (glob_therm_) ,intent(in) :: glob_therm
113
114
115
116 INTEGER I,NF1,IBID,IGTYP,IP,IR,IS,IT,IL,NLAY,NPTR,NPTS,NPTT,NCC,
117 . JHBE,IREP,MPT,NUVAR,NUVARR,IDEF,NREFSTA,
118 . IPTHK, IPPOS,IG,IM,MTN0,ICSTR,IPID1,L_PLA,L_SIGB
119 INTEGER PID(MVSIZ), NGL(MVSIZ),MAT(MVSIZ), MAT0(MVSIZ),
120 . IX1(), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
121 . IX5(MVSIZ), IX6(MVSIZ), IX7(MVSIZ), IX8(MVSIZ)
123 . x1(mvsiz),x2(mvsiz),x3(mvsiz),x4(mvsiz),x5(mvsiz),x6(mvsiz),
124 . x7(mvsiz),x8(mvsiz),y1(mvsiz),y2(mvsiz),y3(mvsiz),y4(mvsiz),
125 . y5(mvsiz),y6(mvsiz),y7(mvsiz),y8(mvsiz),z1(mvsiz),z2(mvsiz),
126 . z3(mvsiz),z4(mvsiz),z5(mvsiz),z6(mvsiz),z7(mvsiz),z8(mvsiz),
127 . rx(mvsiz) ,ry(mvsiz) ,rz(mvsiz) ,sx(mvsiz) ,
128 . sy(mvsiz) ,sz(mvsiz) ,tx(mvsiz) ,ty(mvsiz) ,tz(mvsiz) ,
129 . e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),e2x(mvsiz),
130 . e2y(mvsiz),e2z(mvsiz),e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),
131 . f1x(mvsiz) ,f1y(mvsiz) ,f1z(mvsiz) ,
132 . f2x(mvsiz) ,f2y(mvsiz) ,f2z(mvsiz) ,
133 . ajc1(mvsiz) , ajc2(mvsiz) , ajc3(mvsiz) ,
134 . ajc4(mvsiz) , ajc5(mvsiz) , ajc6(mvsiz) ,
135 . ajc7(mvsiz) , ajc8(mvsiz) , ajc9(mvsiz) ,
136 . hx(4,mvsiz) , hy(4,mvsiz), hz(4,mvsiz),gama(6,mvsiz),
137 . smax(mvsiz) , volu(mvsiz), dtx(mvsiz), deltax(mvsiz),
138 . rhocp(mvsiz),temp0(mvsiz), aire(mvsiz),llsh(mvsiz)
140 . bid(mvsiz), fv, sti, wi
142 . angle(mvsiz),dtx0(mvsiz),wt,zr,zs,zt,zz
144 DOUBLE PRECISION
145 . XD1(MVSIZ), XD2(MVSIZ), XD3(MVSIZ), XD4(MVSIZ),
146 . XD5(MVSIZ), XD6(MVSIZ), XD7(MVSIZ), XD8(MVSIZ),
147 . YD1(MVSIZ), YD2(MVSIZ), YD3(MVSIZ), YD4(MVSIZ),
148 . YD5(MVSIZ), YD6(MVSIZ), YD7(MVSIZ), YD8(MVSIZ),
149 . ZD1(MVSIZ), ZD2(MVSIZ), ZD3(MVSIZ), ZD4(MVSIZ),
150 . ZD5(MVSIZ), ZD6(MVSIZ), ZD7(MVSIZ), ZD8(MVSIZ)
151 INTEGER NLYMAX, IPMAT,IPANG
152 CHARACTER(LEN=NCHARTITLE)::TITR
153 parameter(nlymax = 200,ipmat = 100,ipang = 200)
154
155 TYPE(L_BUFEL_) ,POINTER :: LBUF
156 TYPE(G_BUFEL_) ,POINTER :: GBUF
157 TYPE(BUF_MAT_) ,POINTER :: MBUF
158
160 . w_gauss(9,9),a_gauss(9,9)
161 DATA w_gauss /
162 1 2. ,0. ,0. ,
163 1 0. ,0. ,0. ,
164 1 0. ,0. ,0. ,
165 2 1. ,1. ,0. ,
166 2 0. ,0. ,0. ,
167 2 0. ,0. ,0. ,
168 3 0.555555555555556,0.888888888888889,0.555555555555556,
169 3 0. ,0. ,0. ,
170 3 0. ,0. ,0. ,
171 4 0.347854845137454,0.652145154862546,0.652145154862546,
172 4 0.347854845137454,0. ,0. ,
173 4 0. ,0. ,0. ,
174 5 0.236926885056189,0.478628670499366,0.568888888888889,
175 5 0.478628670499366,0.236926885056189,0. ,
176 5 0. ,0. ,0. ,
177 6 0.171324492379170,0.360761573048139,0.467913934572691,
178 6 0.467913934572691,0.360761573048139,0.171324492379170,
179 6 0. ,0. ,0. ,
180 7 0.129484966168870,0.279705391489277,0.381830050505119,
181 7 0.417959183673469,0.381830050505119,0.279705391489277,
182 7 0.129484966168870,0. ,0. ,
183 8 0.101228536290376,0.222381034453374,0.313706645877887,
184 8 0.362683783378362,0.362683783378362,0.313706645877887,
185 8 0.222381034453374,0.101228536290376,0. ,
186 9 0.081274388361574,0.180648160694857,0.260610696402935,
187 9 0.312347077040003,0.330239355001260,0.312347077040003,
188 9 0.260610696402935,0.180648160694857,0.081274388361574/
189 DATA a_gauss /
190 1 0. ,0. ,0. ,
191 1 0. ,0. ,0. ,
192 1 0. ,0. ,0. ,
193 2 -.577350269189626,0.577350269189626,0. ,
194 2 0. ,0. ,0. ,
195 2 0. ,0. ,0. ,
196 3 -.774596669241483,0. ,0.774596669241483,
197 3 0. ,0. ,0. ,
198 3 0. ,0. ,0. ,
199 4 -.861136311594053,-.339981043584856,0.339981043584856,
200 4 0.861136311594053,0. ,0. ,
201 4 0. ,0. ,0. ,
202 5 -.906179845938664,-.538469310105683,0. ,
203 5 0.538469310105683,0.906179845938664,0. ,
204 5 0. ,0. ,0. ,
205 6 -.932469514203152,-.661209386466265,-.238619186083197,
206 6 0.238619186083197,0.661209386466265,0.932469514203152,
207 6 0. ,0. ,0. ,
208 7 -.949107912342759,-.741531185599394,-.405845151377397,
209 7 0. ,0.405845151377397,0.741531185599394,
210 7 0.949107912342759,0. ,0. ,
211 8 -.960289856497536,-.796666477413627,-.525532409916329,
212 8 -.183434642495650,0.183434642495650,0.525532409916329,
213 8 0.796666477413627,0.960289856497536,0. ,
214 9 -.968160239507626,-.836031107326636,-.613371432700590,
215 9 -.324253423403809,0. ,0.324253423403809,
216 9 0.613371432700590,0.836031107326636,0.968160239507626/
217
218
219
220 gbuf => elbuf_str%GBUF
221 mbuf => elbuf_str%BUFLY(1)%MAT(1,1,1)
222 lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,1)
223
224 bid(1:mvsiz) = zero
225 nrefsta = nxref
226 nxref = 0
227 DO i=1,nel
228 deltax(i)=ep30
229 ENDDO
230 jhbe = iparg(23)
231 irep = iparg(35)
232 igtyp = iparg(38)
233 IF (jcvt==1.AND.isorth
234
235 nf1=nft+1
236 IF (igtyp /= 22) isorth = 0
237 icstr=iparg(17)
238
239 DO i=1,nel
240 rhocp(i) = pm(69,ixs(1,nft+i))
241 temp0(i) = pm(79,ixs(1,nft+i))
242 ENDDO
243
244 IF (jcvt == 0) THEN
245 CALL scoor3(x ,bid(1),ixs(1,nf1) ,geo ,mat ,pid ,ngl ,
246 . ix1 ,ix2 ,ix3 ,ix4 ,ix5 ,ix6 ,ix7 ,ix8 ,
247 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
248 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
249 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
250 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
251 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
252 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,temp0, temp,glob_therm%NINTEMP,
253 . xd1 ,xd2 ,xd3 ,xd4
254 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
255 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 )
256 ELSE
257 CALL srcoor3(x,bid(1),ixs(1,nf1) ,geo ,mat ,pid ,ngl ,jhbe ,
258 . ix1 ,ix2 ,ix3 ,ix4 ,ix5 ,ix6 ,ix7 ,ix8 ,
259 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
260 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
261 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
262 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
263 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
264 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,temp0,temp,glob_therm%NINTEMP,
265 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
266 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
267 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 )
268 ENDIF
269
270 SELECT CASE (igtyp)
271
272 CASE(21)
273 DO i=1,nel
274 angle(i) = geo(1,pid(i))
275 END DO
276 CALL scmorth3(pid ,geo ,igeo ,skew ,irep ,gbuf%GAMA ,
277 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
278 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
279 . ngl ,angle,nsigi,sigsp,nsigs,sigi ,ixs(1,nf1) ,1 ,
280 . orthoglob ,ptsol,nel)
281
282 CASE(22)
283 DO i=1,nel
284 angle(i) = geo(1,pid(i))
285 END DO
286 CALL scmorth3(pid ,geo ,igeo ,skew ,irep ,gbuf%GAMA ,
287 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
288 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
289 . ngl ,angle ,nsigi,sigsp,nsigs,sigi ,ixs(1,nf1),1 ,
290 . orthoglob ,ptsol,nel)
291 ipthk = ipang+nlymax
292 ippos = ipthk+nlymax
293 ig = pid(1)
294 mtn0 = mtn
295 DO i=1,nel
296 mat0(i) = mat(i)
297 dtx0(i) = ep20
298 ENDDO
299 END SELECT
300
302 . ajc1,ajc2,ajc3,
303 . ajc4,ajc5,ajc6,
304 . ajc7,ajc8,ajc9,smax, volu, ngl,
305 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
306 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
307 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 )
308 IF (idttsh > 0) THEN
310 . x1, x2, x3, x4, x5, x6, x7, x8,
311 . y1, y2, y3, y4, y5, y6, y7, y8,
312 . z1, z2, z3, z4, z5, z6, z7, z8,icstr,idt1sol)
313 END IF
314
315!
316
317
318 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
319 DO i=1,nel
320 tempel(i) = one_over_8 *(temp(ixs(2,i)) + temp(ixs(3,i))
321 . + temp(ixs(4,i
322 . + temp(ixs(6,i)) + temp(ixs(7,i))
323 . + temp(ixs(8,i)) + temp(ixs(9,i)))
324 ENDDO
325 ELSE
326 tempel(1:nel) = temp0(1:nel)
327 END IF
328
329 ip=0
330 CALL matini(pm ,ixs ,nixs ,x ,
331 . geo ,ale_connectivity ,detonators ,iparg ,
332 . sigi ,nel ,skew ,igeo ,
333 . ipart ,iparts ,
334 . mat ,ipm ,nsigs ,numsol ,ptsol ,
335 . ip ,ngl ,npf ,tf ,bufmat ,
336 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
337 . facload, deltax ,tempel )
338
339 CALL sczero3(gbuf%RHO,gbuf%SIG,gbuf%EINT,nel)
340
341
342 IF(jthe /=0)
CALL atheri(mat,pm,gbuf%TEMP)
343
344 nlay = elbuf_str%NLAY
345 nptr = elbuf_str%NPTR
346 npts = elbuf_str%NPTS
347 nptt = elbuf_str%NPTT
348 it = 1
349
350
351 DO ir=1,nptr
352 DO is=1,npts
353 DO il=1,nlay
354
355 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
356 mbuf => elbuf_str%BUFLY(il)%MAT(ir,is,it)
357 l_pla = elbuf_str%BUFLY(il)%L_PLA
358 l_sigb= elbuf_str%BUFLY(il)%L_SIGB
359
360 IF (igtyp == 22) THEN
361 wt = geo(ipthk+il,ig)
362 zz = geo(ippos+il,ig)
363 im =igeo(ipmat+il,ig)
364 mtn=nint(pm(19,im))
365 DO i=1,nel
366 mat(i)=im
367 angle(i) = geo(ipang+il,pid(i))
368 ENDDO
369 ELSE
370 zz = a_gauss(il,nlay)
371 wt = w_gauss(il,nlay)
372 ENDIF
373
374 IF (icstr == 10) THEN
375 zr = a_gauss(ir,nptr)
376 zs = a_gauss(is,npts)
377 zt = zz
378 ELSEIF (icstr == 100) THEN
379 zr = a_gauss(ir,nptr)
380 zs = zz
381 zt = a_gauss(is,npts)
382 ELSEIF (icstr == 1) THEN
383 zr = zz
384 zs = a_gauss(ir,nptr)
385 zt = a_gauss(is,npts)
386 ENDIF
387 ip = ir + ( (is-1) + (il-1)*npts )*nptr
388 wi = w_gauss(ir,nptr)*w_gauss(is,npts)*wt
389
390 CALL s8zderi3(lbuf%VOL,veul(1,nf1),geo,
391 . zr,zs,zt,wi,
392 . hx, hy, hz,
393 .
394 . ajc4,ajc5,ajc6,
395 . ajc7,ajc8,ajc9,smax, deltax, ngl,lbuf%VOL0DP)
396 IF (idttsh > 0) THEN
397 DO i=1,nel
398 IF (gbuf%IDT_TSH(i)>0)
399 . deltax(i)=
max(llsh(i),deltax(i))
400 ENDDO
401 END IF
402 IF (igtyp == 22)
403 .
CALL scmorth3(pid ,geo ,igeo ,skew ,irep ,lbuf%GAMA,
404 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
405 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
406 . ngl ,angle ,nsigi,sigsp,nsigs,sigi ,ixs(1,nf1),il ,
407 . orthoglob, ptsol,nel)
408
409 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
410 DO i=1,nel
411 tempel(i) = one_over_8 *(temp(ixs(2,i)) + temp(ixs(3,i))
412 . + temp(ixs(4,i)) + temp(ixs(5,i))
413 . + temp(ixs(6,i)) + temp(ixs(7,i))
414 . + temp(ixs(8,i)) + temp(ixs(9,i)))
415 ENDDO
416 ELSE
417 tempel(1:nel) = temp0(1:nel)
418 END IF
419
420 CALL matini(pm ,ixs ,nixs ,x ,
421 . geo ,ale_connectivity ,detonators,iparg ,
422 . sigi ,nel ,skew ,igeo ,
423 . ipart ,iparts ,
424 . mat ,ipm ,nsigs ,numsol ,ptsol ,
425 . ip ,ngl ,npf ,tf ,bufmat ,
426 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
427 . facload,deltax ,tempel)
428
429 idef =0
430 IF (mtn >= 28) THEN
431 nuvar = ipm(8,ixs(1,nft+1))
432 idef =1
433 ELSE
434 nuvar = 0
435 IF (mtn == 14 .OR. mtn == 12 .OR. mtn == 24) THEN
436 idef =1
437 ELSEIF (istrain == 1 .AND.
438 . (mtn == 1 .OR. mtn == 2 .OR. mtn == 3 .OR.
439 . mtn == 4 .OR. mtn == 6 .OR. mtn == 10 .OR.
440 . mtn == 21 .OR. mtn == 22 .OR. mtn == 23 .OR.
441 . mtn == 49)) THEN
442 idef =1
443 ENDIF
444 ENDIF
445
447 . lbuf%SIG ,pm ,lbuf%VOL ,sigsp ,
448 . sigi ,lbuf%EINT,lbuf%RHO ,mbuf%VAR ,lbuf%STRA,
449 . ixs ,nixs ,nsigi ,ip ,nuvar ,
450 . nel ,iuser ,idef ,nsigs ,strsglob ,
451 . straglob ,jhbe ,igtyp ,x ,gbuf%GAMA,
452 . mat ,lbuf%PLA ,l_pla ,ptsol ,lbuf%SIGB,
453 . l_sigb ,ipm ,bufmat ,lbuf%VOL0DP)
454
455 IF (igtyp == 22) THEN
456 aire(:) = zero
457 CALL dtmain(geo ,pm ,ipm ,pid ,mat ,fv ,
458 . lbuf%EINT ,lbuf%TEMP ,lbuf%DELTAX ,lbuf%RK ,lbuf%RE ,bufmat, deltax, aire,
459 . volu, dtx,igeo,igtyp)
460
462 . lbuf%RHO,lbuf%VOL,lbuf%OFF,lbuf%SIG,lbuf%EINT,dtx,
463 . gbuf%RHO,gbuf%VOL,gbuf%OFF,gbuf%SIG,gbuf%EINT,dtx0,
464 . nel )
465 ELSE
467 . lbuf%RHO,lbuf%VOL,lbuf%OFF,lbuf%SIG,lbuf%EINT,dtx,
468 . gbuf%RHO,gbuf%VOL,gbuf%OFF,gbuf%SIG,gbuf%EINT,dtx0,
469 . nel )
470 ENDIF
471
472 ENDDO
473 ENDDO
474 ENDDO
475
476 IF (igtyp == 22) THEN
477 mtn=mtn0
478 DO i=1,nel
479 mat(i)=mat0(i)
480 ENDDO
481 ENDIF
482
483
485 . gbuf%RHO,mas,partsav,x,v,
486 . iparts(nf1),mss(1,nf1),volu ,
487 . msnf ,mssf(1,nf1) ,bid(1) ,
488 . bid(1) ,bid(1) ,wma ,rhocp ,mcp ,
489 . mcps(1,nf1) ,mssa ,bid(1) ,bid(1),gbuf%FILL,
490 . ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8)
491
492
493
494 IF (i7stifs /= 0) THEN
495 ncc=8
496 CALL sbulk3(volu ,ix1 ,ncc,mat,pm ,
497 . volnod,bvolnod,vns(1,nf1),bns(1,nf1),bid(1),
498 . bid(1) ,gbuf%FILL)
499 ENDIF
500
501
502 CALL failini(elbuf_str,nptr,npts,nptt,nlay,
503 . ipm,sigsp,nsigi,fail_ini ,
504 . sigi,nsigs,ixs,nixs,ptsol,rnoise,perturb,mat_param)
505
506
507 aire(:) = zero
508 CALL dtmain(geo ,pm ,ipm ,pid ,mat ,fv ,
509 . lbuf%EINT ,lbuf%TEMP ,lbuf%DELTAX ,lbuf%RK ,lbuf%RE ,bufmat, deltax, aire,
510 . volu, dtx,igeo,igtyp)
511
512 IF (igtyp == 22) THEN
513 DO i=1,nel
514 dtx(i)=dtx0(i)
515 ENDDO
516 ENDIF
517 DO i=1,nel
518 IF (ixs(10,i+nft)/=0.AND.invers>14) THEN
519 IF(igtyp/=0.AND.igtyp/=6.AND.igtyp/=14.AND.igtyp/=15
520 . .AND.igtyp/=20.AND.igtyp/=21.AND.igtyp/=22)THEN
521 ipid1=ixs(nixs-1,i+nft)
522 CALL fretitl2(titr,igeo(npropgi-ltitr+1,ipid1),ltitr)
524 . msgtype=msgerror,
525 . anmode=aninfo_blind_1,
526 . i1=igeo(1,ipid1),
527 . c1=titr,
528 . i2=igtyp)
529 ENDIF
530 ENDIF
531 dtelem(nft+i)=dtx(i)
532
533 sti = fourth * gbuf%FILL(i) * gbuf%RHO(i) * volu(i)
534 . /
max(em20,dtx(i)*dtx(i))
535 stifn(ixs(2,i+nft))=stifn(ixs(2,i+nft))+sti
536 stifn(ixs(3,i+nft))=stifn(ixs(3,i+nft))+sti
537 stifn(ixs(4,i+nft))=stifn(ixs(4,i+nft))+sti
538 stifn(ixs(5,i+nft))=stifn(ixs(5,i+nft))+sti
539 stifn(ixs(6,i+nft))=stifn(ixs(6,i+nft))+sti
540 stifn(ixs(7,i+nft))=stifn(ixs(7,i+nft))+sti
541 stifn(ixs(8,i+nft))=stifn(ixs(8,i+nft))+sti
542 stifn(ixs(9,i+nft))=stifn(ixs(9,i+nft))+sti
543 ENDDO
544
545 nxref = nrefsta
546
547 RETURN
subroutine atheri(mat, pm, temp)
subroutine dtmain(geo, pm, ipm, pid, mat, fv, eint, temp, deltax, rk, re, bufmat, ddeltax, aire, vol, dtx, igeo, igtyp)
subroutine failini(elbuf_str, nptr, npts, nptt, nlay, ipm, sigsp, nsigi, fail_ini, sigi, nsigs, ix, nix, pt, rnoise, perturb, mat_param)
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 sigin20b(sig, pm, vol, sigsp, sigi, eint, rho, uvar, eps, ix, nix, nsigi, ipt, nuvar, nel, iuser, idef, nsigs, strsglob, straglob, jhbe, igtyp, x, bufgama, mat, epsp, l_pla, pt, sigb, l_sigb, ipm, bufmat, voldp)
subroutine sbulk3(volu, nc, nnc, mat, pm, volnod, bvolnod, vns, bns, vnsx, bnsx, fill)
subroutine sczero3(rhog, sigg, eintg, nel)
subroutine svalue0(rho, vol, off, sig, eint, dtx, rhog, volg, offg, sigg, eintg, dtxg, nel)
subroutine scmorth3(pid, geo, igeo, skew, irep, gama, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, ngl, angle, nsigi, sigsp, nsigs, sigi, ixs, ilay, orthoglob, pt, nel)
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 s8zderi3(vol, veul, geo, ksi, eta, zeta, wi, hx, hy, hz, cj1, cj2, cj3, cj4, cj5, cj6, cj7, cj8, cj9, smax, deltax, ngl, voldp)
subroutine s8zderic3(vol, hx, hy, hz, jac1, jac2, jac3, jac4, jac5, jac6, jac7, jac8, jac9, smax, det, ngl, 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 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 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 sdlensh14(nel, llsh, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, ics, idt1sol)
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)