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)
75 use element_mod ,
only : nixs
79#include "implicit_f.inc"
92#include "vect01_c.inc"
97 INTEGER IXS(NIXS,*), IPARG(*),IPARTS(*),IGEO(NPROPGI,*),
98 . IXS10(6,*), IPART(LIPART1,*),IPM(NPROPMI,*),
99 . NPF(*),STRSGLOB(*),STRAGLOB(*),PTSOL(*),FAIL_INI(*),PERTURB(NPERTURB)
100 INTEGER NEL ,NSIGI,IUSER, NSIGS
102 . MAS(*),PM(NPROPM,*), X(*), GEO(NPROPG,*),
103 . VEUL(LVEUL,*), DTELEM(*),SIGI(NSIGS,*),SKEW(LSKEW,*),STIFN(*),
104 . PARTSAV(20,*), V(*), MSS(8,*), MSSX(12,*) , SIGSP(NSIGI,*),
105 . VOLNOD(*),BVOLNOD(*), VNS(8,*), BNS(8,*),RNOISE(NPERTURB,*),
106 . VNSX(12,*), BNSX(12,*) ,BUFMAT(*),MCP(*),MCPS(8,*),MCPSX(12,*),
107 . TEMP(*), TF(*), IN(*),STIFR(*), INS(8,*), MSSA(*)
108 TYPE(ELBUF_STRUCT_),
TARGET :: ELBUF_STR
109 INTEGER,
INTENT(IN) :: ILOADP(SIZLOADP,*)
110 my_real,
INTENT(IN) :: FACLOAD(LFACLOAD,*)
111 TYPE(DETONATORS_STRUCT_) :: DETONATORS
113 TYPE (MATPARAM_STRUCT_) ,
DIMENSION(NUMMAT) ,
INTENT(INOUT) :: MAT_PARAM
114 TYPE(SOLID_DEFAULTS_),
INTENT(IN) :: DEFAULTS_SOLID
115 type (glob_therm_) ,
intent(in) :: glob_therm
119 INTEGER I,J,IP,NF1,NF2,IGTYP,NUVAR,IREP,NCC,IDEF,JHBE,IPID
120 INTEGER ID,NPTR,NPTS,NPTT,NLAY,L_PLA,L_SIGB,IBOLTP,IINT,IMAS_DS
121 CHARACTER(LEN=NCHARTITLE)::TITR
122 INTEGER NC(MVSIZ,10),MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ)
124 . xx(mvsiz,10), yy(mvsiz,10), zz(mvsiz,10)
127 . volu(mvsiz), mass(mvsiz),volg(mvsiz),
128 . volp(mvsiz,5), sti(mvsiz),deltax(mvsiz),deltax2(mvsiz),
129 . vx(mvsiz,10), vy(mvsiz,10), vz(mvsiz,10),
130 . px(mvsiz,10,5),py(mvsiz,10,5),pz(mvsiz,10,5),
131 . rx(mvsiz),ry(mvsiz),rz(mvsiz),
132 . sx(mvsiz),sy(mvsiz),sz(mvsiz),
133 . tx(mvsiz),ty(mvsiz),tz(mvsiz),
134 . e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),e2x(mvsiz),
135 . e2y(mvsiz),e2z(mvsiz),e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),
136 . nx(mvsiz,10,5), wip(5,5) ,alph(5,5),beta(5,5),masscp(mvsiz),
137 . rhocp(mvsiz),temp0(mvsiz), aire(mvsiz), dtx(mvsiz)
138 my_real :: tempel(nel)
141 TYPE(l_bufel_) ,
POINTER :: LBUF
142 TYPE(G_BUFEL_) ,
POINTER :: GBUF
143 TYPE(BUF_MAT_) ,
POINTER :: MBUF
145 DATA WIP / 1. ,0. ,0. ,0. ,0. ,
146 2 0. ,0. ,0. ,0. ,0. ,
147 3 0. ,0. ,0. ,0. ,0. ,
148 4 0.25,0.25,0.25,0.25,0. ,
149 5 0.45,0.45,0.45,0.45,-0.8/
150 DATA alph /0. ,0. ,0. ,0. ,0. ,
151 2 0. ,0. ,0. ,0. ,0. ,
152 3 0. ,0. ,0. ,0. ,0. ,
153 4 0.58541020,0.58541020,0.58541020,0.58541020,0. ,
154 5 0.5 ,0.5 ,0.5 ,0.5 ,0.25/
155 DATA beta /0. ,0. ,0. ,0. ,0. ,
156 2 0. ,0. ,0. ,0. ,0. ,
157 3 0. ,0. ,0. ,0. ,0. ,
158 4 0.13819660,0.13819660,0.13819660,0.13819660,0. ,
159 5 0.16666666666667,0.16666666666667,0.16666666666667,
160 5 0.16666666666667,0.25/
164 gbuf => elbuf_str%GBUF
172 IF (isrot == 1) nf2=1
174 nptr = elbuf_str%NPTR
175 npts = elbuf_str%NPTS
176 nptt = elbuf_str%NPTT
177 nlay = elbuf_str%NLAY
181 imas_ds = defaults_solid%IMAS
184 rhocp(i) = pm(69,ixs(1,nft+i))
185 temp0(i) = pm(79,ixs(1,nft+i))
189 1 x ,v ,ixs(1,nf1) ,ixs10(1,nf2) ,xx ,
190 2 yy ,zz ,vx ,vy ,vz ,
192 4 dtelem(nf1),sti ,gbuf%SIG ,gbuf%EINT ,gbuf%RHO,
193 5 gbuf%QVIS ,temp0 ,temp ,gbuf%SMSTR ,nel ,
194 6 glob_therm%NINTEMP)
197 . xx, yy, zz, px,py,pz, nx,
198 . rx, ry, rz, sx, sy, sz, tx, ty, tz,volu,gbuf%VOL,
200 CALL s10len3(volp,ngl,deltax,deltax2,
201 . px,py,pz, volu,gbuf%VOL,volg,
202 . rx, ry, rz, sx, sy, sz, tx, ty, tz,
203 . nel,mat,pm,gbuf%DT_PITER,iint)
205 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
206 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
207 IF (igtyp == 6 .OR. igtyp == 21)
208 .
CALL smorth3(pid ,geo ,igeo ,skew ,irep ,gbuf%GAMA ,
209 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
210 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
211 . rx ,ry ,rz ,sx ,sy ,sz ,nsigi,sigsp,nsigs,
212 . sigi ,ixs ,x ,jhbe ,ptsol,nel ,iparg(28))
221 IF(jthe /=0)
CALL atheri(mat,pm,gbuf%TEMP)
226 lbuf => elbuf_str%BUFLY(1)%LBUF(ip,1,1)
227 mbuf => elbuf_str%BUFLY(1)%MAT(ip,1,1)
228 l_pla = elbuf_str%BUFLY(1)%L_PLA
229 l_sigb =elbuf_str%BUFLY(1)%L_SIGB
241 IF(jthe /=0)
CALL atheri(mat,pm,lbuf%TEMP)
242 IF (jthe == 0 .and. glob_therm%NINTEMP > 0)
THEN
246 tempel(i)= tempel(i) + nx(i,j,ip)*temp(nc(i,j))
250 tempel(1:nel) = temp0(1:nel)
253 CALL matini(pm ,ixs ,nixs ,x ,
254 . geo ,ale_connectivity ,detonators,iparg ,
255 . sigi ,nel ,skew ,igeo ,
257 . mat ,ipm ,nsigs ,numsol ,ptsol ,
258 . ip ,ngl ,npf ,tf ,bufmat ,
259 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
260 . facload, deltax ,tempel ,mat_param )
265 CALL dtmain(geo ,pm ,ipm ,pid ,mat ,fv ,
266 . lbuf%EINT ,lbuf%TEMP ,lbuf%DELTAX ,lbuf%RK ,lbuf%RE ,bufmat, deltax, aire,
267 . volu, dtx , igeo,igtyp)
271 CALL s10msi(lbuf%RHO,mass,volu,dtelem(nft+1),sti,
273 . gbuf%OFF,gbuf%SIG,gbuf%EINT,gbuf%RHO,wip(npt,ip),
274 . masscp ,rhocp ,gbuf%FILL,nel, dtx)
280 nuvar = ipm(8,ixs(1,nft+1))
284 IF(mtn == 14 .OR. mtn == 12)
THEN
286 ELSEIF(mtn == 24)
THEN
288 ELSEIF(istrain == 1)
THEN
295 ELSEIF(mtn == 3.OR.mtn == 6.OR.mtn == 10.OR.
296 . mtn == 21.OR.mtn == 22.OR.mtn == 23.
305 . lbuf%SIG,pm, lbuf%VOL,sigsp,
306 . sigi,lbuf%EINT,lbuf%RHO,mbuf%VAR ,lbuf%STRA,
307 . ixs ,nixs,nsigi, ip, nuvar,
308 . nel,iuser,idef,nsigs ,strsglob,
309 . straglob,jhbe,igtyp,x,lbuf%GAMA,
310 . mat ,lbuf%PLA,l_pla,ptsol,lbuf%SIGB,
311 . l_sigb,ipm ,bufmat ,lbuf%VOL0DP)
316 IF (isigi /= 0 .AND. isorth/=0)
THEN
323 CALL sboltini(e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
329 CALL s10mass3(mass,mas,partsav,iparts(nf1),mss(1,nf1),volu,
330 . xx ,yy ,zz ,vx ,vy ,vz ,
331 . nc ,sti,stifn ,deltax2 ,mssx(1,nf1),masscp,
332 . mcp ,mcps(1,nf1),mcpsx(1,nf1),in ,stifr,
333 . ins(1,nf1),mssa(nf1),x ,gbuf%FILL ,imas_ds)
337 CALL failini(elbuf_str,nptr,npts,nptt,nlay,
338 . ipm,sigsp,nsigi,fail_ini ,
339 . sigi,nsigs,ixs,nixs,ptsol,
340 . rnoise,perturb,mat_param)
347 CALL sbulk3(volu ,nc ,ncc,mat,pm ,
348 2 volnod,bvolnod,vns(1,nf1),bns(1,nf1),
349 3 vnsx(1,nf1),bnsx(1,nf1) ,gbuf%FILL)
353 IF(ixs(10,i+nft)/=0)
THEN
354 IF( igtyp/=0 .AND.igtyp/=6
355 . .AND.igtyp/=14.AND.igtyp/=15)
THEN
356 ipid=ixs(nixs-1,i+nft)
358 CALL fretitl2(titr,igeo(npropgi-ltitr+1,ipid),ltitr)
361 . anmode=aninfo_blind_1,