34 1 NEL ,NGL ,NUPARAM ,NUVAR ,TIME ,TIMESTEP,
35 2 UPARAM ,UVAR ,JTHE ,OFF ,RHO ,
36 3 PLA ,DPLA ,EPSD ,SOUNDSP ,SHF ,
37 4 DEPSXX ,DEPSYY ,DEPSXY ,DEPSYZ ,DEPSZX ,
38 5 SIGOXX ,SIGOYY ,SIGOXY ,SIGOYZ ,SIGOZX ,
39 6 SIGNXX ,SIGNYY ,SIGNXY ,SIGNYZ ,SIGNZX ,
41 8 NUMTABL ,ITABLE ,TABLE ,NVARTMP ,VARTMP )
50#include "implicit_f.inc"
58 INTEGER NEL,NUPARAM,,JTHE,NUMTABL,ITABLE(),NVARTMP
59 INTEGER,
DIMENSION(NEL),
INTENT(IN) :: NGL
62 INTEGER :: VARTMP(NEL,NVARTMP)
63 my_real,
DIMENSION(NUPARAM),
INTENT(IN) ::
65 my_real,
DIMENSION(NEL),
INTENT(IN) ::
67 . depsxx,depsyy,depsxy,depsyz,depszx,
68 . sigoxx,sigoyy,sigoxy,sigoyz,sigozx
70 my_real ,
DIMENSION(NEL),
INTENT(OUT) ::
72 . signxx,signyy,signxy,signyz,signzx
74 my_real ,
DIMENSION(NEL),
INTENT(INOUT) ::
76 my_real ,
DIMENSION(NEL,6),
INTENT(INOUT) ::
78 my_real ,
DIMENSION(NEL,NUVAR),
INTENT(INOUT) ::
81 TYPE(
ttable),
DIMENSION(NTABLE) :: TABLE
85 INTEGER I,K,II,NINDX,INDEX(NEL),ITAB,ISMOOTH,IPOS(NEL,2)
88 . young1,young2,nu12,nu21,g12,a11,a12,a21,a22,c1,
89 . xi1,xi2,k1,k2,k3,k4,k5,k6,g1c,d1,d2,sigy1,
90 . cini1,s1,sigy2,cini2,s2,sigy1c,cini1c,s1c,
91 . sigy2c,cini2c,s2c,sigyt,cinit,st,g23,g31
93 . normsig,beta1,beta2,
96 . normxx,normyy,normxy,
97 . normpxx,normpyy,normpxy,
98 . dphi_dlam,dphi,dfdsig2,dphi_dpla,dpxx,dpyy,dpxy,
99 . dphi_dr1,dphi_dr2,dphi_dr1c,dphi_dr2c,dphi_drt
101 . xscale1,yscale1,xscale1c,yscale1c,xscale2,yscale2,xscale2c,yscale2c,
102 . xscalet,yscalet,xvec(nel,2),asrate
104 my_real,
DIMENSION(NEL) ::
105 . alpha1,
alpha2,alpha3,alpha4,alpha5,r1,r2,r1c,r2c,rt,
106 . dsigxx,dsigyy,dsigxy,dsigyz,dsigzx
107 . dr1_dp,dr2_dp,dr1c_dp,dr2c_dp,drt_dp,hardr,dpla2,dpla3,dpla4,
126 itab = int(uparam(14))
166 asrate = (two*pi*asrate*timestep)/(two*pi*asrate*timestep + one)
167 ismooth = int(uparam(35))
173 IF (off(i) < 0.1) off(i) = zero
174 IF (off(i) < one) off(i) = off(i)*four_over_5
191 xvec(1:nel,1) = pla(1:nel,2)
192 xvec(1:nel,2) = epsd(1:nel,2) * xscale1
193 ipos(1:nel,1) = vartmp(1:nel,1)
196 r1(1:nel) = r1(1:nel) * yscale1
197 dr1_dp(1:nel) = dr1_dp(1:nel) * yscale1
198 vartmp(1:nel,1) = ipos(1:nel,1)
200 xvec(1:nel,1) = pla(1:nel,3)
201 xvec(1:nel,2) = epsd(1:nel,3) * xscale2
202 ipos(1:nel,1) = vartmp(1:nel,2)
205 r2(1:nel) = r2(1:nel) * yscale2
206 dr2_dp(1:nel) = dr2_dp(1:nel) * yscale2
207 vartmp(1:nel,2) = ipos(1:nel,1)
209 xvec(1:nel,1) = pla(1:nel,4)
210 xvec(1:nel,2) = epsd(1:nel,4) * xscale1c
211 ipos(1:nel,1) = vartmp(1:nel,3)
214 r1c(1:nel) = r1c(1:nel) * yscale1c
216 vartmp(1:nel,3) = ipos(1:nel,1)
218 xvec(1:nel,1) = pla(1:nel,5)
219 xvec(1:nel,2) = epsd(1:nel,5) * xscale2c
220 ipos(1:nel,1) = vartmp(1:nel,4)
223 r2c(1:nel) = r2c(1:nel) * yscale2c
224 dr2c_dp(1:nel)= dr2c_dp(1:nel) * yscale2c
225 vartmp(1:nel,4) = ipos(1:nel,1)
227 xvec(1:nel,1) = pla(1:nel,6)
228 xvec(1:nel,2) = epsd(1:nel,6) * xscalet
229 ipos(1:nel,1) = vartmp(1:nel,5)
232 rt(1:nel) = rt(1:nel) * yscalet
233 drt_dp(1:nel) = drt_dp(1:nel) * yscalet
234 vartmp(1:nel,5) = ipos(1:nel,1)
243 signxx(i) = sigoxx(i) + a11*depsxx(i) + a12*depsyy(i)
244 signyy(i) = sigoyy(i) + a21*depsxx(i) + a22*depsyy(i)
245 signxy(i) = sigoxy(i) + depsxy(i)*g12
246 signyz(i) = sigoyz(i) + depsyz(i)*g23*shf(i)
247 signzx(i) = sigozx(i) + depszx(i)*g31*shf(i
255 IF ((signxx(i) - xi1*signyy(i)) > zero) alpha1(i) = one
256 IF ((signyy(i) - xi2*signxx(i)) > zero)
alpha2(i) = one
257 IF (-signxx(i) > zero) alpha3(i) = one
258 IF (-signyy(i) > zero) alpha4(i) = one
259 IF (abs(signxy(i)) > zero) alpha5(i) = one
265 r1(i) = sigy1 + (one/(cini1 + s1*pla(i,2)))*pla
267 r2(i) = sigy2 + (one/(cini2 + s2*pla(i,3)))*pla(i,3)
270 r1c(i) = sigy1c + (one/(cini1c + s1c*pla(i,4)))*pla(i,4)
271 r1c(i) = r1c(i)/sqrt(one - g1c)
273 r2c(i) = sigy2c + (one/(cini2c + s2c*pla(i,5)))*pla(i,5)
275 eta1(i) = one + alpha3(i)*alpha4(i)*d1
276 eta2(i) = one + alpha3(i)*alpha4(i)*d2
277 rt(i) = eta1(i)*sigyt + eta2(i)*(one/(cinit + st*pla(i,6)))*pla(i,6)
281 phi(i) = alpha1(i)*((signxx(i) - xi1*signyy(i))/r1(i))**2 +
282 .
alpha2(i)*((signyy(i) - xi2*signxx(i))/r2(i))**2 +
283 . alpha3(i)*((- signxx(i))/r1c(i))**2 +
284 . alpha4(i)*((- signyy(i))/r2c(i))**2 +
285 . alpha5(i)*(abs(signxy(i))/rt(i))**2 - one
295 IF (phi(i) > zero .AND. off(i) == one)
THEN
301 !====================================================================
304#include "vectorize.inc"
323 normxx = two*(alpha1(i)/(r1(i)**2))*(sigoxx(i)-xi1*sigoyy(i))
324 . - two*(
alpha2(i)*xi2/(r2(i)**2))*(sigoyy(i)-xi2*sigoxx(i))
325 . + two*(alpha3(i)/(r1c(i)**2))*sigoxx(i)
326 normyy = -two*(alpha1(i)*xi1/(r1(i)**2))*(sigoxx(i)-xi1*sigoyy(i))
327 . + two*(
alpha2(i)/(r2(i)**2))*(sigoyy(i)-xi2*sigoxx(i))
328 . + two*(alpha4(i)/(r2c(i)**2))*sigoyy(i)
329 normxy = (alpha5(i)/(rt(i)**2))*abs(sigoxy(i))*sign(one,sigoxy(i))
332 !-------------------------------------------------------------------------------
334 normsig = sqrt(sigoxx(i)*sigoxx(i) + sigoyy(i)*sigoyy(i) + two*sigoxy(i)
335 normsig =
max(normsig,em20)
338 IF ((sigoxx(i)/normsig > em01).OR.(sigoyy(i)/normsig > em01)) beta1 = one
339 IF ((sigoxx(i)/normsig < -em01).OR.(sigoyy(i)/normsig < -em01)) beta2
340 IF (((abs(sigoxx(i))/normsig)<em01).AND.((abs(sigoyy(i))/normsig)<em01))
THEN
345 normpxx = beta1*(two*sigoxx(i) + k2*sigoyy(i)) + beta2*(two*sigoxx(i) + k4*sigoyy(i))
346 normpyy = beta1*(two*k1*sigoyy(i) + k2*sigoxx(i)) + beta2*(two*k3*sigoyy(i) + k4*sigoxx(i))
347 normpxy = (beta1*k5 + beta2*k6)*sigoxy(i)
349 normsig = sqrt(normpxx*normpxx + normpyy*normpyy + two*normpxy*normpxy)
350 normsig =
max(normsig,em20)
352 normpxx = normpxx/normsig
353 normpyy = normpyy/normsig
354 normpxy = normpxy/normsig
361 dfdsig2 = normxx * (a11*normpxx + a12*normpyy)
362 . + normyy * (a21*normpxx + a22*normpyy)
363 . + two*normxy * two*normpxy * g12
369 dphi_dr1 = -two*alpha1(i)*(((sigoxx(i)-xi1*sigoyy(i))**2)/(r1(i)**3))
370 dphi_dr2 = -two*
alpha2(i)*(((sigoyy(i)-xi2*sigoxx(i))**2)/(r2(i)**3))
371 dphi_dr1c = -two*alpha3(i)*(sigoxx(i)**2)/(r1c(i)**3)
372 dphi_dr2c = -two*alpha4(i)*(sigoyy(i)**2)/(r2c(i)**3)
373 dphi_drt = -two*alpha5(i)*(sigoxy(i)**2)/(rt(i)**3)
376 dr1_dp(i) = (one/(cini1 + s1*pla(i,2))) * (one - (s1*pla(i,
377 dr2_dp(i) = (one/(cini2 + s2*pla(i,3))) * (one - (s2*pla(i,3) /(cini2 + s2*pla(i,3))))
378 dr1c_dp(i) = (one/(cini1c + s1c*pla(i,4))) * (one - (s1c*pla(i,4)/(cini1c + s1c*pla(i,4))))
379 dr1c_dp(i) = dr1c_dp(i)/sqrt(one - g1c)
380 dr2c_dp(i) = (one/(cini2c + s2c*pla(i,5))) * (one - (s2c*pla(i,5)/(cini2c + s2c*pla(i,5))))
381 drt_dp(i) = eta2(i)*(one/(cinit + st*pla(i,6))) * (one - (st*pla(i,6) /(cinit + st*pla(i,6))))
384 hardp(i) = sqrt(alpha1(i)*dr1_dp(i)**2 +
alpha2(i)*dr2_dp(i
385 . + alpha4(i)*dr2c_dp(i)**2 + two*alpha5(i)*drt_dp(i)**2)
386 dphi_dpla = dphi_dr1*dr1_dp(i)*alpha1(i) + dphi_dr2*dr2_dp(i)*
alpha2(i) +
387 . dphi_dr1c*dr1c_dp(i)*alpha3(i) + dphi_dr2c*dr2c_dp(i)*alpha4(i) +
388 . dphi_drt*drt_dp(i)*alpha5(i)
391 dphi_dlam = -dfdsig2 + dphi_dpla
392 dphi_dlam = sign(
max(abs(dphi_dlam),em20) ,dphi_dlam)
401 dsigxx(i) = a11*depsxx(i) + a12*depsyy(i)
402 dsigyy(i) = a21*depsxx(i) + a22*depsyy(i)
403 dsigxy(i) = depsxy(i)*g12
406 dphi = normxx * dsigxx(i)
407 . + normyy * dsigyy(i)
408 . + two * normxy * dsigxy(i)
411 dlam = -(phi(i) + dphi) / dphi_dlam
412 dlam =
max(dlam, zero)
415 dpxx = dlam * normpxx
417 dpxy = two * dlam * normpxy
420 signxx(i) = sigoxx(i) + dsigxx(i) - (a11*dpxx + a12*dpyy)
421 signyy(i) = sigoyy(i) + dsigyy(i) - (a21*dpxx + a22*dpyy)
422 signxy(i) = sigoxy(i) + dsigxy(i) - g12*dpxy
426 dpla(i) =
max(zero, dpla(i) + ddep)
427 dpla2(i) =
max(zero, dpla2(i) + alpha1(i)*ddep)
428 dpla3(i) =
max(zero, dpla3(i) +
alpha2(i)*ddep)
429 dpla4(i) =
max(zero, dpla4(i) + alpha3(i)*ddep)
430 dpla5(i) =
max(zero, dpla5(i) + alpha4(i)*ddep)
432 pla(i,1) = pla(i,1) + ddep
433 pla(i,2) = pla(i,2) + alpha1(i)*ddep
434 pla(i,3) = pla(i,3) +
alpha2(i)*ddep
435 pla(i,4) = pla(i,4) + alpha3(i)*ddep
436 pla(i,5) = pla(i,5) + alpha4(i)*ddep
437 pla(i,6) = pla(i,6) + alpha5(i)*ddep
445 IF ((signxx(i) - xi1*signyy(i)) > zero) alpha1(i) = one
446 IF ((signyy(i) - xi2*signxx(i)) > zero)
alpha2(i) = one
447 IF (-signxx(i) > zero) alpha3(i) = one
448 IF (-signyy(i) > zero) alpha4(i) = one
449 IF (abs(signxy(i)) > zero) alpha5(i) = one
455 r1(i) = sigy1 + (one/(cini1 + s1*pla(i,2)))*pla(i,2)
457 r2(i) = sigy2 + (one/(cini2 + s2*pla(i,3)))*pla(i,3)
460 r1c(i) = sigy1c + (one/(cini1c + s1c*pla(i,4)))*pla(i,4)
461 r1c(i) = r1c(i)/sqrt(one - g1c)
463 r2c(i) = sigy2c + (one/(cini2c + s2c*pla(i,5)))*pla(i,5)
465 eta1(i) = one + alpha3(i)*alpha4(i)*d1
466 eta2(i) = one + alpha3(i)*alpha4(i)*d2
467 rt(i) = eta1(i)*sigyt + eta2(i)*(one/(cinit + st*pla(i,6)))*pla(i
470 phi(i) = alpha1(i)*((signxx(i) - xi1*signyy(i))/r1(i))**2 +
471 .
alpha2(i)*((signyy(i) - xi2*signxx(i))/r2(i))**2 +
472 . alpha3(i)*((- signxx(i))/r1c(i))**2 +
473 . alpha4(i)*((- signyy(i))/r2c(i))**2 +
474 . alpha5(i)*(abs(signxy(i))/rt(i))**2 - one
486 xvec(1:nel,1) = pla(1:nel,2)
487 xvec(1:nel,2) = epsd(1:nel,2) * xscale1
488 ipos(1:nel,1) = vartmp(1:nel,1)
491 r1(1:nel) = r1(1:nel) * yscale1
492 dr1_dp(1:nel) = dr1_dp(1:nel) * yscale1
493 vartmp(1:nel,1) = ipos(1:nel,1)
495 xvec(1:nel,1) = pla(1:nel,3)
496 xvec(1:nel,2) = epsd(1:nel,3) * xscale2
497 ipos(1:nel,1) = vartmp(1:nel,2)
500 r2(1:nel) = r2(1:nel) * yscale2
501 dr2_dp(1:nel) = dr2_dp(1:nel) * yscale2
502 vartmp(1:nel,2) = ipos(1:nel,1)
504 xvec(1:nel,1) = pla(1:nel,4)
505 xvec(1:nel,2) = epsd(1:nel,4) * xscale1c
506 ipos(1:nel,1) = vartmp(1:nel,3)
509 r1c(1:nel) = r1c(1:nel) * yscale1c
510 dr1c_dp(1:nel)= dr1c_dp(1:nel) * yscale1c
511 vartmp(1:nel,3) = ipos(1:nel,1)
513 xvec(1:nel,1) = pla(1:nel,5)
514 xvec(1:nel,2) = epsd(1:nel,5) * xscale2c
515 ipos(1:nel,1) = vartmp(1:nel,4)
518 r2c(1:nel) = r2c(1:nel) * yscale2c
519 dr2c_dp(1:nel)= dr2c_dp(1:nel) * yscale2c
520 vartmp(1:nel,4) = ipos(1:nel,1)
522 xvec(1:nel,1) = pla(1
527 rt(1:nel) = rt(1:nel) * yscalet
528 drt_dp(1:nel) = drt_dp(1:nel) * yscalet
529 vartmp(1:nel,5) = ipos(
532 phi(i) = alpha1(i)*((signxx(i) - xi1
533 .
alpha2(i)*((signyy(i) - xi2*signxx(i))/r2(i))**2 +
534 . alpha3(i)*((- signxx(i))/r1c(i))**2 +
535 . alpha4(i)*((- signyy(i))/r2c(i))**2 +
536 . alpha5(i)*(abs(signxy(i))/rt(i))**2 - one
547 epsd(i,1) = dpla(i) /
max(em20,timestep)
548 epsd(i,2) = dpla2(i) /
max(em20,timestep)
549 epsd(i,3) = dpla3(i) /
max(em20,timestep)
550 epsd(i,4) = dpla4(i) /
max(em20,timestep)
551 epsd(i,5) = dpla5(i) /
max(em20,timestep)
552 epsd(i,6) = dpla6(i) /
max(em20,timestep)
554 dpdt = dpla(i)/
max(em20,timestep)
555 epsd(i,1) = asrate * dpdt + (one - asrate) * epsd(i,1)
556 dpdt = dpla2(i)/
max(em20,timestep)
557 epsd(i,2) = asrate * dpdt + (one - asrate) * epsd(i,2)
558 dpdt = dpla3(i)/
max(em20,timestep)
559 epsd(i,3) = asrate * dpdt + (one - asrate) * epsd(i,3)
560 dpdt = dpla4(i)/
max(em20,timestep)
561 epsd(i,4) = asrate * dpdt + (one - asrate) * epsd(i,4)
562 dpdt = dpla5(i)/
max(em20,timestep)
563 epsd(i,5) = asrate * dpdt + (one - asrate) * epsd(i,5)
564 dpdt = dpla6(i)/
max(em20,timestep)
565 epsd(i,6) = asrate * dpdt + (one - asrate) * epsd(i,6)
568 et(i) = hardp(i) / (hardp(i) +
max(young1,young2))
570 soundsp(i) = sqrt(
max(a11,a12,a21,a22,g12,g23,g31)/ rho(i))
572 sigy(i) = sqrt(r1(i)**2 + r2(i)**2 + r1c(i)**2 +
573 . r2c(i)**2 + two*rt(i)**2)