29 1 NEL , NUPARAM ,NIPARAM, NUVAR , ISMSTR ,
30 2 TIME , TIMESTEP,UPARAM , IPARAM , RHO0 ,
31 3 DEPSXX , DEPSYY , DEPSXY , DEPSYZ , DEPSZX ,
32 4 EPSXX , EPSYY , EPSXY , THKN , THKLYL ,
33 5 SIGNXX , SIGNYY , SIGNXY , SIGNYZ , SIGNZX ,
34 6 SIGOYZ , SIGOZX , SOUNDSP, GS , UVAR ,
39#include "implicit_f.inc"
53 INTEGER :: IPARAM(NIPARAM)
54 my_real :: UPARAM(NUPARAM)
55 my_real :: time,timestep
56 my_real ,
DIMENSION(NEL) :: thkn,thklyl,rho0,gs,
57 . depsxx,depsyy,depsxy,depsyz,depszx,epsxx,epsyy,epsxy
58 my_real ,
DIMENSION(NEL) ,
INTENT(IN) :: sigoyz,sigozx
62 my_real ,
DIMENSION(NEL) :: signxx,signyy,signxy,signyz,signzx,soundsp
66 my_real :: uvar(nel,nuvar), off(nel)
70 INTEGER :: I,J,II,NPRONY,NORDER,ITER,JNV
71 my_real :: SUM,FAC,FSCAL,TENSCUT,SUMDWDL,,PARTP
72 my_real :: E11,E22,E12,EMAX,GMAX,GVMAX,NU,RBULK,A11,PUI11,PUI22,ALMA1,ALMA2,ALMA3
73 my_real ,
DIMENSION(3) :: ddwddl,dwdl
74 my_real ,
DIMENSION(10) :: mu,al
75 my_real ,
DIMENSION(100) :: gi,taux,h1,h2,h12,h10,h20,h120
76 my_real ,
DIMENSION(NEL,100) :: h30,h31
77 my_real ,
DIMENSION(NEL) :: rvt,c30,c31,dc3ev3,cd10,cd20,cd120
78 my_real ,
DIMENSION(NEL) :: cp1,cp2,cd1,cd2,cd12,ea,invrv,invv3,dezz,rv,trav,rootv
79 my_real ,
DIMENSION(NEL) :: s2,cs,kt3,epszz,rho
80 my_real ,
DIMENSION(NEL,10) :: evma1,evma2,evma3,c11,c22,c12
81 my_real ,
DIMENSION(NEL,3) :: t,sv,sigprv,evv,ev,evm
82 my_real ,
DIMENSION(NEL,3,2) :: eigv(nel,3,2)
101 gi(i) = uparam(24 + i)
102 taux(i) = uparam(24 + nprony + i)
103 gvmax = gvmax + gi(i)
106 gmax = gmax + mu(i)*al(i)
111 IF (time == zero .AND. isigi == 0)
THEN
118 ELSEIF (time == zero )
THEN
125 trav(i) = epsxx(i)+epsyy(i)
126 rootv(i) = sqrt((epsxx(i)-epsyy(i))*(epsxx(i)-epsyy(i))
127 . + epsxy(i)*epsxy(i))
128 evv(i,1) = half*(trav(i)+rootv(i))
129 evv(i,2) = half*(trav(i)-rootv(i))
134 IF (ismstr == 10)
THEN
136 IF (
min(evv(i,1),evv(i,2)) <= -one)
THEN
145 IF (abs(evv(i,2)-evv(i,1)) < em10)
THEN
153 invrv(i) = one / rootv(i)
154 eigv(i,1,1) = (epsxx(i)-evv(i,2)) * invrv(i)
155 eigv(i,2,1) = (epsyy(i)-evv(i,2)) * invrv(i)
156 eigv(i,3,1) = (half*epsxy(i)) * invrv(i)
157 eigv(i,1,2) = (evv(i,1)-epsxx(i)) * invrv(i)
158 eigv(i,2,2) = (evv(i,1)-epsyy(i)) * invrv(i)
159 eigv(i,3,2) =-(half*epsxy(i)) * invrv(i)
163 IF (ismstr == 1 .OR. ismstr == 3 .OR. ismstr == 11)
THEN
165 ev(i,1)=evv(i,1)+ one
166 ev(i,2)=evv(i,2)+ one
167 ev(i,3)=one/ev(i,1)/ev(i,2)
169 ELSEIF(ismstr == 10)
THEN
171 ev(i,1)=sqrt(evv(i,1)+ one)
172 ev(i,2)=sqrt(evv(i,2)+ one)
173 ev(i,3)=one/ev(i,1)/ev(i,2)
177 ev(i,1)=exp(evv(i,1))
178 ev(i,2)=exp(evv(i,2))
179 ev(i,3)=one/ev(i,1)/ev(i,2)
182 IF (nprony > 0) ev(1:nel,3) = uvar(1:nel,3)
184 IF (off(i)==zero.OR.off(i)==four_over_5) ev(i,1:3)=one
196 rv(i) = ev(i,1)*ev(i,2)*ev(i,3)
201 IF (rv(i)/= zero)
THEN
202 rvt(i) = exp( (-third)* log(rv(i)) )
203 invrv(i) = one / rv(i)
208 evm(i,1) = ev(i,1)*rvt(i
209 evm(i,2) = ev(i,2)*rvt(i)
210 evm(i,3) = ev(i,3)*rvt(i)
220 IF(evm(i,1)==zero)
THEN
223 IF (al(j) == zero)
THEN
226 evma1(i,j) = mu(j) * exp(al(j)* log(evm(i,1)) )
230 IF(evm(i,2)==zero)
THEN
233 IF (al(j) == zero)
THEN
236 evma2(i,j) = mu(j) * exp(al(j)* log(evm(i,2)) )
240 IF(evm(i,3)==zero)
THEN
243 IF (al(j) == zero)
THEN
246 evma3(i,j) = mu(j) * exp(al(j)* log(evm(i,3)) )
251! -----------------------
257 dwdl(1) = dwdl(1) + evma1(i,j)
258 dwdl(2) = dwdl(2) + evma2(i,j)
259 dwdl(3) = dwdl(3) + evma3(i,j)
261 sumdwdl = (dwdl(1) + dwdl(2) + dwdl(3)) * third
262 partp = rbulk*(rv(i)- one)
265 IF (ev(i,3) == zero)
THEN
268 invv3(i) = one / ev(i,3)
270 t(i,1) = (dwdl(1) - sumdwdl) *invrv(i) + partp
271 t(i,2) = (dwdl(2) - sumdwdl) *invrv(i) + partp
272 t(i,3) = (dwdl(3) - sumdwdl) *invrv(i) + partp
274 kt3(i) = -third*(dwdl(1) + dwdl(2)) + two_third*(dwdl(3))
275 kt3(i) = -ev(i,1)*ev(i,2)*kt3(i)*invrv(i)*invrv(i) + rbulk*ev(i,1
281 alma1 = alma1 + al(j)*evma1(i,j)
282 alma2 = alma2 + al(j)*evma2(i,j)
283 alma3 = alma3 + al(j)*evma3(i,j)
285 kt3(i) = kt3(i) + (one_over_9*(alma1 + alma2 + four*(alma3))) * invrv(i)*invv3(i)
289 sum = third*(evm(i,1)**2 + evm(i,2)**2 + evm(i,3)**2)
290 c31(i) = evm(i,3)**2 - sum
292 dc3ev3(i) = four_over_3*rvt(i)*evm(i,3)-two_third*invv3(i)*
293 . (two_third*evm(i,3)**2 - third*evm(i,1)**2 - third
298 fac= -timestep/taux(ii)
299 h30(1:nel,ii) = uvar(1:nel,jnv + ii)
300 h31(1:nel,ii) = exp(fac)*h30(1:nel,ii)+ exp(half*fac)*(c31(1:nel) - c30
306 fac= -timestep/taux(ii)
307 t(1:nel,3) = t(1:nel,3) + gi(ii)*h31(1:nel,ii)*invrv(1:nel)
308 kt3(1:nel) = kt3(1:nel) - gi(ii)*h31(1:nel,ii)*invv3(1:nel)*invrv(1:nel)
309 . + dc3ev3(1:nel)*gi(ii)*exp(half*fac)*invrv(1:nel)
312 IF (off(i)==zero.OR.off(i)==four_over_5) cycle
313 IF (abs(kt3(i))>em20) ev(i,3) = ev(i,3) - t(i,3)/kt3(i)
320 uvar(1:nel,jnv + ii) = h31(1:nel,ii)
325 rv(i) = ev(i,1)*ev(i,2)*ev(i,3)
330 IF (rv(i) /= zero)
THEN
331 rvt(i) = exp( (-third)* log(rv(i)) )
335 evm(i,1) = ev(i,1)*rvt(i)
336 evm(i,2) = ev(i,2)*rvt(i)
337 evm(i,3) = ev(i,3)*rvt(i)
343 sum = third*(evm(i,1)**2 + evm(i,2)**2 + evm(i,3)**2)
344 cp1(i) = evm(i,1)**2 - sum
345 cp2(i) = evm(i,2)**2 - sum
346 cd1(i) = eigv(i,1,1)*cp1(i) + eigv(i,1,2)*cp2(i)
347 cd2(i) = eigv(i,2,1)*cp1(i) + eigv(i,2,2)*cp2(i)
348 cd12(i) = eigv(i,3,1)*cp1(i) + eigv(i,3,2)*cp2(i)
360 h10(ii) = uvar(i,jnv + ii )
361 h20(ii) = uvar(i,jnv + nprony + ii )
362 h120(ii) = uvar(i,jnv + 2*nprony + ii )
363 h1(ii) = exp(fac)*h10(ii)+ exp(half*fac)*(cd1(i) - cd10(i))
364 h2(ii) = exp(fac)*h20(ii)+ exp(half*fac)*(cd2(i) - cd20(i))
365 h12(ii) = exp(fac)*h120(ii)+ exp(half*fac)*(cd12(i) - cd120(i))
366 uvar(i,jnv + ii )= h1(ii)
367 uvar(i,jnv + nprony + ii )= h2(ii)
368 uvar(i,jnv + 2*nprony + ii )= h12(ii)
370 sv(i,1) = sv(i,1) + gi(ii)*h1(ii)
371 sv(i,2) = sv(i,2) + gi(ii)*h2(ii)
372 sv(i,3) = sv(i,3) + gi(ii)*h12(ii)
390 IF(ev(i,1)==zero)
THEN
393 IF (al(j) == zero)
THEN
397 pui11 = exp(al(j)* log(ev(i,1)) )
398 evma1(i,j) = mu(j) * pui11
402 IF(ev(i,2)==zero)
THEN
405 IF (al(j) == zero)
THEN
409 pui22 = exp(al(j)* log(ev(i,2)) )
410 evma2(i,j) = mu(j) * pui22
414 IF((ev(i,1)*ev(i,2))==zero)
THEN
417 IF (al(j) == zero)
THEN
420 evma3(i,j) = mu(j)/(pui11*pui22)
431 dwdl(1) = dwdl(1) + evma1(i,j)
432 dwdl(2) = dwdl(2) + evma2(i,j)
433 dwdl(3) = dwdl(3) + evma3(i,j)
437 t(i,1) = dwdl(1) - dwdl(3)
438 t(i,2) = dwdl(2) - dwdl
454 IF (al(j) == four)
THEN
455 c11(i,j) = half*mu(j)*(half*al(j)-one)
456 c22(i,j) = half*mu(j)*(half*al(j)-one)
457 c12(i,j) = half*mu(j)*(half*al(j) + one) / (ev(i,1)*ev(i,2))**(8)
458 ELSEIF (al(j) == zero)
THEN
459 c11(i,j) = half*mu(j)*(half*al(j)-one) / ev(i,1)**(4)
460 c22(i,j) = half*mu(j)*(half*al(j)-one) / ev(i,2)**(4)
461 c12(i,j) = half*mu(j)*(half*al(j) + one) / (ev(i,1)*ev(i,2))**(4)
463 IF(ev(i,1) /= zero)
THEN
464 pui11 = exp((al(j) )* log(ev(i,1)) )
465 c11(i,j) = half*mu(j)*(half*al(j) - one)*pui11 / ev(i,1)**(4)
470 IF(ev(i,2) /= zero)
THEN
471 pui22 = exp((al(j))* log(ev(i,2)) )
472 c22(i,j) = half*mu(j)*(half*al(j) - one)*pui22 / ev(i,2)**(4)
477 IF(ev(i,1)*ev(i,2) /= zero)
THEN
478 c12(i,j) = half*mu(j)*(half*al(j) + one) /
479 . ( (pui11 * pui22)*(ev(i,1)**4 * ev(i,2)**4) )
496 e11 = e11 + e12 * ev(i,2)**4
497 e22 = e22 + e12 * ev(i,1)**4
508 IF (off(i) /= zero .AND.
509 . (t(i,1) > abs(tenscut) .OR. t(i,2) > abs(tenscut)))
THEN
519 IF (ismstr == 1 .OR. ismstr == 3 .OR. ismstr == 11)
THEN
521 epszz(i) = ev(i,3) - one
524 ELSEIF (ismstr == 10)
THEN
526 epszz(i) = ev(i,3) - one
531 epszz(i) = log(ev(i,3))
537 rv(i) = ev(i,1)*ev(i,2)*ev(i,3)
538 IF (rv(i) /= zero)
THEN
539 invrv(i) = one / rv(i)
544 dezz(i) = -nu/(one-nu)*(depsxx(i)+depsyy(i))
546 signxx(i) = eigv(i,1,1)*t(i,1) + eigv(i,1,2)*t(i,2) + sv(i,1)*invrv(i)
547 signyy(i) = eigv(i,2,1)*t(i,1) + eigv(i,2,2)*t(i,2) + sv(i,2)*invrv(i)
548 signxy(i) = eigv(i,3,1)*t(i,1) + eigv(i,3,2)*t(i,2) + sv(i,3)*invrv(i)
549 signyz(i) = sigoyz(i)+gs(i)*depsyz(i)
550 signzx(i) = sigozx(i)+gs(i)*depszx(i)
551 rho(i) = rho0(i)*invrv(i)
552 thkn(i) = thkn(i) + dezz(i)*thklyl(i)*off(i)
555 emax = gmax*(one + nu)
556 emax =
max(emax,ea(i))
557 a11 = emax/(one - nu**2)
558 soundsp(i)= sqrt(a11/rho0(i))