32 1 NEL ,NUPARAM,NUVAR ,TIME ,TIMESTEP,UPARAM ,
33 2 RHO0 ,RHO ,VOLUME ,EINT ,
34 3 EPSPXX ,EPSPYY ,EPSPZZ ,EPSPXY ,EPSPYZ ,EPSPZX ,
35 4 DEPSXX ,DEPSYY ,DEPSZZ ,DEPSXY ,DEPSYZ ,DEPSZX ,
36 5 EPSXX ,EPSYY ,EPSZZ ,EPSXY ,EPSYZ ,EPSZX ,
37 6 SIGOXX ,SIGOYY ,SIGOZZ ,SIGOXY ,SIGOYZ ,SIGOZX ,
38 7 SIGNXX ,SIGNYY ,SIGNZZ ,SIGNXY ,SIGNYZ ,SIGNZX ,
39 8 SIGVXX ,SIGVYY ,SIGVZZ ,SIGVXY ,SIGVYZ ,SIGVZX ,
40 9 SOUNDSP,VISCMAX,UVAR ,OFF ,NGL ,IPM ,
41 A MAT ,JTHE ,TEMP ,ISMSTR ,ETSE)
48#include "implicit_f.inc"
97 INTEGER ,
INTENT(IN) :: NEL,NUPARAM,NUVAR
98 INTEGER ,
INTENT(IN) :: JTHE
99 INTEGER NGL(),MAT(NEL),(NPROPMI,*)
101 . TIME,,UPARAM(NUPARAM),
102 . RHO(NEL),RHO0(NEL),VOLUME(NEL),(NEL),
103 . EPSPXX(NEL),EPSPYY(NEL),EPSPZZ(NEL),
104 . EPSPXY(NEL),EPSPYZ(NEL),(NEL),
105 . DEPSXX(NEL),DEPSYY(NEL),DEPSZZ(NEL),
106 . DEPSXY(NEL),DEPSYZ(),DEPSZX(NEL),
107 . epsxx(nel) ,epsyy(nel) ,epszz(nel) ,
108 . epsxy(nel) ,epsyz(nel) ,epszx(nel) ,
109 . sigoxx(nel),sigoyy(nel),sigozz(nel),
110 . sigoxy(nel),sigoyz(nel),sigozx(nel)
111 my_real,
DIMENSION(NEL) ,
INTENT(INOUT) :: temp
116 . signxx(nel),signyy(nel),signzz(nel),
117 . signxy(nel),signyz(nel),signzx(nel),
118 . sigvxx(nel),sigvyy(nel),sigvzz(nel),
119 . sigvxy(nel),sigvyz(nel),sigvzx(nel),
120 . soundsp(nel),etse(nel),viscmax(nel)
124 my_real,
DIMENSION(NEL) ,
INTENT(INOUT) :: off
125 my_real,
DIMENSION(NEL,NUVAR) ,
INTENT(INOUT) ::uvar
129 INTEGER I,J,J1,J2,I1,I2,KK,IADBUF,EFLAG,ISMSTR,IFUNC(100)
131 . E,EMART,NU,G,G2,WAVE,SQDT,A,B,,FCT,FCTP, DFTR,UNMXN,DB,
132 . ALPHA,EPSL,AA1,FM,DFMSA,DFMAS,UXX,NN,BETA,GM,KM,
133 . CB,CC,CAAS,CBAS,POLD,DGT,DKT,CP,TINI,INVE, n1,n2,n3,
134 . k,p,sxx,cas,csa,tsas,tfas, tssa,tfsa,rv_pui,dfs,
135 . syy,szz,sxy,syz,szx,fass,fsas,fasf,fsaf,rsas,rfas,
136 . sv,fs,fs0,yld_ass,yld_asf,yld_sas,yld_saf,rssa,rfsa,
137 . dfm, fss,dsxx,dsyy,dsxy,dsyz,dszx,dszz,var,h,et,
138 . pm,delta,x1,x2,test,test2,ftest,gnew,knew,betan,
139 . nx2,ny2 ,nz2,nxy2,nyz2,nzx2,ne,dnx,dny,dnz,dnxy,dnyz,dnzx,
140 . nxx(nel),nyy(nel),nzz(nel),nxy(nel),nyz(nel),nzx(nel),
141 . e1(nel),e2(nel),e3(nel),e4(nel),e5(nel),e6(nel),trde(nel),
142 . de1(nel),de2(nel),de3(nel),gt(nel),kt(nel),
143 . ee1(nel),ee2(nel),ee3(nel),pp(nel),nne(nel),det(nel),
144 . sigxx(nel), sigyy(nel), sigzz(nel)
148 . av(mvsiz,6),evv(mvsiz,3),dirprv(mvsiz,3,3)
164 epsl = uparam(11)/(sqrt(two_third)+alpha)
166 eflag = int(uparam(15))
170 beta = epsl*(g2+nine*k*alpha*alpha)
171 sqdt = sqrt(two/three)
186 av(i,4)=epsxy(i) * half
187 av(i,5)=epsyz(i) * half
188 av(i,6)=epszx(i) * half
198 IF(ismstr== 0.OR. ismstr==2.OR. ismstr==4)
THEN
201 ev(i,1)=exp(evv(i,1))
202 ev(i,2)=exp(evv(i,2))
203 ev(i,3)=exp(evv(i,3))
205 ELSEIF(ismstr==10.OR.ismstr==12)
THEN
207 ev(i,1)=sqrt(evv(i,1)+ one)
208 ev(i,2)=sqrt(evv(i,2)+ one)
209 ev(i,3)=sqrt(evv(i,3)+ one)
214 ev(i,1)=evv(i,1)+ one
215 ev(i,2)=evv(i,2)+ one
216 ev(i,3)=evv(i,3)+ one
221 det(i) =ev(i,1)*ev(i,2)*ev(i,3)
222 IF(det(i)/=zero)
THEN
223 trde(i) = log(det(i))
224 rv_pui = exp((-third)*trde(i))
229 ee1(i) = log(ev(i,1)*rv_pui)
230 ee2(i) = log(ev(i,2)*rv_pui)
231 ee3(i) = log(ev(i,3)*rv_pui)
238 temp(i) = tini + eint(i) / rho0(i)/cp/
max(em15,volume(i))
243 IF (eflag > zero)
THEN
245 rsas = yld_ass *(sqdt+alpha)-cas*tsas
246 rfas = yld_asf *(sqdt+alpha)-cas*tfas
247 rssa = yld_sas *(sqdt+alpha)-csa*tssa
248 rfsa = yld_saf *(sqdt+alpha)-csa*tfsa
252 gt(i) = g + fm * (gm - g)
253 kt(i) = k + fm * (km - k)
255 p = kt(i) * (trde(i) - three*alpha*epsl*fm)
257 ne = sqrt( ee1(i)**2 + ee2
258 nxx(i) =ee1(i)/
max(ne,em20)
259 nyy(i) =ee2(i)/
max(ne,em20)
260 nzz(i) =ee3(i)/
max(ne,em20)
262 sxx= two*gt(i)*(ee1(i) -epsl*fm*nxx(i))
263 syy= two*gt(i)*(ee2(i) -epsl*fm*nyy(i))
264 szz= two*gt(i)*(ee3(i) -epsl*fm*nzz(i))
266 sv = sqrt( sxx*sxx + syy*syy + szz*szz )
268 soundsp(i) = sqrt(aa1/rho0(i))
277 fs = sv + three*alpha*p - cas*temp(i)
283 beta = epsl*(two*gt(i)+nine*kt(i)*alpha*alpha)
284 IF((fs - fs0) > zero .AND. fass > zero.AND. fasf < zero .AND. fm < one )
THEN
286 db = (two * (gm-g) +nine*alpha*alpha*(km-k)) *epsl
288 dftr = two*ne*(gm-g) + three*alpha*trde(i)*(km-k)
289 dfmas =
min(one, -(fs-fs0)*(one-fm)/(fasf-beta*(one-fm) ) )
291 b = (rfas-fs+unmxn*(beta-dftr))
294 fct = dfmas*dfmas *a+ dfmas* b +c
295 fctp = two*dfmas *a+ b
296 dfmas = dfmas - fct / fctp
298 dfmas =
min(one,dfmas )
303 fs = sv + three*alpha*p - csa*temp(i)
308 IF((fs - fs0) < zero .AND. fsas < zero.AND. fsaf > zero )
THEN
310 db = (two * (gm-g) +nine*alpha*alpha*(km-k))*epsl
311 dftr = two * (gm-g)*ne+ three*alpha*(km-k)*trde(i)
314 b = -(rfsa-fs+fm*(dftr-beta))
317 fct = dfmsa*dfmsa *a+ dfmsa* b +c
318 fctp = two*dfmsa *a+ b
319 dfmsa = dfmsa - fct / fctp
321 dfmsa =
max(-one , dfmsa )
326 IF(dfm < zero .AND. fm == zero) dfm = zero
334 sxx = sxx -two*gt(i) * epsl*nxx(i)*dfm
335 . + two*dgt* (ee1(i)-epsl*nxx(i)*dfm)
336 syy = syy -two*gt(i)* epsl*dfm*nyy(i)
337 . + two*dgt* (ee2(i)-epsl*nyy(i)*dfm)
338 szz = szz -two*gt(i)* epsl*dfm*nzz(i)
339 . + two*dgt* (ee3(i)-epsl*nzz(i)*dfm)
341 p = p - kt(i)*epsl*three*alpha*dfm
342 . + dkt *(trde(i) -epsl*three*alpha*dfm)
347 sv = sqrt( sxx*sxx + syy*syy + szz*szz )
348 fs = sv + three*alpha*p
355 sigxx(i)= sigxx(i) *inve
356 sigyy(i)= sigyy(i) *inve
357 sigzz(i)= sigzz(i) *inve
359 signxx(i) = dirprv(i,1,1)*dirprv(i,1,1)*sigxx(i)
360 . + dirprv(i,1,2)*dirprv(i,1,2)*sigyy(i)
361 . + dirprv(i,1,3)*dirprv(i,1,3)*sigzz(i)
362 signyy(i) = dirprv(i,2,2)*dirprv(i,2,2)*sigyy(i)
363 . + dirprv(i,2,3)*dirprv(i,2,3)*sigzz(i)
364 . + dirprv(i,2,1)*dirprv(i,2,1)*sigxx(i)
365 signzz(i) = dirprv(i,3,3)*dirprv(i,3,3)*sigzz(i)
366 . + dirprv(i,3,1)*dirprv(i,3,1)*sigxx(i)
367 . + dirprv(i,3,2)*dirprv(i,3,2)*sigyy(i)
368 signxy(i) = dirprv(i,1,1)*dirprv(i,2,1)*sigxx(i)
369 . + dirprv(i,1,2)*dirprv(i,2,2)*sigyy(i)
370 . + dirprv(i,1,3)*dirprv(i,2,3)*sigzz(i)
371 signyz(i) = dirprv(i,2,2)*dirprv(i,3,2)*sigyy(i)
372 . + dirprv(i,2,3)*dirprv(i,3,3)*sigzz(i)
373 . + dirprv(i,2,1)*dirprv(i,3,1)*sigxx(i)
374 signzx(i) = dirprv(i,3,3)*dirprv(i,1,3)*sigzz(i)
375 . + dirprv(i,3,1)*dirprv(i,1,1)*sigxx(i)
376 . + dirprv(i,3,2)*dirprv(i,1,2)*sigyy(i)
378 uvar(i,1) = uvar(i,1) + dfm
379 uvar(i,1) =
max(zero, uvar(i,1))
380 uvar(i,1) =
min(one, uvar(i,1))
381 uvar(i,2) = fs- cas*temp(i)
382 uvar(i,3) = fs- csa*temp(i)
383 IF (dfmas /= zero) dfs = abs(uvar(i,2) - fs0)
384 IF (dfmsa /= zero) dfs = abs(uvar(i,3) - fs0)
385 IF (dfs /= zero .AND. epsl /= zero .AND. dfm/= zero)
THEN
387 etse(i) = h *(one+nu) /( (e + uvar(i,1)*(emart-e)) + h)
391 uvar(i,10) = epsxx(i)
395 rsas = yld_ass *(sqdt+alpha)-cas*tsas
396 rfas = yld_asf *(sqdt+alpha)-cas*tfas
397 rssa = yld_sas *(sqdt+alpha)-csa*tssa
398 rfsa = yld_saf *(sqdt+alpha)-csa*tfsa
403 p = k * (trde(i) - three*alpha*epsl*fm)
405 ne = sqrt( ee1(i)**2 + ee2(i)**2 + ee3(i)**2)
406 nxx(i) =ee1(i)/
max(ne,em20)
407 nyy(i) =ee2(i)/
max(ne,em20)
408 nzz(i) =ee3(i)/
max(ne,em20)
410 sxx= g2*(ee1(i) -epsl*fm*nxx(i))
411 syy= g2*(ee2(i) -epsl*fm*nyy(i))
412 szz= g2*(ee3(i) -epsl*fm*nzz(i))
414 sv = sqrt( sxx*sxx + syy*syy + szz*szz )
416 soundsp(i) = sqrt(aa1/rho0(i))
425 fs = sv + three*alpha*p - cas*temp(i)
432 IF((fs - fs0) > zero .AND. fass > zero.AND. fasf < zero.AND. fm < one ) then
433 dfmas =
min(one, -(fs-fs0)*(one-fm)/(fasf-beta*(one-fm) ) )
437 fs = sv + three*alpha*p - csa*temp(i)
441 IF((fs - fs0) < zero .AND. fsas < zero .AND. fsaf > zero .AND. fm > zero )
THEN
442 dfmsa =
max(-one , fm * (fs - fs0)/ (fsaf+beta*fm)
447 IF(dfm < zero .AND. fm == zero) dfm = zero
450 sxx = sxx -g2* epsl*dfm*nxx(i)
451 syy = syy -g2* epsl*dfm*nyy(i)
452 szz = szz -g2* epsl*dfm*nzz(i)
453 p = p - k*epsl*three*alpha*dfm
458 sv = sqrt( sxx*sxx + syy*syy + szz*szz )
459 fs = sv + three*alpha*p
466 sigxx(i)= sigxx(i) *inve
467 sigyy(i)= sigyy(i) *inve
468 sigzz(i)= sigzz(i) *inve
470 signxx(i) = dirprv(i,1,1)*dirprv(i,1,1)*sigxx(i)
471 . + dirprv(i,1,2)*dirprv(i,1,2)*sigyy(i)
472 . + dirprv(i,1,3)*dirprv(i,1,3)*sigzz(i)
473 signyy(i) = dirprv(i,2,2)*dirprv(i,2,2)*sigyy(i)
474 . + dirprv(i,2,3)*dirprv(i,2,3)*sigzz(i)
475 . + dirprv(i,2,1)*dirprv(i,2,1)*sigxx(i)
477 . + dirprv(i,3,1)*dirprv(i,3,1)*sigxx(i)
478 . + dirprv(i,3,2)*dirprv(i,3,2)*sigyy(i)
479 signxy(i) = dirprv(i,1,1)*dirprv(i,2,1)*sigxx(i)
480 . + dirprv(i,1,2)*dirprv(i,2,2)*sigyy(i)
481 . + dirprv(i,1,3)*dirprv(i,2,3)*sigzz(i)
482 signyz(i) = dirprv(i,2,2)*dirprv(i,3,2)*sigyy(i)
483 . + dirprv(i,2,3)*dirprv(i,3,3)*sigzz(i)
484 . + dirprv(i,2,1)*dirprv(i,3,1)*sigxx(i)
485 signzx(i) = dirprv(i,3,3)*dirprv(i,1,3)*sigzz(i)
486 . + dirprv(i,3,1)*dirprv(i,1,1)*sigxx(i)
487 . + dirprv(i,3,2)*dirprv(i,1,2)*sigyy(i)
488 uvar(i,1) = uvar(i,1) + dfm
489 uvar(i,1) =
max(zero, uvar(i,1))
490 uvar(i,1) =
min(one, uvar(i,1))
491 uvar(i,2) = fs- cas*temp(i)
492 uvar(i,3) = fs- csa*temp(i)
494 IF (dfmas /= zero) dfs = abs(uvar(i,2) - fs0)
495 IF (dfmsa /= zero) dfs = abs(uvar(i,3) - fs0)
496 IF (dfs /= zero .AND. epsl /= zero.AND.dfm/= zero)
THEN
498 etse(i) = h * (one+nu)/(e + h)
503 uvar(i,7) = uvar(i,7)+epsl*dfm
504 uvar(i,10) = epsxx(i)