60
61
62
63
64
65
66 USE elbufdef_mod
70 USE matparam_def_mod
71 USE defaults_mod
73 use glob_therm_mod
74
75
76
77#include "implicit_f.inc"
78
79
80
81#include "mvsiz_p.inc"
82
83
84
85#include "com04_c.inc"
86#include "param_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
98
99
100 . mas(*), pm(npropm,*), x(*), geo(npropg,*),
101 . veul(lveul,*), dtelem(*),sigi(nsigs,*),skew(lskew,*),stifn(*),
102 . partsav(20,*), v(*), mss(8,*),sigsp(nsigi,*),
103 . volnod(*), bvolnod(*), vns(8,*), bns(8,*),bufmat(*),mcp(*),
104 . mcps(8,*), mcpsx(12,*),temp(*), tf(*), mssa(*),rnoise(nperturb,*)
105 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
106 INTEGER,INTENT(IN) :: ILOADP(SIZLOADP,*)
107 my_real,
INTENT(IN) :: facload(lfacload,*)
108 TYPE(DETONATORS_STRUCT_) ::
109 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
110 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
111 TYPE(SOLID_DEFAULTS_), INTENT(IN) :: DEFAULTS_SOLID
112 type (glob_therm_) ,intent(in) :: glob_therm
113
114
115
116 INTEGER I,NF1,IBID,IGTYP,IREP,IP,ILAY,NLAY,NUVAR,NCC,JHBE,
117 . NUVARR,IDEF,IPANG,IPTHK,,IPMAT,IG,IM,MTN0,,
118 . IPID1,NPTR,NPTS,,L_PLA,L_SIGB,IMAS_DS
119 INTEGER MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ), MAT0(MVSIZ)
120 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
121 . IX5(MVSIZ), IX6(MVSIZ)
123 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz), x5(mvsiz), x6(mvsiz),
124 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz), y5(mvsiz), y6(mvsiz),
125 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz), z5(mvsiz), z6(mvsiz)
126 CHARACTER(LEN=NCHARTITLE)::TITR1
128 . bid, fv, sti, zi,wi
130 . v8loc(51,mvsiz),volu(mvsiz),dtx(mvsiz),vzl(mvsiz),vzq(mvsiz),
131 . rx(mvsiz) ,ry(mvsiz) ,rz(mvsiz) ,sx(mvsiz) ,
132 . sy(mvsiz) ,sz(mvsiz) ,tx(mvsiz) ,ty(mvsiz) ,tz(mvsiz) ,
133 . e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),
134 . e2x(mvsiz),e2y(mvsiz),e2z(mvsiz),
135 . e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),
136 . f1x(mvsiz) ,f1y(mvsiz) ,f1z(mvsiz) ,llsh(mvsiz) ,
137 . f2x(mvsiz) ,f2y(mvsiz) ,f2z(mvsiz) ,rhocp(mvsiz),temp0(mvsiz), deltax(mvsiz), aire(mvsiz)
139
140 TYPE(G_BUFEL_) ,POINTER :: GBUF
141 TYPE(BUF_LAY_) ,POINTER :: BUFLY
142 TYPE(L_BUFEL_) ,POINTER :: LBUF
143 TYPE(BUF_MAT_) ,POINTER :: MBUF
144
146 . w_gauss(9,9),a_gauss(9,9),angle(mvsiz),dtx0(mvsiz)
147 DATA w_gauss /
148 1 2. ,0. ,0. ,
149 1 0. ,0. ,0. ,
150 1 0. ,0. ,0. ,
151 2 1. ,1. ,0. ,
152 2 0. ,0. ,0. ,
153 2 0. ,0. ,0. ,
154 3 0.555555555555556,0.888888888888889,0.555555555555556,
155 3 0. ,0. ,0. ,
156 3 0. ,0. ,0. ,
157 4 0.347854845137454,0.652145154862546,0.652145154862546,
158 4 0.347854845137454,0. ,0. ,
159 4 0. ,0. ,0. ,
160 5 0.236926885056189,0.478628670499366,0.568888888888889,
161 5 0.478628670499366,0.236926885056189,0. ,
162 5 0. ,0. ,0. ,
163 6 0.171324492379170,0.360761573048139,0.467913934572691,
164 6 0.467913934572691,0.360761573048139,0.171324492379170,
165 6 0. ,0. ,0. ,
166 7 0.129484966168870,0.279705391489277,0.381830050505119,
167 7 0.417959183673469,0.381830050505119,0.279705391489277,
168 7 0.129484966168870,0. ,0. ,
169 8 0.101228536290376,0.222381034453374,0.313706645877887,
170 8 0.362683783378362,0.362683783378362,0.313706645877887,
171 8 0.222381034453374,0.101228536290376,0. ,
172 9 0.081274388361574,0.180648160694857,0.260610696402935,
173 9 0.312347077040003,0.330239355001260,0.312347077040003,
174 9 0.260610696402935,0.180648160694857,0.081274388361574/
175 DATA a_gauss /
176 1 0. ,0. ,0. ,
177 1 0. ,0. ,0. ,
178 1 0. ,0. ,0. ,
179 2 -.577350269189626,0.577350269189626,0. ,
180 2 0. ,0. ,0. ,
181 2 0. ,0. ,0. ,
182 3 -.774596669241483,0. ,0.774596669241483,
183 3 0. ,0. ,0. ,
184 3 0. ,0. ,0. ,
185 4 -.861136311594053,-.339981043584856,0.339981043584856,
186 4 0.861136311594053,0. ,0. ,
187 4 0. ,0. ,0. ,
188 5 -.906179845938664,-.538469310105683,0. ,
189 5 0.538469310105683,0.906179845938664,0. ,
190 5 0. ,0. ,0. ,
191 6 -.932469514203152,-.661209386466265,-.238619186083197,
192 6 0.238619186083197,0.661209386466265,0.932469514203152,
193 6 0. ,0. ,0. ,
194 7 -.949107912342759,-.741531185599394,-.405845151377397,
195 7 0. ,0.405845151377397,0.741531185599394,
196 7 0.949107912342759,0. ,0. ,
197 8 -.960289856497536,-.796666477413627,-.525532409916329,
198 8 -.183434642495650,0.183434642495650,0.525532409916329,
199 8 0.796666477413627,0.960289856497536,0. ,
200 9 -.968160239507626,-.836031107326636,-.613371432700590,
201 9 -.324253423403809,0. ,0.324253423403809,
202 9 0.613371432700590,0.836031107326636,0.968160239507626/
203
204
205
206 gbuf => elbuf_str%GBUF
207 lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,1)
208 mbuf => elbuf_str%BUFLY(1)%MAT(1,1,1)
209 bufly => elbuf_str%BUFLY(1)
210 nptr = elbuf_str%NPTR
211 npts = elbuf_str%NPTS
212 nptt = elbuf_str%NPTT
213 nlay = elbuf_str%NLAY
214
215 jhbe = iparg(23)
216 irep = iparg(35)
217 igtyp = iparg(38)
218 nf1=nft+1
219 idef =0
220 ibid = 0
221 bid = zero
222 IF (igtyp /= 22) THEN
223 isorth = 0
224 END IF
225 imas_ds = defaults_solid%IMAS
226
227 DO i=1,nel
228 rhocp(i) = pm(69,ixs(1,nft+i))
229 temp0(i) = pm(79,ixs(1,nft+i))
230 ENDDO
231
232 CALL s6ccoor3(x ,ixs(1,nf1) ,geo ,ngl ,mat ,pid ,
233 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
234 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
235 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,temp0, temp,glob_therm%NINTEMP,
236 . ix1, ix2, ix3, ix4, ix5, ix6,
237 . x1, x2, x3, x4, x5, x6,
238 . y1, y2, y3, y4, y5, y6,
239 . z1, z2, z3, z4, z5, z6)
240 IF (igtyp == 21 .OR. igtyp == 22) THEN
241 DO i=1,nel
242 angle(i) = geo(1,pid(i))
243 END DO
244 CALL scmorth3(pid ,geo ,igeo ,skew ,irep ,gbuf%GAMA ,
245 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
246 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
247 . ngl ,angle,nsigi,sigsp,nsigs,sigi ,ixs ,1 ,
248 . orthoglob,ptsol,nel)
249 IF (igtyp == 22) THEN
250 nlymax= 200
251 ipang = 200
252 ipthk = ipang+nlymax
253 ippos = ipthk+nlymax
254 ipmat = 100
255 ig=pid(1)
256 mtn0=mtn
257 DO i=1,nel
258 mat0(i)=mat(i)
259 dtx0(i) = ep20
260 ENDDO
261 END IF
262 END IF
263 CALL s6cderi3(nel,gbuf%VOL,geo,vzl,ngl,deltax,volu ,
264 . x1, x2, x3, x4, x5, x6,
265 . y1, y2, y3, y4, y5, y6,
266 . z1, z2, z3, z4, z5, z6)
267 IF (idttsh > 0) THEN
269 . x1, x2, x3, x4, x5, x6,
270 . y1, y2, y3, y4, y5, y6,
271 . z1, z2, z3, z4, z5, z6)
272 DO i=1,nel
273 IF (gbuf%IDT_TSH(i)>0)
274 . deltax(i)=
max(llsh(i),deltax(i))
275 ENDDO
276 END IF
277
278
279
280 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
281 DO i=1,nel
282 tempel(i) = one_over_8 *(temp(ixs(2,i)) + temp(ixs(3,i))
283 . + temp(ixs(4,i)) + temp(ixs(5,i))
284 . + temp(ixs(6,i)) + temp(ixs(7,i))
285 . + temp(ixs(8,i)) + temp(ixs(9,i)))
286 ENDDO
287 ELSE
288 tempel(1:nel) = temp0(1:nel)
289 END IF
290
291 ip=0
292 CALL matini(pm ,ixs ,nixs ,x ,
293 . geo ,ale_connectivity ,detonators ,iparg ,
294 . sigi ,nel ,skew ,igeo ,
295 . ipart ,iparts ,
296 . mat ,ipm ,nsigs ,numsol ,ptsol ,
297 . ip ,ngl ,npf ,tf ,bufmat ,
298 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
299 . facload, deltax ,tempel )
300
301 IF (igtyp == 22)
CALL sczero3(gbuf%RHO,gbuf%SIG,gbuf%EINT,nel)
302
303
304 IF(jthe /=0)
CALL atheri(mat,pm,gbuf%TEMP)
305
306
307 DO ilay=1,nlay
308 lbuf => elbuf_str%BUFLY(ilay)%LBUF(1,1,1)
309 mbuf => elbuf_str%BUFLY(ilay)%MAT(1,1,1)
310 l_pla = elbuf_str%BUFLY(ilay)%L_PLA
311 l_sigb= elbuf_str%BUFLY(ilay)%L_SIGB
312
313 IF (igtyp == 22) THEN
314 zi = geo(ippos+ilay,ig)
315 wi = geo(ipthk+ilay,ig)
316 im=igeo(ipmat+ilay,ig)
317 mtn=nint(pm(19,im))
318 DO i=1,nel
319 mat(i)=im
320 angle(i) = geo(ipang+ilay,pid(i))
321 ENDDO
322 ELSE
323 zi = a_gauss(ilay,nlay)
324 wi = w_gauss(ilay,nlay)
325 ENDIF
326
327 DO i=1,nel
328 lbuf%VOL0DP(i)= half*wi*(gbuf%VOL(i)+vzl(i)*zi)
329 lbuf%VOL(i)= lbuf%VOL0DP(i)
330 ENDDO
331 IF (igtyp == 22)
332 .
CALL scmorth3(pid ,geo ,igeo ,skew ,irep ,lbuf%GAMA ,
333 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
334 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
335 . ngl ,angle,nsigi,sigsp,nsigs,sigi ,ixs,ilay,
336 . orthoglob,ptsol,nel)
337
338
339
340 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
341 DO i=1,nel
342 tempel(i) = one_over_8 *(temp(ixs(2,i)) + temp(ixs(3,i))
343 . + temp(ixs(4,i)) + temp(ixs(5,i))
344 . + temp(ixs(6,i)) + temp(ixs(7,i))
345 . + temp(ixs(8,i)) + temp(ixs(9,i)))
346 ENDDO
347 ELSE
348 tempel(1:nel) = temp0(1:nel)
349 END IF
350
351 CALL matini(pm ,ixs ,nixs ,x ,
352 . geo ,ale_connectivity ,detonators,iparg ,
353 . sigi ,nel ,skew ,igeo ,
354 . ipart ,iparts ,
355 . mat ,ipm ,nsigs ,numsol ,ptsol ,
356 . ilay ,ngl ,npf ,tf ,bufmat ,
357 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
358 . facload, deltax ,tempel )
359 IF (mtn >= 28) THEN
360 nuvar = ipm(8,ixs(1,nft+1))
361 idef =1
362 ELSE
363 nuvar = 0
364 IF(mtn == 14 .OR. mtn == 12)THEN
365 idef =1
366 ELSEIF(mtn == 24)THEN
367 idef =1
368 ELSEIF(istrain == 1)THEN
369 IF(mtn == 1)THEN
370 idef =1
371 ELSEIF(mtn == 2)THEN
372 idef =1
373 ELSEIF(mtn == 4)THEN
374 idef =1
375 ELSEIF(mtn == 3.OR.mtn == 6.OR.mtn == 10
376 . .OR.mtn == 21.OR.mtn == 22.OR.mtn == 23.OR.mtn == 49)THEN
377 idef =1
378 ENDIF
379 ENDIF
380 ENDIF
382 . lbuf%SIG,pm ,lbuf%VOL ,sigsp ,
383 . sigi ,lbuf%EINT,lbuf%RHO,mbuf%VAR ,lbuf%STRA,
384 . ixs ,nixs ,nsigi ,ilay ,nuvar ,
385 . nel ,iuser ,idef ,nsigs ,strsglob ,
386 . straglob,jhbe ,igtyp ,x ,lbuf%GAMA,
387 . mat ,lbuf%PLA ,l_pla ,ptsol ,lbuf%SIGB,
388 . l_sigb ,ipm ,bufmat ,lbuf%VOL0DP)
389
390 IF(igtyp == 22) THEN
391
392 aire(:) = zero
393 CALL dtmain(geo ,pm ,ipm ,pid ,mat ,fv ,
394 . lbuf%EINT ,lbuf%TEMP ,lbuf%DELTAX ,lbuf%RK ,lbuf%RE ,bufmat, deltax, aire,
395 . volu, dtx , igeo,igtyp)
396
398 . lbuf%RHO,lbuf%VOL,lbuf%OFF,lbuf%SIG,lbuf%EINT,dtx,
399 . gbuf%RHO,gbuf%VOL,gbuf%OFF,gbuf%SIG,gbuf%EINT,dtx0,
400 . nel )
401 ENDIF
402 ENDDO
403
404 IF(igtyp == 22) THEN
405 mtn=mtn0
406 DO i=1,nel
407 mat(i)=mat0(i)
408 ENDDO
409 ENDIF
410
411
412 CALL s6mass3(gbuf%RHO,mas,partsav,x,v,iparts(nf1),mss(1,nf1),
413 . rhocp,mcp ,mcps(1,nf1),mssa(nf1),gbuf%FILL, volu,
414 . ix1, ix2, ix3, ix4, ix5, ix6,imas_ds)
415
416
417 CALL failini(elbuf_str,nptr,npts,nptt,nlay,
418 . ipm,sigsp,nsigi,fail_ini ,
419 . sigi,nsigs,ixs,nixs,ptsol,
420 . rnoise,perturb,mat_param)
421
422
423
424 IF(i7stifs/=0)THEN
425 ncc=6
426 CALL sbulk3(volu ,ix1 ,ncc,mat,pm ,
427 2 volnod,bvolnod,vns(1,nf1),bns(1,nf1),bid,
428 3 bid ,gbuf%FILL)
429 ENDIF
430
431
432 aire(:) = zero
433 CALL dtmain(geo ,pm ,ipm ,pid ,mat ,fv ,
434 . lbuf%EINT ,lbuf%TEMP ,lbuf%DELTAX ,lbuf%RK ,lbuf%RE ,bufmat, deltax, aire,
435 . volu, dtx, igeo,igtyp)
436
437 IF(igtyp == 22) THEN
438 DO i=1,nel
439 dtx(i)=dtx0(i)
440 ENDDO
441 ENDIF
442
443 DO i=1,nel
444 IF(ixs(10,i+nft) /= 0) THEN
445 IF (igtyp < 20 .OR. igtyp > 22) THEN
446 ipid1=ixs(nixs-1,i+nft)
447 CALL fretitl2(titr1,igeo(npropgi-ltitr+1,ipid1),ltitr)
449 . msgtype=msgerror,
450 . anmode=aninfo_blind_1,
451 . i1=igeo(1,ipid1),
452 . c1=titr1,
453 . i2=igtyp)
454 ENDIF
455 ENDIF
456 dtelem(nft+i)=dtx(i)
457 sti = fourth * gbuf%FILL(i) * gbuf%RHO(i) * volu(i) /
458 .
max(em20,dtx(i)*dtx(i))
459 stifn(ixs(2,i+nft))=stifn(ixs(2,i+nft))+sti
460 stifn(ixs(3,i+nft))=stifn(ixs(3,i+nft))+sti
461 stifn(ixs(4,i+nft))=stifn(ixs(4,i+nft))+sti
462 stifn(ixs(5,i+nft))=stifn(ixs(5,i+nft))+sti
463 stifn(ixs(6,i+nft))=stifn(ixs(6,i+nft))+sti
464 stifn(ixs(7,i+nft))=stifn(ixs(7,i+nft))+sti
465 stifn(ixs(8,i+nft))=stifn(ixs(8,i+nft))+sti
466 stifn(ixs(9,i+nft))=stifn(ixs(9,i+nft))+sti
467 ENDDO
468
469 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 s6ccoor3(x, ixs, geo, ngl, mxt, ngeo, rx, ry, rz, sx, sy, sz, tx, ty, tz, r11, r21, r31, r12, r22, r32, r13, r23, r33, f1x, f1y, f1z, f2x, f2y, f2z, temp0, temp, nintemp, ix1, ix2, ix3, ix4, ix5, ix6, x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6, z1, z2, z3, z4, z5, z6)
subroutine sdlensh3n(nel, llsh3n, x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6, z1, z2, z3, z4, z5, z6)
subroutine s6mass3(rho, ms, partsav, x, v, ipart, mss, rhocp, mcp, mcps, mssa, fill, volu, nc1, nc2, nc3, nc4, nc5, nc6, imas_ds)
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 s6cderi3(nel, vol, geo, vzl, ngl, deltax, det, x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6, z1, z2, z3, z4, z5, z6)
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)
1.15.0