31
32
33
34
35
36
37
38!
39
40
41
42
43
44!
45
46
47
48
49
50
51
52
53
54
55
56
57#include "implicit_f.inc"
58#include "comlock.inc"
59
60
61
62#include "param_c.inc"
63#include "com04_c.inc"
64#include "com06_c.inc"
65#include "com08_c.inc"
66#include "vect01_c.inc"
67#include "scr06_c.inc"
68
69
70
71 INTEGER MAT(NEL), IFLAG, NEL
73 . off(nel) ,eint(nel) ,mu(nel) ,
74 . espe(nel) ,dvol(nel) ,df(nel) ,
75 . vnew(nel) ,psh(nel) ,pnew(nel) ,dpdm(nel),
76 . dpde(nel)
77
78
79
80 INTEGER I, MX
81 my_real gm1(nel), dvv, pp,bb_(nel),rho0(nel)
83
84 IF(iflag == 0) THEN
85 DO i=1,nel
86 mx = mat(i)
87 bb_(i) = pm(32,mx)
88 gm1(i) = pm(33,mx)
89 rho0(i) = pm(34,mx)
90 psh(i) = pm(88,mx)
91 ENDDO
92 DO i=1,nel
93 denom = one-bb_(i)*rho0(i)*(one+mu(i))
94 pp = espe(i)*gm1(i)*(mu(i)+one)/denom
95 dpde(i) = gm1(i)*(one+mu(i))/denom
96 dpdm(i) = gm1(i)*espe(i)/denom + pp/denom*bb_(i)*rho0(i) + pp*df(i)*df(i)*dpde(i)
97 pnew(i) =
max(pp,zero)*off(i)
98 pnew(i) = pnew(i)-psh(i)
99 ENDDO
100
101 ELSEIF(iflag == 1) THEN
102 DO i=1,nel
103 mx = mat(i)
104 bb_(i) = pm(32,mx)
105 gm1(i) = pm(33,mx)
106 rho0(i) = pm(34,mx)
107 psh(i) = pm(88,mx)
108 ENDDO
109 DO i=1,nel
110 denom = one-bb_(i)*rho0(i)*(one+mu(i))
111 bb = gm1(i)*(one+mu(i))/denom
112 dpde(i) = bb
113 dvv = half*dvol(i)*df(i) /
max(em15,vnew(i))
114 pnew(i) = (bb*espe(i))/(one+bb*dvv)
115 pnew(i) = pnew(i)*off(i)
116 eint(i) = eint(i) - half*dvol(i)*pnew(i)
117 pnew(i) = pnew(i)-psh(i)
118 ENDDO
119
120 ELSEIF(iflag == 2) THEN
121 DO i=1, nel
122 mx = mat(i)
123 bb_(i) = pm(32,mx)
124 gm1(i) = pm(33,mx)
125 rho0(i) = pm(34,mx)
126 psh(i) = pm(88,mx)
127 ENDDO
128 DO i=1, nel
129 IF (vnew(i) > zero) THEN
130 denom = one-bb_(i)*rho0(i)*(one+mu(i))
131 pp = espe(i)*gm1(i)*(mu(i)+one)/denom
132 dpde(i) = gm1(i)*(one+mu(i))/denom
133 dpdm(i) = gm1(i)*espe(i)/denom + pp/denom*bb_(i)*rho0(i) + pp*df(i)*df(i)*dpde(i)
134 pnew(i) = pp-psh(i)
135 ENDIF
136 ENDDO
137 ENDIF
138 RETURN