59
60
61
62 USE elbufdef_mod
66 USE matparam_def_mod
68 use glob_therm_mod
69 use s20temp_mod
70 use element_mod , only : nixs
71
72
73
74#include "implicit_f.inc"
75
76
77
78#include "mvsiz_p.inc"
79
80
81
82#include "com04_c.inc"
83#include "param_c.inc"
84#include "scr12_c.inc"
85#include "scr17_c.inc"
86#include "scry_c.inc"
87#include "vect01_c.inc"
88
89
90
91 INTEGER IXS(NIXS,*), IPARG(*),IPARTS(*),IGEO(NPROPGI,*),
92 . IXS16(8,*), IPART(LIPART1,*),IPM(NPROPMI,*), PTSOL(*),
93 . NPF(*),STRSGLOB(*),STRAGLOB(*),FAIL_INI(*),PERTURB(NPERTURB)
94 INTEGER NEL,NSIGI,IUSER,NSIGS
96 . mas(*), pm(npropm,*), x(*), geo(npropg,*),
97 . veul(lveul,*), dtelem(*),sigi(nsigs,*),skew(lskew,*),stifn(*),
98 . partsav(20,*), v(*), mss(8,*), mssx(12,*), sigsp(nsigi, *),
99 . volnod(*), bvolnod(*), vns(8,*), bns(8,*),
100 . vnsx(12,*), bnsx(12,*),bufmat(*),rnoise(nperturb,*),
101 . mcp(*), mcps(8,*),mcpsx(12,*), temp(*), tf(*)
102 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
103 INTEGER,INTENT(IN) :: ILOADP(SIZLOADP,*)
104 my_real,
INTENT(IN) :: facload(lfacload,*)
105 TYPE(DETONATORS_STRUCT_)::DETONATORS
106 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
107 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
108 type (glob_therm_) ,intent(in) :: glob_therm
109
110
111
112 INTEGER NF1,IBID,I,IGTYP,IP,NF2,NPTR,NPTS,NPTT,NLAY,IL,IR,IS,IT,
113 . N, NUVAR,IINT, NCC,IDEF,JHBE,IPID1,L_PLA,L_SIGB
114 INTEGER NC(MVSIZ,16),MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ),RBID(1)
115 INTEGER ,PARAMETER :: NPE=16
116 CHARACTER(LEN=NCHARTITLE)::TITR1
118 . bid, fv,wi,aa,bb
120 . mass(mvsiz),
121 . volp(mvsiz,5), sti(mvsiz),deltax(mvsiz),deltax2(mvsiz),
122 . xx(mvsiz,16), yy(mvsiz,16), zz(mvsiz,16),
123 . vx(mvsiz,16), vy(mvsiz,16), vz(mvsiz,16),
124 . px(mvsiz,16), py(mvsiz,16), pz(mvsiz,16),
125 . rx(mvsiz),ry(mvsiz),rz(mvsiz),
126 . sx(mvsiz),sy(mvsiz),sz(mvsiz),volg(mvsiz),
127 . tx(mvsiz),ty(mvsiz),tz(mvsiz),ul(mvsiz,16),
128 . ni(mvsiz,16),dnidr(mvsiz,16),dnids(mvsiz,16),dnidt(mvsiz,16),
129 . dtx(mvsiz),stin(mvsiz,16), rhocp(mvsiz),temp0(mvsiz), aire(mvsiz)
131 TYPE(L_BUFEL_) ,POINTER :: LBUF
132 TYPE(G_BUFEL_) ,POINTER :: GBUF
133 TYPE(BUF_MAT_) ,POINTER :: MBUF
134
136 . w_gauss(9,9),a_gauss(9,9),w_lobatto(9,9),a_lobatto(9,9),
137 . w_newton(9,9),a_newton(9,9)
138
139 DATA w_gauss /
140 1 2. ,0. ,0. ,
141 1 0. ,0. ,0. ,
142 1 0. ,0. ,0. ,
143 2 1. ,1. ,0. ,
144 2 0. ,0. ,0. ,
145 2 0. ,0. ,0. ,
146 3 0.555555555555556,0.888888888888889,0.555555555555556,
147 3 0. ,0. ,0. ,
148 3 0. ,0. ,0. ,
149 4 0.347854845137454,0.652145154862546,0.652145154862546,
150 4 0.347854845137454,0. ,0. ,
151 4 0. ,0. ,0. ,
152 5 0.236926885056189,0.478628670499366,0.568888888888889,
153 5 0.478628670499366,0.236926885056189,0. ,
154 5 0. ,0. ,0. ,
155 6 0.171324492379170,0.360761573048139,0.467913934572691,
156 6 0.467913934572691,0.360761573048139,0.171324492379170,
157 6 0. ,0. ,0. ,
158 7 0.129484966168870,0.279705391489277,0.381830050505119,
159 7 0.417959183673469,0.381830050505119,0.279705391489277,
160 7 0.129484966168870,0. ,0. ,
161 8 0.101228536290376,0.222381034453374,0.313706645877887,
162 8 0.362683783378362,0.362683783378362,0.313706645877887,
163 8 0.222381034453374,0.101228536290376,0. ,
164 9 0.081274388361574,0.180648160694857,0.260610696402935,
165 9 0.312347077040003,0.330239355001260,0.312347077040003,
166 9 0.260610696402935,0.180648160694857,0.081274388361574/
167 DATA a_gauss /
168 1 0. ,0. ,0. ,
169 1 0. ,0. ,0. ,
170 1 0. ,0. ,0. ,
171 2 -.577350269189626,0.577350269189626,0. ,
172 2 0. ,0. ,0. ,
173 2 0. ,0. ,0. ,
174 3 -.774596669241483,0. ,0.774596669241483,
175 3 0. ,0. ,0. ,
176 3 0. ,0. ,0. ,
177 4 -.861136311594053,-.339981043584856,0.339981043584856,
178 4 0.861136311594053,0. ,0. ,
179 4 0. ,0. ,0. ,
180 5 -.906179845938664,-.538469310105683,0. ,
181 5 0.538469310105683,0.906179845938664,0. ,
182 5 0. ,0. ,0. ,
183 6 -.932469514203152,-.661209386466265,-.238619186083197,
184 6 0.238619186083197,0.661209386466265,0.932469514203152,
185 6 0. ,0. ,0. ,
186 7 -.949107912342759,-.741531185599394,-.405845151377397,
187 7 0. ,0.405845151377397,0.741531185599394,
188 7 0.949107912342759,0. ,0. ,
189 8 -.960289856497536,-.796666477413627,-.525532409916329,
190 8 -.183434642495650,0.183434642495650,0.525532409916329,
191 8 0.796666477413627,0.960289856497536,0. ,
192 9 -.968160239507626,-.836031107326636,-.613371432700590,
193 9 -.324253423403809,0. ,0.324253423403809,
194 9 0.613371432700590,0.836031107326636,0.968160239507626/
195
196 DATA w_lobatto /
197 1 2. ,0. ,0. ,
198 1 0. ,0. ,0. ,
199 1 0. ,0. ,0. ,
200 2 1. ,1. ,0. ,
201 2 0. ,0. ,0. ,
202 2 0. ,0. ,0. ,
203 3 0.333333333333333,1.333333333333333,0.333333333333333,
204 3 0. ,0. ,0. ,
205 3 0. ,0. ,0. ,
206 4 0.166666666666667,0.833333333333333,0.833333333333333,
207 4 0.166666666666667,0. ,0. ,
208 4 0. ,0. ,0. ,
209 5 0.1 ,0.544444444444444,0.711111111111111,
210 5 0.544444444444444,0.1 ,0. ,
211 5 0. ,0. ,0. ,
212 6 0.066666666666667,0.37847496 ,0.55485838 ,
213 6 0.55485838 ,0.37847496 ,0.066666666666667,
214 6 0. ,0. ,0. ,
215 7 0.04761904 ,0.27682604 ,0.43174538 ,
216 7 0.48761904 ,0.43174538 ,0.27682604 ,
217 7 0.04761904 ,0. ,0. ,
218 8 0.03571428 ,0.21070422 ,0.34112270 ,
219 8 0.41245880 ,0.41245880 ,0.34112270 ,
220 8 0.21070422 ,0.03571428 ,0. ,
221 9 0.027777777777778,0.1654953616 ,0.2745387126 ,
222 9 0.3464285110 ,0.3715192744 ,0.3464285110 ,
223 9 0.2745387126 ,0.1654953616 ,0.027777777777778/
224 DATA a_lobatto /
225 1 0. ,0. ,0. ,
226 1 0. ,0. ,0. ,
227 1 0. ,0. ,0. ,
228 2 -1. ,1. ,0. ,
229 2 0. ,0. ,0. ,
230 2 0. ,0. ,0. ,
231 3 -1. ,0. ,1. ,
232 3 0. ,0. ,0. ,
233 3 0. ,0. ,0. ,
234 4 -1. ,-.44721360 ,0.44721360 ,
235 4 1. ,0. ,0. ,
236 4 0. ,0. ,0. ,
237 5 -1. ,-.65465367 ,0. ,
238 5 0.65465367 , 1. ,0. ,
239 5 0. ,0. ,0. ,
240 6 -1. ,-.76505532 ,-.28523152 ,
241 6 0.28523152 ,0.76505532 , 1. ,
242 6 0. ,0. ,0. ,
243 7 -1. ,-.83022390 ,-.46884879 ,
244 7 0. ,0.46884879 ,0.83022390 ,
245 7 1. ,0. ,0. ,
246 8 -1. ,-.87174015 ,-.59170018 ,
247 8 -.20929922 ,0.20929922 ,0.59170018 ,
248 8 0.87174015 , 1. ,0. ,
249 9 -1. ,-.8997579954 ,-.6771862795 ,
250 9 -.3631174638 ,0. ,0.3631174638 ,
251 9 0.6771862795 ,0.8997579954 , 1. /
252
253
254 DATA w_newton /
255 1 2. ,0. ,0. ,
256 1 0. ,0. ,0. ,
257 1 0. ,0. ,0. ,
258 2 1. ,1. ,0. ,
259 2 0. ,0. ,0. ,
260 2 0. ,0. ,0. ,
261 3 0.5 ,1. ,0.5 ,
262 3 0. ,0. ,0. ,
263 3 0. ,0. ,0. ,
264 4 0.166666666666667,0.833333333333333,0.833333333333333,
265 4 0.166666666666667,0. ,0. ,
266 4 0. ,0. ,0. ,
267 5 0.25 ,0.5 ,0.5 ,
268 5 0.5 ,0.25 ,0. ,
269 5 0. ,0. ,0. ,
270 6 0.066666666666667,0.37847496 ,0.55485838 ,
271 6 0.55485838 ,0.37847496 ,0.066666666666667,
272 6 0. ,0. ,0. ,
273 7 0.04761904 ,0.27682604 ,0.43174538 ,
274 7 0.48761904 ,0.43174538 ,0.27682604 ,
275 7 0.04761904 ,0. ,0. ,
276 8 0.03571428 ,0.21070422 ,0.34112270 ,
277 8 0.41245880 ,0.41245880 ,0.34112270 ,
278 8 0.21070422 ,0.03571428 ,0. ,
279 9 0.027777777777778,0.1654953616 ,0.2745387126 ,
280 9 0.3464285110 ,0.3715192744 ,0.3464285110 ,
281 9 0.2745387126 ,0.1654953616 ,0.027777777777778/
282 DATA a_newton /
283 1 0. ,0. ,0. ,
284 1 0. ,0. ,0. ,
285 1 0. ,0. ,0. ,
286 2 -1. ,1. ,0. ,
287 2 0. ,0. ,0. ,
288 2 0. ,0. ,0. ,
289 3 -1. ,0. ,1. ,
290 3 0. ,0. ,0. ,
291 3 0. ,0. ,0. ,
292 4 -1. ,-.44721360 ,0.44721360 ,
293 4 1. ,0. ,0. ,
294 4 0. ,0. ,0. ,
295 5 -1. ,-.5 ,0. ,
296 5 0.5 , 1. ,0. ,
297 5 0. ,0. ,0. ,
298 6 -1. ,-.76505532 ,-.28523152 ,
299 6 0.28523152 ,0.76505532 , 1. ,
300 6 0. ,0. ,0. ,
301 7 -1. ,-.83022390 ,-.46884879 ,
302 7 0. ,0.46884879 ,0.83022390 ,
303 7 1. ,0. ,0. ,
304 8 -1. ,-.87174015 ,-.59170018 ,
305 8 -.20929922 ,0.20929922 ,0.59170018 ,
306 8 0.87174015 , 1. ,0. ,
307 9 -1. ,-.8997579954 ,-.6771862795 ,
308 9 -.3631174638 ,0. ,0.3631174638 ,
309 9 0.6771862795 ,0.8997579954 , 1. /
310
311
312
313 gbuf => elbuf_str%GBUF
314 nptr = elbuf_str%NPTR
315 npts = elbuf_str%NPTS
316 nptt = elbuf_str%NPTT
317 nlay = elbuf_str%NLAY
318
319 jhbe = iparg(23)
320 iint = iparg(36)
321 igtyp = iparg(38)
322 idef = 0
323 nf1=nft+1
324 nf2=nf1-(numels8+numels10+numels20)
325 ibid = 0
326 rbid = zero
327
328 DO i=lft,llt
329 rhocp(i) = pm(69,ixs(1,nft+i))
330 temp0(i) = pm(79,ixs(1,nft+i))
331 ENDDO
332
334 1 x ,v ,ixs(1,nf1) ,ixs16(1,nf2),xx ,
335 2 yy ,zz ,vx ,vy ,vz ,
336 3 nc ,ngl ,mat ,pid ,mass ,
337 4 dtelem(nft+1),sti ,gbuf%SIG ,gbuf%EINT ,gbuf%RHO,
338 5 gbuf%QVIS ,temp0 ,temp ,nel ,glob_therm%NINTEMP)
339
340 DO n=1,16
341 DO i=lft,llt
342 ul(i,n) = zero
343 ENDDO
344 ENDDO
345 DO i=lft,llt
346 volg(i) = zero
347 ENDDO
348
349
350
351
352 IF(jthe /=0)
CALL atheri(mat,pm,gbuf%TEMP)
353
354
355
356 is = 1
357 DO it=1,nptt
358 DO ir=1,nptr
359 DO il=1,nlay
360
361 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
362 mbuf => elbuf_str%BUFLY(il)%MAT(ir,is,it)
363 l_pla = elbuf_str%BUFLY(il)%L_PLA
364 l_sigb = elbuf_str%BUFLY(il)%L_SIGB
365 ip = ir + ( (il-1) + (it-1)*nlay )*nptr
366
367 IF (iint == 1) THEN
368
369 wi = w_gauss(ir,nptr)*w_gauss(il,nlay)*w_gauss(it,nptt)
370
372 1 a_gauss(ir,nptr),a_gauss(il,nlay),a_gauss(it,nptt),ni ,
373 2 dnidr ,dnids ,dnidt )
374
376 1 a_gauss(ir,nptr),a_gauss(il,nlay),a_gauss(it,nptt),wi,
377 2 dnidr ,dnids ,dnidt ,rx ,ry ,rz ,
378 3 sx ,sy ,sz ,tx ,ty ,tz ,
379 4 xx ,yy ,zz ,px ,py ,pz ,
380 5 lbuf%VOL,deltax ,stin ,ni ,volg ,ul ,lbuf%VOL0DP)
381 ELSEIF (iint == 2) THEN
382
383 wi = w_gauss(ir,nptr)*w_lobatto(il,nlay)*w_gauss(it,nptt)
384
386 1 a_gauss(ir,nptr),a_lobatto(il,nlay),a_gauss(it,nptt),ni ,
387 2 dnidr ,dnids ,dnidt )
388
390 1 a_gauss(ir,nptr),a_lobatto(il,nlay),a_gauss(it,nptt),wi,
391 2 dnidr ,dnids ,dnidt ,rx ,ry ,rz ,
392 3 sx ,sy ,sz ,tx ,ty ,tz ,
393 4 xx ,yy ,zz ,px ,py ,pz ,
394 5 lbuf%VOL,deltax ,stin ,ni ,volg ,ul ,lbuf%VOL0DP )
395 ENDIF
396
397 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
398 CALL s20temp(nel,numnod,mvsiz,npe, nc,ni(1,ip),temp,tempel)
399 ELSE
400 tempel(1:nel) = temp0(1:nel)
401 ENDIF
402
403 CALL matini(pm ,ixs ,nixs ,x ,
404 . geo ,ale_connectivity ,detonators ,iparg ,
405 . sigi ,nel ,skew ,igeo(1,1) ,
406 . ipart ,iparts ,
407 . mat ,ipm ,nsigs ,numsol ,ptsol ,
408 . ip ,ngl ,npf ,tf ,bufmat ,
409 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
410 . facload, deltax ,tempel ,mat_param )
411
412
413
414 CALL s20msi(lbuf%RHO ,mass ,lbuf%VOL ,dtelem(nft+1),sti ,
415 . lbuf%OFF ,lbuf%SIG ,lbuf%EINT ,dtx ,nel ,
416 . gbuf%OFF ,gbuf%SIG ,gbuf%EINT ,gbuf%RHO ,wi/eight)
417
418
419
420
421 IF (mtn >= 28) THEN
422 nuvar = ipm(8,ixs(1,nft+1))
423 idef =1
424 ELSE
425 nuvar = 0
426 IF(mtn == 14 .OR. mtn == 12)THEN
427 idef =1
428 ELSEIF(mtn == 24)THEN
429 idef =1
430 ELSEIF(istrain == 1)THEN
431 IF(mtn == 1)THEN
432 idef =1
433 ELSEIF(mtn == 2)THEN
434 idef =1
435 ELSEIF(mtn == 4)THEN
436 idef =1
437 ELSEIF(mtn == 3.OR.mtn == 6.OR.mtn ==10.OR.
438 . mtn == 21.OR.mtn == 22.OR.
439 . mtn == 23.OR.mtn == 49)THEN
440 idef =1
441 ENDIF
442 ENDIF
443 ENDIF
444 CALL sigin20b(lbuf%SIG,pm ,lbuf%VOL,sigsp ,
445 . sigi ,lbuf%EINT,lbuf%RHO,mbuf%VAR,lbuf%STRA,
446 . ixs ,nixs ,nsigi ,ip ,nuvar ,
447 . nel ,iuser ,idef ,nsigs ,strsglob ,
448 . straglob,jhbe ,igtyp ,x ,lbuf%GAMA,
449 . mat ,lbuf%PLA ,l_pla ,ptsol ,lbuf%SIGB,
450 . l_sigb ,ipm ,bufmat ,lbuf%VOL0DP)
451 ENDDO
452 ENDDO
453 ENDDO
454
455 DO i=lft,llt
456 aa =
max(ul(i,1),ul(i,2),ul(i,3),ul(i,4),
457 . ul(i,5),ul(i,6),ul(i,7),ul(i,8))
458 bb =
max(ul(i,9) ,ul(i,10),ul(i,11),ul(i,12),ul(i,13),ul(i,14),
459 . ul(i,15),ul(i,16))
460 deltax2(i) = aa/
max(aa,bb)
461 aa = aa*thirty2
462 bb = bb*thirty2*third
463 deltax(i) = sqrt(two*volg(i)/
max(aa,bb))
464 gbuf%VOL(i) = volg(i)
465 ENDDO
466
467 aire(:) = zero
468 CALL dtmain(geo ,pm ,ipm ,pid ,mat ,fv ,
469 . gbuf%EINT ,gbuf%TEMP ,gbuf%DELTAX ,gbuf%RK ,gbuf%RE ,bufmat, deltax, aire,
470 . gbuf%VOL, dtx, igeo,igtyp)
471
473 1 mass ,mas,partsav,iparts(nf1),mss(1,nf1),volg,
474 2 xx ,yy ,zz ,vx ,vy ,vz ,
475 3 nc ,sti,stifn ,deltax2 ,gbuf%RHO ,dtx ,
476 4 dtelem(nft+1),mssx(1,nf1),rhocp, mcp, mcps(1,nf1) ,
477 5 mcpsx(1,nf1) ,gbuf%FILL )
478
479
480
481 CALL failini(elbuf_str,nptr,npts,nptt,nlay,
482 . ipm,sigsp,nsigi,fail_ini ,
483 . sigi,nsigs,ixs,nixs,ptsol,
484 . rnoise,perturb,mat_param)
485
486
487
488
489 IF (i7stifs /= 0) THEN
490 ncc=16
491 CALL sbulk3(volg ,nc ,ncc,mat,pm ,
492 2 volnod,bvolnod,vns(1,nf1),bns(1,nf1),
493 3 vnsx(1,nf1),bnsx(1,nf1) ,gbuf%FILL)
494 ENDIF
495
496 DO i=lft,llt
497 IF(ixs(10,i+nft) /= 0) THEN
498 IF (igtyp/=0 .AND. igtyp /= 14 .AND. igtyp/=20 .AND.
499 . igtyp/=21) THEN
500 ipid1=ixs(nixs-1,i+nft)
501 CALL fretitl2(titr1,igeo(npropgi-ltitr+1,ipid1),ltitr)
503 . msgtype=msgerror,
504 . anmode=aninfo_blind_1,
505 . i1=igeo(1,ipid1),
506 . c1=titr1,
507 . i2=igtyp)
508 ENDIF
509 ENDIF
510 ENDDO
511
512 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, mat_param)
integer, parameter nchartitle
subroutine s16coor3(x, v, ixs, ixs16, xx, yy, zz, vx, vy, vz, nc, ngl, mxt, ngeo, mass, dtelem, sti, sigg, eintg, rhog, qg, temp0, temp, nel, nintemp)
subroutine s16mass3(mass, ms, partsav, ipart, mss, volg, xx, yy, zz, vx, vy, vz, nc, sti, stifn, deltax2, rho, dtx, dtelem, mssx, rhocp, mcp, mcps, mcpsx, fill)
subroutine s20msi(rho, mass, volu, dtelem, sti, off, sig, eint, dtx, nel, offg, sigg, eintg, rhog, wip)
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 s16rst(r, s, t, ni, dnidr, dnids, dnidt)
subroutine s16deri3(ngl, off, r, s, t, w, dnidr, dnids, dnidt, dxdr, dydr, dzdr, dxds, dyds, dzds, dxdt, dydt, dzdt, xx, yy, zz, px, py, pz, vol, deltax, kxx, ni, volg, ul, voldp)
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)