32
33
34
35#include "implicit_f.inc"
36
37
38
39#include "param_c.inc"
40#include "com04_c.inc"
41#include "com08_c.inc"
42#include "comlock.inc"
43
44
45
46 INTEGER ,INTENT(IN) :: NEL,NUVAR
47 INTEGER ,DIMENSION(NEL) ,INTENT(IN) :: MAT,PID,
48 INTEGER ,DIMENSION(NPROPMI,NUMMAT) ,INTENT(IN) ::
49 my_real ,
DIMENSION(NPROPG ,NUMGEO) ,
INTENT(IN) :: geo
50 my_real ,
DIMENSION(*) ,
INTENT(IN) :: uparam
52 my_real ,
DIMENSION(NEL,NUVAR) :: uvar
53
54
55
56 INTEGER :: I,J,IADBUF,NINDX
57 INTEGER ,DIMENSION(NEL) :: INDX,ICC,ISRATE,VFLAG
58 my_real :: k3,nu2,dsig,h01,h02,h1,h2,sv,ddexx,depsdxx,
59 . dexx,depsvxx,dp
60 my_real,
DIMENSION(NEL) :: bulk,g_ins,g_inf,ge,ge2,gv,gv2,beta,
61 . deps,gap,eps,c1,c2
62
63 DO i=1,nel
64 iadbuf = ipm(7,mat(i))-1
65 bulk(i) = uparam(iadbuf+1)
66 g_ins(i) = uparam(iadbuf+2)
67 g_inf(i) = uparam(iadbuf+3)
68 beta(i) = uparam(iadbuf+4)
69 gap(i) = geo(2,pid(i))
70 ENDDO
71
72 ge(1:nel) = g_inf(1:nel)
73 gv(1:nel) = g_ins(1:nel)-g_inf(1:nel)
74 ge2(1:nel) = ge(1:nel) * two
75 gv2(1:nel) = gv(1:nel) * two
76 c1(1:nel) = one - exp(-beta(1:nel)*dt1)
77 c2(1:nel) =-c1(1:nel) / beta(1:nel)
78
79 deps(1:nel) = epsp(1:nel) * dt1
80 eps(1:nel) = uvar(1:nel,2) + deps(1:nel)
81 uvar(1:nel,2) = eps(1:nel)
82
83 DO i=1,nel
84 IF (gap(i) > zero .AND. al(i) <= (al0(i)-gap(i))) off(i)=one
85 ENDDO
86
87 DO i=1,nel
88 k3 = bulk(i)*three
89 nu2 = (k3 - ge2(i)) / (k3 + ge(i))
91 eint(i) = eint(i) +
for(i)*deps(i)*al(i)*half
92 area(i) =
area(i)*(one - nu2*deps(i)*off(i))
93 sti(i) = k3
94 ENDDO
95
96 DO i=1,nel
97 ddexx = deps(i)*two_third
98 depsdxx = two_third*epsp(i)
99 dexx = two_third*eps(i)
100
101 depsvxx = c1(i)*(dexx - uvar(i,1)) + c2(i)*depsdxx
102 dp = bulk(i)*deps(i)
103
104 dsig = ge2(i)*ddexx - gv2(i)*depsvxx + dp
106 sti(i) =
max(sti(i), abs(dsig /
max(ddexx,em20)))
107 sti(i) = sti(i)*off(i)
109 uvar(i,1) = uvar(i,1) + depsvxx + ddexx
110 END DO
111
112 DO i=1,nel
113 eint(i) = eint(i) +
for(i)*deps(i)*al(i)*half
114 ENDDO
115
116 RETURN
subroutine area(d1, x, x2, y, y2, eint, stif0)
for(i8=*sizetab-1;i8 >=0;i8--)