42
43
44
47
48
49
50#include "implicit_f.inc"
51
52
53
54#include "com04_c.inc"
55
56
57
58 INTEGER NEL,NUPARAM,NUVAR,JTHE,NUMTABL,ITABLE(NUMTABL),NVARTMP
59 INTEGER, DIMENSION(NEL), INTENT(IN) :: NGL
61 . time,timestep
62 INTEGER :: VARTMP(NEL,NVARTMP)
63 my_real,
DIMENSION(NUPARAM),
INTENT(IN) ::
64 . uparam
65 my_real,
DIMENSION(NEL),
INTENT(IN) ::
66 . rho,shf,
67 . depsxx,depsyy,depsxy,depsyz,depszx,
68 . sigoxx,sigoyy,sigoxy,sigoyz,sigozx
69
70 my_real ,
DIMENSION(NEL),
INTENT(OUT) ::
71 . soundsp,sigy,et,
72 . signxx,signyy,signxy,signyz,signzx
73
74 my_real ,
DIMENSION(NEL),
INTENT(INOUT) ::
75 . dpla,off
76 my_real ,
DIMENSION(NEL,4),
INTENT(INOUT) ::
77 . pla,epsd
78 my_real ,
DIMENSION(NEL,NUVAR),
INTENT(INOUT) ::
79 . uvar
80
81 TYPE(TTABLE), DIMENSION(NTABLE) :: TABLE
82
83
84
85 INTEGER I,K,II,NINDX,INDEX(NEL),NINDX2,INDEX2(NEL),ITAB,ISMOOTH,
86 . IPOS(NEL,2)
87
89 . young1,young2,nu12,nu21,g12,a11,a12,a21,a22,c1,
90 . deuxk,nu1p,nu2p,nu4p,nu5p,s01,a01,b01,c01,
91 . s02,a02,b02,c02,s03,a03,b03,c03,
92 . s04,a04,b04,c04,s05,a05,b05,c05,asig,bsig
93 . tau0,atau,btau,n3,n6,g23,g31
95 . normsig,h,dpdt,dlam,ddep,depxx,depyy
97 . normxx,normyy,normxy,normpxx,normpyy,normpxy,
98 . dphi_dlam,dphi,dfdsig2,dphi_dpla,dpxx,dpyy,dpxy,
99 . dphi_dsigy1,dphi_dsigy2,dphi_dsigy3,dphi_dsigy4,
100 . dphi_dsigy5
102 . normyz,normzx,dpsi_dlam,dpsi,dpsi_dpla,
103 . dpyz,dpzx,dpsi_dsigys
105 . xscale1,yscale1,xscale2,yscale2,xscale3,yscale3,xscale4,yscale4,
106 . xscale5,yscale5,xscales,yscales,xvec(nel,2),asrate
107
109 . n1,n2,n4,n5
110
112 . khi1,khi2,khi3,khi4,khi5,khi6,sigy1,sigy2,sigy3,sigy4,sigy5,dpla2,
113 . dpla4,sigys,dsigxx,dsigyy,dsigxy,dsigyz,dsigzx,hardp,phi,phi0,psi,psi0,
114 . gam1,gam2,gam3,gam4,gam5,gam6,dsigy1_dp,dsigy2_dp,dsigy3_dp,dsigy4_dp,
115 . dsigy5_dp,dsigys_dp,hardr
116
117
118
119
120
121
122 young1 = uparam(1)
123 young2 = uparam(2)
124 nu12 = uparam(4)
125 nu21 = uparam(5)
126 a11 = uparam(6)
127 a12 = uparam(7)
128 a21 = uparam(8)
129 a22 = uparam(9)
130 g12 = uparam(10)
131 g23 = uparam(11)
132 g31 = uparam(12)
133 itab = int(uparam(14))
134 deuxk = uparam(15)
135 nu1p = uparam(18)
136 nu2p = uparam(19)
137 nu4p = uparam(20)
138 nu5p = uparam(21)
139 IF (itab == 0) THEN
140 s01 = uparam(22)
141 a01 = uparam(23)
142 b01 = uparam(24)
143 c01 = uparam(25)
144 s02 = uparam(26)
145 a02 = uparam(27)
146 b02 = uparam(28)
147 c02 = uparam(29)
148 s03 = uparam(30)
149 a03 = uparam(31)
150 b03 = uparam(32)
151 c03 = uparam(33)
152 s04 = uparam(34)
153 a04 = uparam(35)
154 b04 = uparam(36) ! 3rd compressive plasticity parameter
155 c04 = uparam(37)
156 s05 = uparam(38)
157 a05 = uparam(39)
158 b05 = uparam(40)
159 c05 = uparam(41)
160 asig = uparam(42)
161 bsig = uparam(43) ! 2nd out-of-plane plasticity parameter
162 csig = uparam(44)
163 tau0 = uparam(45)
164 atau = uparam(46)
165 btau = uparam(47)
166 ELSE
167 xscale1 = uparam(22)
168 yscale1 = uparam(23)
169 xscale2 = uparam(24)
170 yscale2 = uparam(25)
171 xscale3 = uparam(26)
172 yscale3 = uparam(27)
173 xscale4 = uparam(28)
174 yscale4 = uparam(29)
175 xscale5 = uparam(30)
176 yscale5 = uparam(31)
177 xscales = uparam(34)
178 yscales = uparam(35)
179 asrate = uparam(36)
180 asrate = (two*pi*asrate*timestep)/(two*pi*asrate*timestep + one)
181 ismooth = int(uparam(37))
182 ENDIF
183
184
185 n1(1) = one/(sqrt(one+nu1p**2))
186 n1(2) = -nu1p/(sqrt(one+nu1p**2))
187 n2(1) = -nu2p/(sqrt(one+nu2p**2))
188 n2(2) = one/(sqrt(one+nu2p**2))
189 n3 = one
190 n4(1) = -one/(sqrt(one+nu4p**2))
191 n4(2) = nu4p/(sqrt(one+nu4p**2))
192 n5(1) = nu5p/(sqrt(one+nu5p**2))
193 n5(2) = -one/(sqrt(one+nu5p**2))
194 n6 = -one
195
196
197 DO i=1,nel
198
199 IF (off(i) < 0.1) off(i) = zero
200 IF (off(i) < one) off(i) = off(i)*four_over_5
201
202 phi0(i) = uvar(i,1)
203 psi0(i) = uvar(i,2)
204
205 dpla(i) = zero
206 dpla2(i) = zero
207 dpla4(i) = zero
208 et(i) = one
209 hardp(i) = zero
210 ENDDO
211
212
213 IF (itab > 0) THEN
214
215 xvec(1:nel,1) = pla(1
216 xvec(1:nel,2) = epsd(1:nel,2) * xscale1
217
218 ipos(1:nel,1) = vartmp(1:nel,1)
219 ipos(1:nel,2) = 1
221 sigy1(1:nel) = sigy1(1:nel) * yscale1
222 dsigy1_dp(1:nel)= dsigy1_dp(1:nel) * yscale1
223 vartmp(1:nel,1) = ipos(1:nel,1)
224
225 xvec(1:nel,2) = epsd(1:nel,2) * xscale2
226 ipos(1:nel,1) = vartmp(1:nel,2)
227 ipos(1:nel,2) = 1
229 sigy2(1:nel) = sigy2(1:nel) * yscale2
230 dsigy2_dp(1:nel)= dsigy2_dp(1:nel) * yscale2
231 vartmp(1:nel,2) = ipos(1:nel,1)
232
233 xvec(1:nel,2) = epsd(1:nel,2) * xscale3
234 ipos(1:nel,1) = vartmp(1:nel,3)
235 ipos(1:nel,2) = 1
237 sigy3(1:nel) = sigy3(1:nel
238 dsigy3_dp(1:nel)= dsigy3_dp(1:nel) * yscale3
239 vartmp(1:nel,3) = ipos(1:nel,1)
240
241 xvec(1:nel,2) = epsd(1:nel,2) * xscale4
242 ipos(1:nel,1) = vartmp(1:nel,4)
243 ipos(1:nel,2) = 1
245 sigy4(1:nel) = sigy4(1:nel) * yscale4
246 dsigy4_dp(1:nel)= dsigy4_dp(1:nel) * yscale4
247 vartmp(1:nel,4) = ipos(1:nel,1)
248
249 xvec(1:nel,2) = epsd(1:nel,2) * xscale5
250 ipos(1:nel,1) = vartmp(1:nel,5)
251 ipos(1:nel,2) = 1
253 sigy5(1:nel) = sigy5(1:nel) * yscale5
254 dsigy5_dp(1:nel)= dsigy5_dp(1:nel) * yscale5
255 vartmp(1:nel,5) = ipos(1:nel,1)
256
257 xvec(1:nel,1) = pla(1:nel,4)
258 xvec(1:nel,2) = epsd(1:nel,4) * xscales
259
260 ipos(1:nel,1) = vartmp(1:nel,7)
261 ipos(1:nel,2) = 1
263 sigys(
264 dsigys_dp(1:nel)= dsigys_dp(1:nel) * yscales
265 vartmp(1:nel,7) = ipos(1:nel,1)
266 ELSE
267 DO i = 1,nel
268
269
270 sigy1(i) = s01 + a01*tanh(b01*pla(i,2)) + c01*pla(i,2)
271
272 sigy2(i) = s02 + a02*tanh(b02*pla(i,2)) + c02*pla(i,2)
273
274 sigy3(i) = s03 + a03*tanh(b03*pla(i,2)) + c03*pla(i,2)
275
276 sigy4(i) = s04 + a04*tanh(b04*pla(i,2)) + c04*pla(i,2)
277
278 sigy5(i) = s05 + a05*tanh(b05*pla(i,2)) + c05*pla(i,2)
279
280 sigys(i) =
281 ENDDO
282 ENDIF
283
284
285
286
287 DO i=1,nel
288
289
290 signxx(i) = sigoxx(i) + a11*depsxx(i) + a12*depsyy(i)
291 signyy(i) = sigoyy(i) + a21*depsxx(i) + a22*depsyy
292 signxy(i) = sigoxy(i) + depsxy(i)*g12
293 signyz(i) = sigoyz(i) + depsyz(i)*g23*shf(i)
294 signzx(i) = sigozx(i) + depszx(i)*g31*shf(i)
295
296
297 khi1(i) = zero
298 khi2(i) = zero
299 khi3(i) = zero
300 khi4(i) = zero
301 khi5(i) = zero
302 khi6(i) = zero
303 IF ((n1(1)*signxx(i)+n1(2)*signyy(i)) > zero) khi1(i) = one
304 IF ((n2(1)*signxx(i)+n2(2)*signyy(i)) > zero
305 IF (n3*signxy(i) > zero) khi3(i) = one
306 IF ((n4(1)*signxx(i)+n4(2)*signyy(i)) > zero) khi4(i) = one
307 IF ((n5(1)*signxx(i)+n5(2)*signyy(i)) > zero) khi5(i) = one
308 IF (n6*signxy(i) > zero) khi6(i) = one
309
310
311 gam1(i) = (n1(1)*signxx(i)+n1(2)*signyy(i))/sigy1(i)
312 gam2(i) = (n2(1)*signxx(i)+n2(2)*signyy(i))/sigy2(i)
313 gam3(i) = n3*signxy(i)/sigy3(i)
314 gam4(i) = (n4(1)*signxx(i)+n4(2)*signyy(i))/sigy4(i)
315 gam5(i) = (n5(1)*signxx(i)+n5(2)*signyy(i))/sigy5(i)
316 gam6(i) = n6*signxy(i)/sigy3(i)
317 phi(i) = khi1(i)*gam1(i)**deuxk + khi2(i)*gam2(i)**deuxk +
318 . khi3(i)*gam3(i)**deuxk + khi4(i)*gam4(i
319 . khi5(i)*gam5(i)**deuxk
320
321
322
323
324 ENDDO
325
326
327
328
329
330
331 nindx = 0
332 nindx2 = 0
333 DO i=1,nel
334
335 IF (phi(i) > zero .AND. off(i) == one) THEN
336 nindx=nindx+1
337 index(nindx)=i
338 ENDIF
339
340 IF (psi(i) > zero .AND. off(i) == one) THEN
341 nindx2=nindx2+1
342 index2(nindx2)=i
343 ENDIF
344 ENDDO
345
346
347
348
349#include "vectorize.inc"
350 DO ii=1,nindx
351
352
353 i = index(ii)
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370 gam1(i) = (n1(1)*sigoxx(i)+n1(2)*sigoyy(i))/sigy1(i)
371 gam2(i) = (n2(1)*sigoxx(i)+n2(2)*sigoyy(i))/sigy2(i)
372 gam3(i) = n3*sigoxy(i)/sigy3(i)
373 gam4(i) = (n4(1)*sigoxx(i)+n4(2)*sigoyy(i))/sigy4(i)
374 gam5(i) = (n5(1)*sigoxx(i)+n5(2)*sigoyy(i))/sigy5(i)
375 gam6(i) = n6*sigoxy(i)/sigy3(i)
376 normxx = deuxk*khi1(i)*(gam1(i)**(deuxk-1))*(n1(1)/sigy1(i)) +
377 . deuxk*khi2(i)*(gam2(i)**(deuxk-1))*(n2(1)/sigy2(i)) +
378 . deuxk*khi4(i)*(gam4(i)**(deuxk-1))*(n4(1)/sigy4(i)) +
379 . deuxk*khi5(i)*(gam5(i)**(deuxk-1))*(n5(1)/sigy5(i))
380 normyy = deuxk*khi1(i)*(gam1(i)**(deuxk-1))*(n1(2)/sigy1(i)) +
381 . deuxk*khi2(i)*(gam2(i)**(deuxk-1))*(n2(2)/sigy2(i)) +
382 . deuxk*khi4(i)*(gam4(i)**(deuxk-1))*(n4(2)/sigy4(i)) +
383 . deuxk*khi5(i)*(gam5(i)**(deuxk-1))*(n5(2)/sigy5(i))
384 normxy = deuxk/two*khi3(i)*(gam3(i)**(deuxk-1))*(n3/sigy3(i)) +
385 . deuxk/two*khi6(i)*(gam6(i)**(deuxk-1))*(n6/sigy3(i))
386
387
388
389 normsig = sqrt(normxx**2 + normyy**2 + two*normxy**2)
390 normsig =
max(normsig,em20)
391 normpxx = normxx/normsig
392 normpyy = normyy/normsig
393 normpxy = normxy/normsig
394
395
396
397
398
399
400 dfdsig2 = normxx * (a11*normpxx + a12*normpyy)
401 . + normyy * (a21*normpxx + a22*normpyy)
402 . + two*normxy * two*normpxy * g12
403
404
405
406
407
408 dphi_dsigy1 = deuxk*khi1(i)*(gam1(i)**(deuxk-1))*(-(n1
409 dphi_dsigy2 = deuxk*khi2(i)*(gam2(i)**(deuxk-1))*(-(n2(1)*sigoxx(i)+n2(2)*sigoyy(i))/(sigy2(i)**2))
410 dphi_dsigy3 = deuxk*khi3(i)*(gam3(i)**(deuxk-1))*(-n3*sigoxy(i)/(sigy3(i)**2)) +
411 . deuxk*khi6(i)*(gam6(i)**(deuxk-1))*(-n6*sigoxy(i)/(sigy3(i)**2))
412 dphi_dsigy4 = deuxk*khi4(i)*(gam4(i)**(deuxk-1))*(-(n4(1)*sigoxx(i)+n4(2)*sigoyy(i))/(sigy4(i)**2))
413 dphi_dsigy5 = deuxk*khi5(i)*(gam5(i)**(deuxk-1))*(-(n5(1)*sigoxx(i)+n5(2)*sigoyy(i))/(sigy5(i)**2))
414
415 IF (itab == 0) THEN
416 dsigy1_dp(i) = a01*b01*(one-(tanh(b01*pla(i,2)))**2) + c01
417 dsigy2_dp(i) = a02*b02*(one-(tanh(b02*pla(i,2)))**2) + c02
418 dsigy3_dp(i) = a03*b03*(one-(tanh(b03*pla(i,2)))**2) + c03
419 dsigy4_dp(i) = a04*b04*(one-(tanh(b04*pla(i,2)))**2) + c04
420 dsigy5_dp(i) = a05*b05*(one-(tanh(b05*pla(i,2)))**2) + c05
421 ENDIF
422
423 hardp(i) = sqrt(dsigy1_dp(i)**2 + dsigy2_dp(i)**2 +
424 . two*dsigy3_dp(i)**2 + dsigy4_dp(i)**2 +
425 . dsigy5_dp(i)**2)
426 dphi_dpla = dphi_dsigy1*dsigy1_dp(i) + dphi_dsigy2*dsigy2_dp(i) +
427 . dphi_dsigy3*dsigy3_dp(i) + dphi_dsigy4*dsigy4_dp(i) +
428 . dphi_dsigy5*dsigy5_dp(i)
429
430
431 dphi_dlam = -dfdsig2 + dphi_dpla
432 dphi_dlam = sign(
max(abs(dphi_dlam),em20) ,dphi_dlam)
433
434
435
436
437
438 phi(i) = phi0(i)
439
440
441 dsigxx(i) = a11*depsxx(i) + a12*depsyy(i)
442 dsigyy(i) = a21*depsxx(i) + a22*depsyy(i)
443 dsigxy(i) = depsxy(i)*g12
444
445
446 dphi = normxx * dsigxx(i)
447 . + normyy * dsigyy(i)
448 . + two*normxy * dsigxy(i)
449
450
451 dlam = -(phi(i) + dphi) / dphi_dlam
452 dlam =
max(dlam, zero)
453
454
455 dpxx = dlam * normpxx
456 dpyy = dlam * normpyy
457 dpxy = two * dlam * normpxy
458
459
460 signxx(i) = sigoxx(i) + dsigxx(i) - (a11*dpxx + a12*dpyy)
461 signyy(i) = sigoyy(i) + dsigyy(i) - (a21*dpxx + a22*dpyy)
462 signxy(i) = sigoxy(i) + dsigxy(i) - g12*dpxy
463
464
465 ddep = dlam
466 dpla2(i) =
max(zero, dpla2(i) + ddep)
467 pla(i,2) = pla(i,2) + ddep
468
469
470 IF (itab == 0) THEN
471
472 sigy1(i) = s01 + a01*tanh(b01*pla(i,2)) + c01*pla(i,2)
473
474 sigy2(i) = s02 + a02*tanh(b02*pla(i,2)) + c02*pla(i,2)
475
476 sigy3(i) = s03 + a03*tanh(b03*pla(i,2)) + c03*pla(i,2)
477
478 sigy4(i) = s04 + a04*tanh(b04*pla(i,2)) + c04*pla(i,2)
479
480 sigy5(i) = s05 + a05*tanh(b05*pla(i,2)) + c05*pla(i,2)
481 ENDIF
482
483
484 khi1(i) = zero
485 khi2(i) = zero
486 khi3(i) = zero
487 khi4(i) = zero
488 khi5(i) = zero
489 khi6(i) = zero
490 IF ((n1(1)*signxx(i)+n1(2)*signyy(i)) > zero) khi1(i) = one
491 IF ((n2(1)*signxx(i)+n2(2)*signyy(i)) > zero) khi2(i) = one
492 IF (n3*signxy(i) > zero) khi3(i) = one
493 IF ((n4(1)*signxx(i)+n4(2)*signyy(i)) > zero) khi4(i) = one
494 IF ((n5(1)*signxx(i)+n5(2)*signyy(i)) > zero) khi5(i) = one
495 IF (n6*signxy(i) > zero) khi6(i) = one
496
497
498 IF (itab == 0) THEN
499 gam1(i) = (n1(1)*signxx(i)+n1(2)*signyy(i))/sigy1(i)
500 gam2(i) = (n2(1)*signxx(i)+n2(2)*signyy(i))/sigy2(i)
501 gam3(i) = n3*signxy(i)/sigy3(i)
502 gam4(i) = (n4(1)*signxx(i)+n4(2)*signyy(i))/sigy4(i)
503 gam5(i) = (n5(1)*signxx(i)+n5(2)*signyy(i))/sigy5(i)
504 gam6(i) = n6*signxy(i)/sigy3(i)
505 phi(i) = khi1(i)*gam1(i)**deuxk + khi2(i)*gam2(i)**deuxk +
506 . khi3(i)*gam3(i)**deuxk + khi4(i)*gam4(i)**deuxk +
507 . khi5(i)*gam5(i)**deuxk + khi6(i)*gam6(i)**deuxk - one
508 ENDIF
509
510 ENDDO
511
512
513
514
515
516
517
518#include "vectorize.inc"
519 DO ii=1,nindx2
520
521
522 i = index2(ii)
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539 normyz = sigoyz(i)/(sqrt(sigoyz(i)**2 + sigozx(i)**2)*sigys(i))
540 normzx = sigozx(i)/(sqrt(sigoyz(i)**2 + sigozx(i)**2)*sigys(i))
541
542
543
544
545
546
547 dfdsig2 = two*normyz * g23*shf(i) * two*normyz +
548 . two*normzx * g31*shf(i) * two*normzx
549
550
551
552
553
554 dpsi_dsigys = -sqrt(sigoyz(i)**2 + sigozx(i)**2)/(sigys(i)**2)
555
556 IF (itab == 0) dsigys_dp(i) = atau
557
558 dpsi_dpla = dpsi_dsigys*dsigys_dp(i)
559
560
561 dpsi_dlam = -dfdsig2 + dpsi_dpla
562 dpsi_dlam = sign(
max(abs(dpsi_dlam),em20),dpsi_dlam)
563
564
565
566
567
568 psi(i) = psi0(i)
569
570
571 dsigyz(i) = depsyz(i)*g23*shf(i)
572 dsigzx(i) = depszx(i)*g31*shf(i)
573
574
575 dpsi = two*normyz * dsigyz(i)
576 . + two*normzx * dsigzx(i)
577
578
579 dlam = -(psi(i) + dpsi) / dpsi_dlam
580 dlam =
max(dlam, zero)
581
582
583 dpyz = two* dlam * normyz
584 dpzx = two* dlam * normzx
585
586
587 signyz(i) = sigoyz(i) + dsigyz(i) - g23*shf(i)*dpyz
588 signzx(i) = sigozx(i) + dsigzx(i) - g31*shf(i)*dpzx
589
590
591 ddep = dlam
592 dpla4(i) =
max(zero, dpla4(i) + ddep)
593 pla(i,4) = pla(i,4) + ddep
594
595
596 IF (itab == 0) THEN
597
598 sigys(i) = tau0 + atau*pla(i,4)
599
600 psi(i) = (sqrt(signyz(i)**2 + signzx(i)**2)/sigys(i)) - one
601 ENDIF
602
603 ENDDO
604
605
606
607
608
609 IF (itab > 0) THEN
610 IF (nindx > 0) THEN
611
612 xvec(1:nel,1) = pla(1:nel,2)
613 xvec(1:nel,2) = epsd(1:nel,2) * xscale1
614
615 ipos(1:nel,1) = vartmp(1:nel,1)
616 ipos(1:nel,2) = 1
618 sigy1(1:nel) = sigy1(1:nel) * yscale1
619 dsigy1_dp(1:nel)= dsigy1_dp(1:nel) * yscale1
620 vartmp(1:nel,1) = ipos(1:nel,1)
621
622 xvec(1:nel,2) = epsd(1:nel,2) * xscale2
623 ipos(1:nel,1) = vartmp(1:nel,2)
624 ipos(1:nel,2) = 1
626 sigy2(1:nel) = sigy2(1:nel) * yscale2
627 dsigy2_dp(1:nel)= dsigy2_dp(1:nel) * yscale2
628 vartmp(1:nel,2) = ipos(1:nel,1)
629
630 xvec(1:nel,2) = epsd(1:nel,2) * xscale3
631 ipos(1:nel,1) = vartmp(1:nel,3)
632 ipos(1:nel,2) = 1
634 sigy3(1:nel) = sigy3(1:nel) * yscale3
635 dsigy3_dp(1:nel)= dsigy3_dp(1:nel) * yscale3
636 vartmp(1:nel,3) = ipos(1:nel,1)
637
638 xvec(1:nel,2) = epsd(1:nel,2) * xscale4
639 ipos(1:nel,1) = vartmp(1:nel,4)
640 ipos(1:nel,2) = 1
642 sigy4(1:nel) = sigy4(1:nel) * yscale4
643 dsigy4_dp(1:nel)= dsigy4_dp(1:nel) * yscale4
644 vartmp(1:nel,4) = ipos(1:nel,1)
645
646 xvec(1:nel,2) = epsd(1:nel,2) * xscale5
647 ipos(1:nel,1) = vartmp(1:nel,5)
648 ipos(1:nel,2) = 1
650 sigy5(1:nel) = sigy5(1:nel) * yscale5
651 dsigy5_dp(1:nel)= dsigy5_dp(1:nel) * yscale5
652 vartmp(1:nel,5) = ipos(1:nel,1)
653
654#include "vectorize.inc"
655 DO ii=1,nindx
656 i = index(ii)
657 gam1(i) = (n1(1)*signxx(i)+n1(2)*signyy(i))/sigy1(i)
658 gam2(i) = (n2(1)*signxx(i)+n2(2)*signyy(i))/sigy2(i)
659 gam3(i) = n3*signxy(i)/sigy3(i)
660 gam4(i) = (n4(1)*signxx(i)+n4(2)*signyy(i))/sigy4(i)
661 gam5(i) = (n5(1)*signxx(i)+n5(2)*signyy(i))/sigy5(i)
662 gam6(i) = n6*signxy(i)/sigy3(i)
663 phi(i) = khi1(i)*gam1(i)**deuxk + khi2(i)*gam2(i)**deuxk +
664 . khi3(i)*gam3
665 . khi5(i)*gam5(i)**deuxk + khi6(i)*gam6(i)**deuxk - one
666 ENDDO
667 ENDIF
668 IF (nindx2 > 0) THEN
669
670 xvec(1:nel,1) = pla(1:nel,4)
671 xvec(1:nel,2) = epsd(1:nel,4) * xscales
672
673 ipos(1:nel,1) = vartmp(1:nel,7)
674 ipos(1:nel,2) = 1
676 sigys(1:nel) = sigys(1:nel) * yscales
677 dsigys_dp(1:nel)= dsigys_dp(1:nel) * yscales
678 vartmp(1:nel,7) = ipos(1:nel,1)
679
680#include "vectorize.inc"
681 DO ii=1,nindx2
682 i = index2(ii)
683 psi(i) = (sqrt(signyz(i)**2 + signzx(i)**2)/sigys(i)) - one
684 ENDDO
685 ENDIF
686 ENDIF
687
688
689 DO i=1,nel
690
691 uvar(i,1) = zero
692 uvar(i,2) = zero
693
694 pla(i,1) = sqrt(pla(i,2)**2 + pla(i,4)**2)
695 dpla(i) = (pla(i,2)/(
max(sqrt(pla(i,2)**2 + pla(i,4)**2),em20)))*dpla2(i) +
696 . (pla(i,4)/(
max(sqrt(pla(i,2)**2 + pla(i,4)**2),em20)))*dpla4(i)
697
698 IF (itab == 0) THEN
699 epsd(i,1) = dpla(i) /
max(em20,timestep)
700 epsd(i,2) = dpla2(i) /
max(em20,timestep)
701 epsd(i,4) = dpla4(i) /
max(em20,timestep)
702 ELSE
703 dpdt = dpla(i)/
max(em20,timestep)
704 epsd(i,1) = asrate * dpdt + (one - asrate) * epsd(i,1)
705 dpdt = dpla2(i)/
max(em20,timestep)
706 epsd(i,2) = asrate * dpdt + (one - asrate) * epsd(i,2)
707 dpdt = dpla4(i)/
max(em20,timestep)
708 epsd(i,4) = asrate * dpdt + (one - asrate) * epsd(i,4)
709 ENDIF
710
711 IF (dpla(i) > zero) THEN
712 et(i) = hardp(i) / (hardp(i) +
max(young1,young2))
713 ELSE
714 et(i) = one
715 ENDIF
716
717 soundsp(i) = sqrt(
max(a11,a12,a21,a22,g12,g23,g31)/ rho(i))
718
719 sigy(i) = sqrt(sigy1(i)**2 + sigy2(i)**2 + sigy4(i)**2 +
720 . sigy5(i)**2 + two*sigy3(i
721 ENDDO
722
723
724#include "vectorize.inc"
725 DO ii=1,nindx
726 i = index(ii)
727 uvar(i,1) = phi(i)
728 ENDDO
729
730
731#include "vectorize.inc"
732 DO ii=1,nindx2
733 i = index2(ii)
734 uvar(i,2) = psi(i)
735 ENDDO
736