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 . mu2(nel) ,espe(nel) ,dvol(nel) ,df(nel) ,
76 . vnew(nel) ,pnew(nel) ,dpdm(nel),
77 . dpde(nel)
78 my_real,
INTENT(INOUT) :: psh(nel)
79
80
81
82 INTEGER I, MX
83 my_real :: p0,gamma,t0,e0,sph,aa, bb, dvv, pp, pstar, pc
84
85
86
87 IF(iflag == 0) THEN
88 mx = mat(1)
89 e0 = pm(23,mx)
90 gamma = pm(34,mx)
91 p0 = pm(32,mx)
92 psh(1:nel) = pm(88,mx)
93 pstar = pm(35,mx)
94 sph = pm(69,mx)
95 pc = pm(37,mx)
96 DO i=1,nel
97 pp = -gamma*pstar-psh(i) + (gamma-one)*(one+mu(i))*espe(i)
98 dpdm(i) = (gamma-one) *espe(i)+(gamma-one)*(one+mu(i))*df(i)*df(i)*(pp+psh(i) )
99 dpde(i) = (gamma-one)*(one+mu(i))
100 pnew(i) =
max(pp,pc-psh(i))*off(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 pstar = pm(35,mx)
110 sph = pm(69,mx)
111 pc = pm(37,mx)
112 DO i=1,nel
113 aa = -gamma*pstar-psh(i)
114 bb = (gamma-one)*(one+mu(i))
115 dpde(i) = (gamma-one)*(one+mu(i))
116 dvv = half*dvol(i)*df(i) /
max(em15,vnew(i))
117 pnew(i) = (aa+bb*(espe(i)-psh(i) *dvv))/(one+bb*dvv)
118 pnew(i) =
max(pnew(i),pc-psh(i) )*off(i)
119 eint(i) = eint(i) - half*dvol(i)*(pnew(i)+psh
120 ENDDO
121
122 ELSEIFTHEN
123 mx = mat(1)
124 e0 = pm(23,mx)
125 gamma = pm(34,mx)
126 p0 = pm(32,mx)
127 psh(1:nel) = pm(88,mx)
128 pstar = pm(35,mx)
129 sph = pm(69,mx)
130 pc = pm(37, mx)
131 DO i=1, nel
132 IF (vnew(i) > zero) THEN
133 pnew(i) = (gamma-one)*(one+mu(i))*espe(i) - gamma*pstar
134 pnew(i) =
max(pnew(i),pc)*off(i)
135
136 dpdm(i) = (gamma-one)*(espe(i)+pnew(i)*df(i))
137 dpde(i) = (gamma-one)*(one+mu(i))
138 pnew(i) = pnew(i)-psh(i)
139 ENDIF
140 ENDDO
141 ENDIF
142
143 RETURN