54 1 ELBUF_STR,MAS ,IXS ,PM ,X ,
55 2 DETONATORS,GEO ,VEUL ,ALE_CONNECTIVITY ,IPARG_GR,
56 3 DTELEM ,SIGI ,NEL ,SKEW ,IGEO ,
57 4 STIFN ,PARTSAV ,V ,IPARTS ,MSS ,
58 5 IPART ,MSNF ,IPARG ,
59 6 MSSF ,IPM ,NSIGS ,VOLNOD ,BVOLNOD ,
60 7 VNS ,BNS ,WMA ,PTSOL ,BUFMAT ,
61 8 MCP ,MCPS ,TEMP ,NPF ,TF ,
62 9 IUSER ,SIGSP ,NSIGI ,MSSA ,XREFS ,
63 A STRSGLOB ,STRAGLOB,FAIL_INI,SPBUF ,SOL2SPH ,
64 B ILOADP ,FACLOAD ,RNOISE ,PERTURB ,MAT_PARAM,
65 C DEFAULTS_SOLID ,NINTEMP )
77 use element_mod ,
only : nixs
81#include "implicit_f.inc"
95#include "vect01_c.inc"
100 INTEGER IXS(NIXS,*),IPARG_GR(NPARG),IPARG(NPARG,NGROUP),
101 . IPARTS(*),IPART(LIPART1,*),IGEO(NPROPGI,*),PTSOL(*),NPF(*),
102 . IPM(NPROPMI,*),STRSGLOB(*),STRAGLOB(*),FAIL_INI(*),SOL2SPH(2,*),
104 INTEGER NEL, NSIGS, IUSER, NSIGI
105 INTEGER ,
INTENT(IN) :: NINTEMP
107 . MAS(*), PM(NPROPM,*), X(*), GEO(NPROPG,*),
108 . VEUL(LVEUL,*), DTELEM(*),SIGI(NSIGS,*),SKEW(LSKEW,*),STIFN(*),
109 . PARTSAV(20,*), V(*), MSS(8,*) ,
110 . MSNF(*), MSSF(8,*),WMA(*),XREFS(8,3,*),
111 . VOLNOD(*), BVOLNOD(*), VNS(8,*), BNS(8,*),BUFMAT(*),
112 . mcp(*), mcps(8,*), temp(*), tf(*),sigsp(nsigi,*), mssa(*),
113 . spbuf(nspbuf,*),rnoise(nperturb,*)
114 TYPE(elbuf_struct_),
TARGET :: ELBUF_STR
115 INTEGER,
INTENT(IN) :: ILOADP(SIZLOADP,*)
116 my_real,
INTENT(IN) :: facload(lfacload,*)
119 TYPE (MATPARAM_STRUCT_)
DIMENSION(NUMMAT)INTENT(INOUT)
120TYPE(SOLID_DEFAULTS_),
INTENT(IN) :: DEFAULTS_SOLID
124 INTEGER NF1,I,IGTYP,IREP,NCC,IP,NUVAR,IDEF,JHBE,IPID1,NPTR,NPTS,NPTT,NLAY,L_SIGB,L_PLA,IMAS_DS
125 INTEGER MAT(MVSIZ), (MVSIZ), NGL(MVSIZ), IXT4(MVSIZ,4)
126 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ)
127 INTEGER NSPHDIR,NCELF,NCELL,IBOLTP
129 . x1(mvsiz),x2(mvsiz),x3(mvsiz),x4(mvsiz),y1(mvsiz),y2(mvsiz),
130 . y3(mvsiz),y4(mvsiz),z1(mvsiz),z2(mvsiz),z3(mvsiz),z4(mvsiz)
131 CHARACTER(LEN=NCHARTITLE)::TITR1
135 . rx(mvsiz),ry(mvsiz),rz(mvsiz),
136 . sx(mvsiz),sy(mvsiz),sz(mvsiz),
137 . tx(mvsiz),ty(mvsiz),tz(mvsiz),
138 . e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),e2x(mvsiz),
139 . e2y(mvsiz),e2z(mvsiz),e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),
140 . px1(mvsiz),px2(mvsiz),px3(mvsiz),px4(mvsiz),
141 . py1(mvsiz),py2(mvsiz),py3(mvsiz),py4(mvsiz),
142 . pz1(mvsiz),pz2(mvsiz),pz3(mvsiz),pz4(mvsiz),
143 . volu(mvsiz), dtx(mvsiz),rhocp(mvsiz),
144 . temp0(mvsiz), deltax(mvsiz), aire(mvsiz)
145 my_real :: tempel(nel)
147 TYPE(l_bufel_) ,
POINTER :: LBUF
148 TYPE(G_BUFEL_) ,
POINTER :: GBUF
149 TYPE(BUF_MAT_) ,
POINTER :: MBUF
153 GBUF => elbuf_str%GBUF
154 lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,1)
155 mbuf => elbuf_str%BUFLY(1)%MAT(1,1,1)
160 nptr = elbuf_str%NPTR
161 npts = elbuf_str%NPTS
162 nptt = elbuf_str%NPTT
163 nlay = elbuf_str%NLAY
164 l_sigb= elbuf_str%BUFLY(1)%L_SIGB
165 l_pla = elbuf_str%BUFLY(1)%L_PLA
168 nuvar = ipm(8,ixs(1,nf1))
173 imas_ds = defaults_solid%IMAS
174 iboltp = iparg_gr(72)
178 rhocp(i) = pm(69,ixs(1,nft+i))
179 temp0(i) = pm(79,ixs(1,nft+i))
182 CALL s4coor3(x ,xrefs(1,1,nf1),ixs(1,nf1),ngl ,
183 . mat ,pid ,ix1 ,ix2 ,ix3 ,ix4 ,
184 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
185 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 )
186 CALL s4deri3(gbuf%VOL,veul(1,nf1),geo ,igeo ,rx ,
189 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
190 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
191 . px1 ,px2 ,px3 ,px4 ,
192 . py1 ,py2 ,py3 ,py4 ,
193 . pz1 ,pz2 ,pz3 ,pz4 ,gbuf%JAC_I,
194 . deltax ,volu ,ngl ,pid ,mat ,
198 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
199 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
200 IF (igtyp == 6 .OR. igtyp == 21)
201 .
CALL smorth3(pid ,geo ,igeo ,skew ,irep ,gbuf%GAMA ,
202 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
203 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
204 . rx ,ry ,rz ,sx ,sy ,sz ,nsigi,sigsp,nsigs,
205 . sigi ,ixs ,x ,jhbe ,ptsol,nel ,iparg_gr(28))
209 IF (jthe == 0 .and. nintemp > 0)
THEN
211 tempel(i) = one_over_8 *(temp(ixs(2,i)) + temp(ixs(3,i))
213 . + temp(ixs(6,i)) + temp(ixs(7,i))
214 . + temp(ixs(8,i)) + temp(ixs(9,i)))
217 tempel(1:nel) = temp0(1:nel)
221 CALL matini(pm ,ixs ,nixs ,x ,
222 . geo ,ale_connectivity ,detonators ,iparg_gr ,
223 . sigi ,nel ,skew ,igeo ,
225 . mat ,ipm ,nsigs ,numsol ,ptsol
226 . ip ,ngl ,npf ,tf ,bufmat ,
227 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
228 . facload, deltax ,tempel ,mat_param )
242 IF(jthe /=0)
CALL atheri(mat ,pm ,gbuf%TEMP)
243 IF(jtur /=0)
CALL aturi3(iparg ,gbuf%RHO,pm ,ixs ,x ,
244 . gbuf%RK ,gbuf%RE ,volu )
248 IF(jlag+jale+jeul/=0)
THEN
250 IF (isigi /= 0 .AND. (jcvt/=0.OR.isorth/=0))
252 . sigi ,lbuf%SIG ,ixs ,nixs ,nsigs ,
253 . nel ,strsglob ,jhbe ,igtyp ,x ,
254 . gbuf%GAMA,ptsol ,lbuf%VOL0DP,rhocp,gbuf%RHO)
257 IF(mtn >= 28.AND. mtn /= 49)
THEN
259 ELSEIF(mtn == 14 .OR. mtn == 12)
THEN
261 ELSEIF(istrain == 1)
THEN
268 ELSEIF(mtn == 3.OR.mtn == 6.OR.mtn == 10.OR.
269 . mtn == 21.OR.mtn == 22.OR.mtn == 23)
THEN
274 IF (isigi /= 0 .AND. ((mtn >= 28 .AND. iuser == 1).OR.
275 . (nvsolid2 /= 0 .and .idef /=0)))
277 . sigsp ,sigi ,mbuf%VAR ,lbuf%STRA,
278 . ixs ,nixs ,nsigi ,nuvar ,nel ,
279 . nsigs ,iuser ,idef ,straglob ,jhbe ,
280 . igtyp ,x ,gbuf%GAMA,ptsol ,lbuf%SIGB,
281 . l_sigb ,mat(1) ,ipm ,bufmat ,lbuf%PLA,
285 1 gbuf%RHO ,mas ,partsav,x ,v,
286 2 iparts(nf1),mss(1,nf1),msnf ,mssf(1,nf1),wma,
287 3 rhocp ,mcp ,mcps(1,nf1),temp0,temp ,
288 4 mssa ,ix1 ,ix2 ,ix3 ,ix4 ,
289 5 gbuf%FILL, volu ,imas_ds ,nintemp )
297 ixt4(1:mvsiz,1) = ix1(1:mvsiz)
298 ixt4(1:mvsiz,2) = ix2(1:mvsiz)
299 ixt4(1:mvsiz,3) = ix3(1:mvsiz)
300 ixt4(1:mvsiz,4) = ix4(1:mvsiz)
301 CALL sbulk3(volu ,ixt4 ,ncc,mat,pm ,
302 2 volnod,bvolnod,vns(1,nf1),bns(1,nf1),bid,
309 IF (isigi /= 0 .AND. isorth/=0)
THEN
315 CALL failini(elbuf_str,nptr,npts,nptt,nlay,
316 . ipm,sigsp,nsigi,fail_ini ,
317 . sigi,nsigs,ixs,nixs,ptsol,rnoise,perturb,mat_param)
321 IF (nsigi > 0.AND.(ismstr==10.OR.ismstr==12))
THEN
322 CALL s4jaci3(gbuf%SMSTR,gbuf%JAC_I, gbuf%VOL,nel )
328 CALL dtmain(geo ,pm ,ipm ,pid ,mat ,fv ,
329 . gbuf%EINT ,gbuf%TEMP ,gbuf%DELTAX ,gbuf%RK ,gbuf%RE ,bufmat, deltax, aire,
330 . volu, dtx ,igeo,igtyp)
334 IF(ixs(10,i+nft)/=0)
THEN
335 IF( igtyp/=0 .AND.igtyp/=6
336 . .AND.igtyp/=14.AND.igtyp/=15)
THEN
337 ipid1=ixs(nixs-1,i+nft)
338 CALL fretitl2(titr1,igeo(npropgi-ltitr+1,ipid1),ltitr)
341 . anmode=aninfo_blind_1,
349 sti = half * gbuf%FILL(i)* gbuf%RHO(i) * volu(i) /
350 .
max(em20,dtx(i)*dtx(i))
351 stifn(ixs(2,i+nft))=stifn(ixs(2,i+nft))+sti
352 stifn(ixs(4,i+nft))=stifn(ixs(4,i+nft))+sti
353 stifn(ixs(6,i+nft))=stifn(ixs(6,i+nft))+sti
354 stifn(ixs(7,i+nft))=stifn(ixs(7,i+nft))+sti
361 IF(sol2sph(1,nft+i) < sol2sph(2,nft+i))
THEN
363 nsphdir=igeo(37,ixs(10,nft+i))
364 ncelf =sol2sph(1,nft+i)+1
365 ncell =sol2sph(2,nft+i)-sol2sph(1,nft+i)
367 . nsphdir ,gbuf%RHO(i) ,ncell ,x ,spbuf(1,ncelf),