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 )
80#include "implicit_f.inc"
94#include "vect01_c.inc"
99 INTEGER IXS(NIXS,*),IPARG_GR(NPARG),IPARG(NPARG,NGROUP),
100 . IPARTS(*),IPART(LIPART1,*),IGEO(NPROPGI,*),PTSOL(*),NPF(*),
101 . IPM(NPROPMI,*),STRSGLOB(*),STRAGLOB(*),FAIL_INI(*),SOL2SPH(2,*),
103 INTEGER NEL, NSIGS, IUSER, NSIGI
104 INTEGER ,
INTENT(IN) :: NINTEMP
106 . (*), PM(NPROPM,*), X(*), GEO(NPROPG,*),
107 . VEUL(LVEUL,*), DTELEM(*),SIGI(NSIGS,*),SKEW(LSKEW,*),STIFN(*),
108 . PARTSAV(20,*), (*), MSS(8,*) ,
109 . MSNF(*), MSSF(8,*),WMA(*),XREFS(8,3,*),
110 . VOLNOD(*), BVOLNOD(*), VNS(8,*), (8,*),BUFMAT(*),
111 . mcp(*), mcps(8,*), temp(*), tf(*),sigsp(nsigi,*), mssa(*),
112 . spbuf(nspbuf,*),rnoise(nperturb,*)
113 TYPE(elbuf_struct_),
TARGET :: ELBUF_STR
114 INTEGER,
INTENT(IN) :: ILOADP(SIZLOADP,*)
115 my_real,
INTENT(IN) :: facload(lfacload,*)
118 TYPE (MATPARAM_STRUCT_) ,
DIMENSION(NUMMAT) ,
INTENT(INOUT) :: MAT_PARAM
119 TYPE(SOLID_DEFAULTS_),
INTENT(IN) :: DEFAULTS_SOLID
123 INTEGER NF1,I,IGTYP,IREP,NCC,IP,NUVAR,IDEF,JHBE,IPID1,NPTR,NPTS,NPTT,NLAY,L_SIGB,L_PLA,IMAS_DS
124 INTEGER MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ), IXT4(MVSIZ,4)
125 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ)
126 INTEGER NSPHDIR,NCELF,,IBOLTP
128 . x1(mvsiz),x2(mvsiz),x3(mvsiz),x4(mvsiz),y1(mvsiz),y2(mvsiz),
129 . y3(mvsiz),y4(mvsiz),z1(mvsiz),z2(mvsiz),z3(mvsiz),z4(mvsiz)
130 CHARACTER(LEN=NCHARTITLE)::TITR1
134 . rx(mvsiz),ry(mvsiz),rz(mvsiz),
135 . sx(mvsiz),sy(mvsiz),sz(mvsiz),
136 . tx(mvsiz),ty(mvsiz),tz
137 . e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),e2x(mvsiz),
138 . e2y(mvsiz),e2z(mvsiz),e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),
139 . px1(mvsiz),px2(mvsiz),px3(mvsiz),px4(mvsiz),
140 . py1(mvsiz),py2(mvsiz),py3(mvsiz),py4(mvsiz),
141 . pz1(mvsiz),pz2(mvsiz),pz3(mvsiz),pz4(mvsiz),
142 . volu(mvsiz), dtx(mvsiz),rhocp(mvsiz),
143 . temp0(mvsiz), deltax(mvsiz), aire(mvsiz)
144 my_real :: tempel(nel)
146 TYPE(l_bufel_) ,
POINTER :: LBUF
147 TYPE(G_BUFEL_) ,
POINTER :: GBUF
148 TYPE(BUF_MAT_) ,
POINTER :: MBUF
152 GBUF => elbuf_str%GBUF
153 lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,1)
154 mbuf => elbuf_str%BUFLY(1)%MAT(1,1,1)
159 nptr = elbuf_str%NPTR
160 npts = elbuf_str%NPTS
161 nptt = elbuf_str%NPTT
162 nlay = elbuf_str%NLAY
163 l_sigb= elbuf_str%BUFLY(1)%L_SIGB
164 l_pla = elbuf_str%BUFLY(1)%L_PLA
167 nuvar = ipm(8,ixs(1,nf1))
172 imas_ds = defaults_solid%IMAS
173 iboltp = iparg_gr(72)
177 rhocp(i) = pm(69,ixs(1,nft+i))
178 temp0(i) = pm(79,ixs(1,nft+i))
181 CALL s4coor3(x ,xrefs(1,1,nf1),ixs(1,nf1),ngl ,
182 . mat ,pid ,ix1 ,ix2 ,ix3 ,ix4 ,
183 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
184 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 )
185 CALL s4deri3(gbuf%VOL,veul(1,nf1),geo ,igeo ,rx ,
189 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
190 . px1 ,px2 ,px3 ,px4 ,
191 . py1 ,py2 ,py3 ,py4 ,
192 . pz1 ,pz2 ,pz3 ,pz4 ,gbuf%JAC_I,
193 . deltax ,volu ,ngl ,pid ,mat ,
197 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
198 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
199 IF (igtyp == 6 .OR. igtyp == 21)
200 .
CALL smorth3(pid ,geo ,igeo ,skew ,irep ,gbuf%GAMA ,
201 . rx ,ry ,rz ,sx ,sy ,sz
202 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
203 . rx ,ry ,rz ,sx ,sy ,sz ,nsigi,sigsp,nsigs,
204 . sigi ,ixs ,x ,jhbe ,ptsol,nel ,iparg_gr(28))
208 IF (jthe == 0 .and. nintemp > 0)
THEN
210 tempel(i) = one_over_8 *(temp(ixs(2,i)) + temp(ixs(3,i))
211 . + temp(ixs(4,i)) + temp(ixs(5,i))
212 . + temp(ixs(6,i)) + temp(ixs(7,i))
213 . + temp(ixs(8,i)) + temp(ixs(9,i)))
216 tempel(1:nel) = temp0(1:nel)
220 CALL matini(pm ,ixs ,nixs ,x ,
221 . geo ,ale_connectivity ,detonators ,iparg_gr ,
222 . sigi ,nel ,skew ,igeo ,
224 . mat ,ipm ,nsigs ,numsol ,ptsol ,
225 . ip ,ngl ,npf ,tf ,bufmat ,
226 . gbuf ,lbuf ,mbuf ,elbuf_str
227 . facload, deltax ,tempel )
235 CALL sboltini(e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
241 IF(jthe /=0)
CALL atheri(mat ,pm ,gbuf%TEMP)
242 IF(jtur /=0)
CALL aturi3(iparg ,gbuf%RHO,pm ,ixs ,x ,
243 . gbuf%RK ,gbuf%RE ,volu )
247 IF(jlag+jale+jeul/=0)
THEN
249 IF (isigi /= 0 .AND. (jcvt/=0.OR.isorth/=0))
251 . sigi ,lbuf%SIG ,ixs ,nixs ,nsigs ,
252 . nel ,strsglob ,jhbe ,igtyp ,x ,
253 . gbuf%GAMA,ptsol ,lbuf%VOL0DP,rhocp,gbuf%RHO)
256 IF(mtn >= 28.AND. mtn /= 49)
THEN
258 ELSEIF(mtn == 14 .OR. mtn == 12)
THEN
260 ELSEIF(istrain == 1)
THEN
267 ELSEIF(mtn == 3.OR.mtn == 6.OR.mtn == 10.OR.
268 . mtn == 21.OR.mtn == 22.OR.mtn == 23)
THEN
273 IF (isigi /= 0 .AND. ((mtn >= 28 .AND. iuser == 1).OR.
274 . (nvsolid2 /= 0 .and .idef /=0)))
276 . sigsp ,sigi ,mbuf%VAR ,lbuf%STRA,
277 . ixs ,nixs ,nsigi ,nuvar ,nel ,
278 . nsigs ,iuser ,idef ,straglob ,jhbe ,
279 . igtyp ,x ,gbuf%GAMA,ptsol ,lbuf%SIGB,
280 . l_sigb ,mat(1) ,ipm ,bufmat ,lbuf%PLA,
284 1 gbuf%RHO ,mas ,partsav,x ,v,
285 2 iparts(nf1),mss(1,nf1),msnf ,mssf(1,nf1),wma,
286 3 rhocp ,mcp ,mcps(1,nf1),temp0,temp ,
287 4 mssa ,ix1 ,ix2 ,ix3 ,ix4 ,
296 ixt4(1:mvsiz,1) = ix1(1:mvsiz)
297 ixt4(1:mvsiz,2) = ix2(1:mvsiz)
298 ixt4(1:mvsiz,3) = ix3(1:mvsiz)
299 ixt4(1:mvsiz,4) = ix4(1:mvsiz)
300 CALL sbulk3(volu ,ixt4 ,ncc,mat,pm ,
301 2 volnod,bvolnod,vns(1,nf1
308 IF (isigi /= 0 .AND. isorth/=0)
THEN
314 CALL failini(elbuf_str,nptr,npts,nptt,nlay
315 . ipm,sigsp,nsigi,fail_ini ,
316 . sigi,nsigs,ixs,nixs,ptsol,rnoise,perturb,mat_param)
320 IF (nsigi > 0.AND.(ismstr==10.OR.ismstr==12))
THEN
321 CALL s4jaci3(gbuf%SMSTR,gbuf%JAC_I, gbuf%VOL,nel )
328 . gbuf%EINT ,gbuf%TEMP ,gbuf%DELTAX ,gbuf%RK ,gbuf%RE ,bufmat, deltax, aire,
329 . volu, dtx ,igeo,igtyp)
333 IF(ixs(10,i+nft)/=0)
THEN
334 IF( igtyp/=0 .AND.igtyp/=6
335 . .AND.igtyp/=14.AND.igtyp/=15)
THEN
336 ipid1=ixs(nixs-1,i+nft)
337 CALL fretitl2(titr1,igeo(npropgi-ltitr+1,ipid1),ltitr)
340 . anmode=aninfo_blind_1,
348 sti = half * gbuf%FILL(i)* gbuf%RHO(i) * volu(i) /
349 .
max(em20,dtx(i)*dtx(i))
350 stifn(ixs(2,i+nft))=stifn(ixs(2,i+nft))+sti
351 stifn(ixs(4,i+nft))=stifn(ixs(4,i+nft))+sti
352 stifn(ixs(6,i+nft))=stifn(ixs(6,i+nft))+sti
353 stifn(ixs(7,i+nft))=stifn(ixs(7,i+nft))+sti
360 IF(sol2sph(1,nft+i) < sol2sph(2,nft+i))
THEN
362 nsphdir=igeo(37,ixs(10,nft+i))
363 ncelf =sol2sph(1,nft+i)+1
364 ncell =sol2sph(2,nft+i)-sol2sph(1,nft+i)
366 . nsphdir ,gbuf%RHO(i) ,ncell ,x ,spbuf(1,ncelf),