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
58#include "implicit_f.inc"
59#include "comlock.inc"
60
61
62
63#include "param_c.inc"
64#include "com04_c.inc"
65#include "com06_c.inc"
66#include "com08_c.inc"
67#include "vect01_c.inc"
68#include "scr06_c.inc"
69
70
71
72 INTEGER MAT(NEL), IFLAG, NEL
74 . off(nel) ,eint(nel) ,mu(nel) ,
75 . espe(nel) ,dvol(nel) ,df(nel) ,
76 . vnew(nel) ,pnew(nel) ,dpdm(nel),
77 . dpde(nel)
78
79
80
81 INTEGER I,
82 my_real :: p0,psh(nel),gamma,e0,aa,bb,dvv,pp,ar0b,b,pc
83
84
85
86 IF(iflag == 0) THEN
87 mx = mat(1)
88 e0 = pm(23,mx)
89 gamma = pm(34,mx)
90 p0 = pm(32,mx)
91 psh(1:nel) = pm(88,mx)
92 ar0b = pm(35,mx)
93 b = pm(36,mx)
94 pc = pm(37,mx)
95 DO i=1,nel
96 pp = (gamma-one)*(one+mu(i))*espe(i) + ar0b*exp(b*log(one+mu(i)))
97 dpdm(i) = (gamma-one)*espe(i)+ar0b*b/(one+mu(i))*exp((b-one)*log(one+mu(i)))+(gamma-one)*df(i)*pp
98 dpde(i) = (gamma-one)*(one+mu(i))
99 pnew(i) =
max(pp,pc)*off(i)
100 pnew(i) = pnew(i) - psh(i)
101 ENDDO
102
103 ELSEIF(iflag == 1) THEN
104 mx = mat(1)
105 e0 = pm(23,mx)
106 gamma = pm(34,mx)
107 p0 = pm(32,mx)
108 psh(1:nel) = pm(88,mx)
109 ar0b = pm(35,mx)
110 b = pm(36,mx)
111 pc = pm(37,mx)
112 DO i=1,nel
113 bb = (gamma-one)*(one+mu(i))
114 dpde(i) = bb
115 aa = ar0b*exp(b*log(one+mu(i)))
116 dvv = half*dvol(i)*df(i) /
max(em15,vnew(i))
117 pnew(i) = (aa + bb*espe(i) ) / (one+bb*dvv)
118 pnew(i) =
max(pnew(i),pc)*off(i)
119 eint(i) = eint(i) - half*dvol(i)*(pnew(i))
120 pnew(i) = pnew(i) - psh(i)
121 ENDDO
122
123 ELSEIF (iflag == 2) THEN
124 mx = mat(1)
125 e0 = pm(23,mx)
126 gamma = pm(34,mx)
127 p0 = pm(32,mx)
128 psh(1:nel) = pm(88,mx)
129 ar0b = pm(35,mx)
130 b = pm(36,mx)
131 DO i=1, nel
132 IF (vnew(i) > zero) THEN
133 pnew(i) = (gamma-one)*(one+mu(i))*espe(i) + ar0b*exp(b*log(one+mu(i)))
134 dpdm(i) = (gamma-one)*espe(i)+ar0b*b/(one+mu(i))*exp((b-one)*log(one+mu(i)))+(gamma-one)*df(i)*pnew(i)
135 dpde(i) = (gamma-one)*(one+mu(i)) !partial derivative
136 pnew(i) = pnew(i)-psh(i)
137 ENDIF
138 ENDDO
139
140 ENDIF
141
142
143 RETURN