52 2 DETONATORS,GEO ,VEUL ,ALE_CONNECTIVITY ,IPARG ,
53 3 DTELEM ,SIGI ,NEL ,SKEW ,IGEO ,
54 4 STIFN ,PARTSAV ,V ,IPARTS ,MSS ,
55 5 IXS10 ,IPART ,GLOB_THERM,
56 7 MSSX ,SIGSP ,NSIGI ,IPM ,
57 8 IUSER ,NSIGS ,VOLNOD ,BVOLNOD,VNS ,
58 9 BNS ,VNSX ,BNSX ,PTSOL ,BUFMAT ,
59 A MCP ,MCPS ,MCPSX ,TEMP ,NPF ,
60 B TF ,IN ,STIFR ,INS ,MSSA ,
61 C STRSGLOB,STRAGLOB,FAIL_INI,ILOADP ,FACLOAD ,
62 D RNOISE ,PERTURB ,MAT_PARAM,DEFAULTS_SOLID)
78#include "implicit_f.inc"
91#include "vect01_c.inc"
96 INTEGER IXS(NIXS,*), IPARG(*),IPARTS(*),IGEO(NPROPGI,*),
97 . IXS10(6,*), IPART(LIPART1,*),IPM(NPROPMI,*),
98 . NPF(*),STRSGLOB(*),STRAGLOB(*),PTSOL(*),FAIL_INI(*),PERTURB(NPERTURB)
99 INTEGER NEL ,NSIGI,IUSER, NSIGS
101 . MAS(*),PM(NPROPM,*), X(*), GEO(NPROPG,*),
102 . VEUL(LVEUL,*), DTELEM(*),SIGI(NSIGS,*),SKEW(LSKEW,*),STIFN(*),
103 . PARTSAV(20,*), V(*), MSS(8,*), MSSX(12,*) , SIGSP(NSIGI,*),
104 . VOLNOD(*),BVOLNOD(*), VNS(8,*), BNS(8,*),RNOISE(NPERTURB,*),
105 . VNSX(12,*), BNSX(12,*) ,BUFMAT(*),MCP(*),MCPS(8,*),MCPSX(12,*),
106 . TEMP(*), TF(*), IN(*),STIFR(*), INS(8,*), MSSA(*)
107 TYPE(ELBUF_STRUCT_),
TARGET :: ELBUF_STR
108 INTEGER,
INTENT(IN) :: (SIZLOADP,*)
109 my_real,
INTENT(IN) :: FACLOAD(,*)
110 TYPE(DETONATORS_STRUCT_) :: DETONATORS
112 TYPE () ,
DIMENSION(NUMMAT) ,
INTENT(INOUT) :: MAT_PARAM
113 TYPE(SOLID_DEFAULTS_),
INTENT(IN) :: DEFAULTS_SOLID
114 type (glob_therm_) ,
intent(in) ::
118 INTEGER I,J,IP,NF1,NF2,IBID,IGTYP,NUVAR,IREP,NCC,IDEF,JHBE,IPID
119 INTEGER ID,NPTR,NPTS,NPTT,NLAY,L_PLA,L_SIGB,IBOLTP,IINT,IMAS_DS
120 CHARACTER(LEN=NCHARTITLE)::TITR
121 INTEGER NC(MVSIZ,10),MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ)
123 . xx(mvsiz,10), yy(mvsiz,10), zz(mvsiz,10)
126 . volu(mvsiz), mass(mvsiz),volg(mvsiz),
127 . volp(mvsiz,5), sti(mvsiz),deltax(mvsiz),deltax2(mvsiz),
128 . vx(mvsiz,10), vy(mvsiz,10), vz(mvsiz,10),
129 . px(mvsiz,10,5),py(mvsiz,10,5),pz(mvsiz,10,5),
130 . rx(mvsiz),ry(mvsiz),rz(mvsiz),
131 . sx(mvsiz),sy(mvsiz),sz(mvsiz),
132 . tx(mvsiz),ty(mvsiz),tz(mvsiz),
133 . e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),e2x(mvsiz),
134 . e2y(mvsiz),e2z(mvsiz),e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),
135 . nx(mvsiz,10,5), wip(5,5) ,alph(5,5),beta(5,5),masscp(mvsiz),
136 . rhocp(mvsiz),temp0(mvsiz), aire(mvsiz), dtx(mvsiz)
137 my_real :: tempel(nel)
140 TYPE(l_bufel_) ,
POINTER :: LBUF
141 TYPE(G_BUFEL_) ,
POINTER ::
142 TYPE(BUF_MAT_) ,
POINTER :: MBUF
144 DATA WIP / 1. ,0. ,0. ,0. ,0. ,
145 2 0. ,0. ,0. ,0. ,0. ,
146 3 0. ,0. ,0. ,0. ,0. ,
147 4 0.25,0.25,0.25,0.25,0. ,
148 5 0.45,0.45,0.45,0.45,-0.8/
149 DATA alph /0. ,0. ,0. ,0. ,0. ,
150 2 0. ,0. ,0. ,0. ,0. ,
151 3 0. ,0. ,0. ,0. ,0. ,
152 4 0.58541020,0.58541020,0.58541020,0.58541020,0. ,
153 5 0.5 ,0.5 ,0.5 ,0.5 ,0.25/
154 DATA beta /0. ,0. ,0. ,0. ,0. ,
155 2 0. ,0. ,0. ,0. ,0. ,
156 3 0. ,0. ,0. ,0. ,0. ,
157 4 0.13819660,0.13819660,0.13819660,0.13819660,0. ,
158 5 0.16666666666667,0.16666666666667,0.16666666666667,
159 5 0.16666666666667,0.25/
163 gbuf => elbuf_str%GBUF
171 IF (isrot == 1) nf2=1
173 nptr = elbuf_str%NPTR
174 npts = elbuf_str%NPTS
175 nptt = elbuf_str%NPTT
176 nlay = elbuf_str%NLAY
180 imas_ds = defaults_solid%IMAS
183 rhocp(i) = pm(69,ixs(1,nft+i))
184 temp0(i) = pm(79,ixs(1,nft+i))
188 1 x ,v ,ixs(1,nf1) ,ixs10(1,nf2) ,xx ,
189 2 yy ,zz ,vx ,vy ,vz ,
190 3 nc ,ngl ,mat ,pid ,mass ,
191 4 dtelem(nf1),sti ,gbuf%SIG ,gbuf%EINT ,gbuf%RHO,
192 5 gbuf%QVIS ,temp0 ,temp ,gbuf%SMSTR ,nel ,
193 6 glob_therm%NINTEMP)
196 . xx, yy, zz, px,py,pz, nx,
197 . rx, ry, rz, sx, sy, sz, tx, ty, tz,volu,gbuf%VOL,
199 CALL s10len3(volp,ngl,deltax,deltax2,
200 . px,py,pz, volu,gbuf%VOL,volg,
201 . rx, ry, rz, sx, sy, sz, tx, ty, tz,
202 . nel,mat,pm,gbuf%DT_PITER,iint)
204 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
205 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
206 IF (igtyp == 6 .OR. igtyp == 21)
207 .
CALL smorth3(pid ,geo ,igeo ,skew ,irep ,gbuf%GAMA ,
208 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
209 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
210 . rx ,ry ,rz ,sx ,sy ,sz ,nsigi,sigsp,nsigs,
211 . sigi ,ixs ,x ,jhbe ,ptsol,nel ,iparg(28))
220 IF(jthe /=0)
CALL atheri(mat,pm,gbuf%TEMP)
225 lbuf => elbuf_str%BUFLY(1)%LBUF(ip,1,1)
226 mbuf => elbuf_str%BUFLY(1)%MAT(ip,1,1)
227 l_pla = elbuf_str%BUFLY(1)%L_PLA
228 l_sigb =elbuf_str%BUFLY(1)%L_SIGB
240 IF(jthe /=0)
CALL atheri(mat,pm,lbuf%TEMP)
241 IF (jthe == 0 .and. glob_therm%NINTEMP > 0)
THEN
245 tempel(i)= tempel(i) + nx(i,j,ip)*temp(nc(i,j))
249 tempel(1:nel) = temp0(1:nel)
252 CALL matini(pm ,ixs ,nixs ,x ,
253 . geo ,ale_connectivity ,detonators,iparg ,
254 . sigi ,nel ,skew ,igeo ,
256 . mat ,ipm ,nsigs ,numsol ,ptsol ,
257 . ip ,ngl ,npf ,tf ,bufmat ,
258 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
259 . facload, deltax ,tempel )
264 CALL dtmain(geo ,pm ,ipm ,pid ,mat ,fv ,
265 . lbuf%EINT ,lbuf%TEMP ,lbuf%DELTAX ,lbuf%RK ,lbuf%RE ,bufmat, deltax, aire,
266 . volu, dtx , igeo,igtyp)
270 CALL s10msi(lbuf%RHO,mass,volu,dtelem
271 . lbuf%OFF,lbuf%SIG ,lbuf%EINT ,
273 . masscp ,rhocp ,gbuf%FILL,nel, dtx)
279 nuvar = ipm(8,ixs(1,nft+1))
283 IF(mtn == 14 .OR. mtn == 12)
THEN
285 ELSEIF(mtn == 24)
THEN
287 ELSEIF(istrain == 1)
THEN
294 ELSEIF(mtn == 3.OR.mtn == 6.OR.mtn == 10.OR.
295 . mtn == 21.OR.mtn == 22.OR.mtn == 23.
304 . lbuf%SIG,pm, lbuf%VOL,sigsp,
305 . sigi,lbuf%EINT,lbuf%RHO,mbuf%VAR ,lbuf%STRA,
306 . ixs ,nixs,nsigi, ip, nuvar,
307 . nel,iuser,idef,nsigs ,strsglob,
308 . straglob,jhbe,igtyp,x,lbuf%GAMA,
309 . mat ,lbuf%PLA,l_pla,ptsol,lbuf%SIGB,
310 . l_sigb,ipm ,bufmat ,lbuf%VOL0DP)
315 IF (isigi /= 0 .AND. isorth/=0)
THEN
322 CALL sboltini(e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
328 CALL s10mass3(mass,mas,partsav,iparts(nf1),mss(1,nf1),volu,
329 . xx ,yy ,zz ,vx ,vy ,vz
330 . nc ,sti,stifn ,deltax2 ,mssx(1,nf1),masscp,
331 . mcp ,mcps(1,nf1),mcpsx(1,nf1),in ,stifr,
332 . ins(1,nf1),mssa(nf1),x ,gbuf%FILL ,imas_ds)
336 CALL failini(elbuf_str,nptr,npts,nptt,nlay,
337 . ipm,sigsp,nsigi,fail_ini ,
338 . sigi,nsigs,ixs,nixs,ptsol,
339 . rnoise,perturb,mat_param)
346 CALL sbulk3(volu ,nc ,ncc,mat,pm ,
347 2 volnod,bvolnod,vns(1,nf1),bns(1,nf1),
348 3 vnsx(1,nf1),bnsx(1,nf1) ,gbuf%FILL)
352 IF(ixs(10,i+nft)/=0)
THEN
353 IF( igtyp/=0 .AND.igtyp/=6
354 . .AND.igtyp/=14.AND.igtyp/=15)
THEN
355 ipid=ixs(nixs-1,i+nft)
357 CALL fretitl2(titr,igeo(npropgi-ltitr+1,ipid),ltitr)
360 . anmode=aninfo_blind_1,