74 . GEO ,ALE_CONNECTIVITY ,DETONATORS ,IPARG ,
75 . SIGI ,NEL ,SKEW ,IGEO ,
77 . MAT ,IPM ,NSIG ,NUMS ,PT ,
78 . IPT ,NGL ,NPF ,TF ,BUFMAT ,
79 . GBUF ,LBUF ,MBUF ,ELBUF_STR ,ILOADP ,
80 . FACLOAD ,DDELTAX ,TEMPEL )
92#include "implicit_f.inc"
100#include "com01_c.inc"
101#include "com04_c.inc"
102#include "param_c.inc"
103#include "scr19_c.inc"
104#include "units_c.inc"
105#include "vect01_c.inc"
106#include "scr17_c.inc"
110 INTEGER NIX,NEL,NSIG,NUMS,IPT,JALE_FROM_PROP,JALE_FROM_MAT,JALE_MAX
111 INTEGER IX(NIX,*), IPARG(*),IPART(LIPART1,*),IPARTEL(*),MAT(*),IPM(NPROPMI,*),PT(*), NGL(*),NPF(*)
112 INTEGER,
INTENT(IN) :: IGEO(NPROPGI,NUMGEO)
113 INTEGER,
INTENT(IN) :: ILOADP(SIZLOADP,*)
114 my_real X(*), GEO(*), PM(NPROPM,*),SIGI(NSIG,*),SKEW(LSKEW,*),BUFMAT(*),TF(*)
115 my_real,
INTENT(IN) :: FACLOAD(LFACLOAD,*)
116 my_real,
INTENT(IN) :: DDELTAX(*)
117 my_real,
INTENT(IN) :: tempel(nel)
118 TYPE(g_bufel_),
TARGET :: GBUF
119 TYPE(l_bufel_),
TARGET :: LBUF
120 TYPE(buf_mat_) :: MBUF
121 TYPE(elbuf_struct_),
TARGET :: ELBUF_STR
128 CHARACTER(LEN=NCHARTITLE)::TITR
129 INTEGER I,IADBUF,NPAR,NFUNC,NUVAR,IFORM,NUMEL
130 INTEGER IFUNC(MAXFUNC)
133 my_real ,
DIMENSION(MVSIZ) ,
TARGET :: TMP,EPL,FILLO
134 my_real ,
DIMENSION(:) ,
POINTER ::
135 . off,sig,eint,rho,vol,epsd,deltax,tb,ang,sf,vk,rob,uvar,eplas,fill,
dtel,uparam,temp
141 off => gbuf%OFF(1:nel)
142 sig => gbuf%SIG(1:nel*6)
143 eint => gbuf%EINT(1:nel)
144 epsd => gbuf%EPSD(1:nel)
145 rho => gbuf%RHO(1:nel)
146 vol => gbuf%VOL(1:nel)
147 IF(
SIZE(gbuf%DELTAX)>0) deltax=> gbuf%DELTAX(1:nel)
148 IF(
SIZE(gbuf%TB)>0) tb => gbuf%TB(1:nel)
149 dtel => gbuf%DT(1:nel)
150 IF (gbuf%G_TEMP > 0)
THEN
151 temp => gbuf%TEMP(1:nel)
155 IF (gbuf%G_PLA > 0)
THEN
156 eplas => gbuf%PLA(1:nel)
161 off => lbuf%OFF(1:nel)
162 sig => lbuf%SIG(1:nel*6)
163 eint => lbuf%EINT(1:nel)
164 epsd => lbuf%EPSD(1:nel)
165 rho => lbuf%RHO(1:nel)
166 vol => lbuf%VOL(1:nel)
167 IF(
SIZE(lbuf%DELTAX)>0) deltax=> lbuf%DELTAX(1:nel)
168 IF(
SIZE(lbuf%TB)>0) tb => lbuf%TB(1:nel)
169 IF (elbuf_str%BUFLY(1)%L_TEMP > 0)
THEN
170 temp => lbuf%TEMP(1:nel)
174 IF (elbuf_str%BUFLY(1)%L_PLA > 0)
THEN
175 eplas => lbuf%PLA(1:nel)
182 fill => gbuf%FILL(1:nel)
188 CALL mating(pm ,vol ,off ,eint ,rho ,
189 . sig ,ix ,nix ,sigi ,eplas ,
190 . nsig ,mat ,nums ,pt ,nel ,
191 . fill ,temp ,tempel )
203 ELSEIF (mtn == 2.OR.mtn == 3.OR.mtn == 4)
THEN
206 ELSEIF (mtn == 5)
THEN
209 CALL m5in3 (pm,mat,0,detonators,tb,iparg,x,ix,nix)
211 CALL m5in2 (pm,mat,0,detonators,tb,x,ix,nix)
214 ELSEIF (mtn == 6)
THEN
216 CALL m6in(pm,mat,sig,rho,nel)
220 ELSEIF (mtn == 10)
THEN
223 ELSEIF (mtn == 11)
THEN
231 jale_from_prop = igeo(62,iabs(ix(nix-1,1)))
232 jale_from_mat = iparg(7)+iparg(11)
233 jale_max =
max(jale_from_prop, jale_from_mat)
235 CALL mat11check(pm,nix,ix,ale_connectivity,numel,jale_max,nel,nft,id,nummat,npropm)
236 ELSEIF (mtn == 12)
THEN
240 WRITE(iout,
'(A)')
' LAW 12 IS NOT AVAILABLE IN 2D ANALYSIS'
243 ELSEIF (mtn == 14)
THEN
247 WRITE(iout,
'(A)')
' LAW 14 IS NOT AVAILABLE IN 2D ANALYSIS'
250 ELSEIF (mtn == 16)
THEN
253 ELSEIF (mtn == 17)
THEN
255 CALL m6in(pm,mat,sig,rho,nel)
259 ELSEIF (mtn == 18)
THEN
260 CALL athlen(deltax, ddeltax)
263 CALL agrad3(ix,x,ale_connectivity,sig,nel)
265 CALL agrad2(ix,x,ale_connectivity,sig,nel)
268 ELSEIF (mtn == 20)
THEN
270 CALL ancmsg(msgid=129,msgtype=msgerror,anmode=aninfo)
273 ELSEIF (mtn == 21 .OR. mtn == 22 .OR. mtn == 23)
THEN
276 ELSEIF (mtn == 24)
THEN
279 ang => lbuf%ANG(1:nel*6)
280 sf => lbuf%SF(1:nel*3)
282 rob => lbuf%ROB(1:nel)
285 CALL m24in3(pm ,ix ,ang ,sf ,vk ,rob, nel)
287 CALL m24in2(pm ,ix ,ang ,sf ,vk ,rob, nel)
290 CALL m24insph(pm ,ang ,sf ,vk ,rob ,
291 . ipart ,ipartel ,nel )
293 ELSEIF (mtn == 26)
THEN
296 ELSEIF (mtn == 46.OR.mtn == 47)
THEN
298 ELSEIF (mtn == 49)
THEN
301 ELSEIF (mtn >= 28)
THEN
308 nuvar = ipm(8,mat(1))
310 iadbuf = ipm(7,mat(1))
311 iadbuf =
max(1,iadbuf)
312 uparam => bufmat(iadbuf:iadbuf+npar)
315 rho0(i)= pm( 1,mat(i))
318 nfunc = ipm(10,mat(1))
320 ifunc(i) = ipm(10+i,mat(1))
326 . ngl ,nuvar ,mbuf%VAR ,uparam ,x ,
327 . mat ,iparg ,iform ,ix ,nix ,
328 . iloadp ,facload ,gbuf ,nel)
329 ELSEIF (mtn == 38)
THEN
331 1 nel ,npar ,nuvar ,nfunc ,ifunc ,
332 2 npf ,tf ,bufmat(iadbuf),rho0 ,vol ,
334 ELSEIF (mtn == 51)
THEN
335 CALL m51init(ipm ,detonators ,pm ,tb ,
336 . nuvar ,mbuf%VAR ,uparam ,x ,
337 . mat ,iparg ,iform ,ix ,nix ,
338 . ale_connectivity ,bufmat ,rho0 ,
340 ELSEIF (mtn == 70)
THEN
341 CALL m70init(nel ,npar ,nuvar ,uparam ,mbuf%VAR)
343 ELSEIF (mtn == 75)
THEN
345 CALL fretitl2(titr,ipm(npropmi-ltitr+1,mat(1)),ltitr)
347 1 nel ,npar ,nuvar ,nfunc ,ifunc ,
348 2 npf ,tf ,uparam ,rho0 ,vol ,
349 3 eint ,mbuf%VAR,pm ,id ,titr )
350 ELSEIF (mtn == 77)
THEN
352 1 nel ,npar ,nuvar ,nfunc ,ifunc ,
353 2 npf ,tf ,uparam ,rho0 ,vol ,
356 ELSEIF (mtn == 95)
THEN
357 CALL m95init(nel ,nuvar ,mbuf%VAR)
358 ELSEIF (mtn == 97)
THEN
362 . ipm ,detonators,pm ,
363 . nuvar ,mbuf%VAR ,bufmat(iadbuf) ,x ,
364 . mat ,iparg ,iform ,ix ,nix ,
366 ELSEIF (mtn == 102)
THEN
369 ELSEIF (mtn == 105)
THEN
373 . ipm ,detonators,pm ,
374 . nuvar ,mbuf%VAR ,bufmat(iadbuf) ,x ,
375 . mat ,iparg ,iform ,ix ,nix ,
382 IF(elbuf_str%BUFLY(1)%L_SSP /= 0)
THEN
384 lbuf%SSP(i)=pm(27,mat(i))
subroutine athlen(delt, deltax)
subroutine dtel(ssp, pm, geo, pid, mat, rho0, vis, deltax, aire, vol, dtx)
subroutine m105init(ipm, detonators, pm, nuvar, uvar, uparam, x, mat, iparg, iform, ix, nix, bufmat, rho0, tb)
subroutine m24in2(pm, ix, ang, sf, vk0, rob, nel)
subroutine m24in3(pm, ix, ang, sf, vk0, rob, nel)
subroutine m24insph(pm, ang, sf, vk0, rob, ipart, ipartsp, nel)
subroutine m37init(ipm, pm, ngl, nuvar, uvar, uparam, x, mat, iparg, iform, ix, nix, iloadp, facload, gbuf, nel)
subroutine m38init(nel, nuparam, nuvar, nfunc, ifunc, npf, tf, uparam, rho0, volume, eint, uvar)
subroutine m51init(ipm, detonators, pm, tb, nuvar, uvar, uparam, x, mat, iparg, iform, ix, nix, ale_connectivity, bufmat, rho0, gbuf, nel, sig)
subroutine m5in2(pm, mat, m151_id, detonators, tb, x, ix, nix)
subroutine m5in3(pm, mat, m151_id, detonators, tb, iparg, x, ix, nix)
subroutine m6in(pm, mat, sig, rho, nel)
subroutine m70init(nel, nuparam, nuvar, uparam, uvar)
subroutine m75init(nel, nuparam, nuvar, nfunc, ifunc, npf, tf, uparam, rho0, volume, eint, uvar, pm, id, titr)
subroutine m77init(nel, nuparam, nuvar, nfunc, ifunc, npf, tf, uparam, rho0, volume, eint, uvar)
subroutine m95init(nel, nuvar, uvar)
subroutine m97init(ipm, detonators, pm, nuvar, uvar, uparam, x, mat, iparg, iform, ix, nix, bufmat, rho0, tb)
subroutine mat11check(pm, nix, ix, ale_connectivity, numel, jale_from_prop, nel, nft, mat_id, nummat, npropm)
subroutine mating(pm, vol, off, eint, rho, sig, ix, nix, sigi, epsp, nsig, mat, nums, pt, nel, fill, temp, tempel)
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 s6cinit3(elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ipart, glob_therm, sigsp, nsigi, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, ptsol, bufmat, mcp, mcps, mcpsx, temp, npf, tf, strsglob, straglob, mssa, orthoglob, fail_ini, iloadp, facload, rnoise, perturb, mat_param, defaults_solid)
subroutine agrad2(ixq, x, ale_connectivity, grad, nel)
subroutine agrad3(ixs, x, ale_connectivity, grad, nel)
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)