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) ,pnew(nel) ,dpdm(nel),
76 . dpde
77 my_real,
INTENT(INOUT) :: psh(nel)
78
79
80
81 INTEGER I, MX
82 my_real :: p0,gamma,t0,e0,sph,bb,dvv,pp
83
84
85
86 IF(iflag == 0) THEN
87 mx = mat(1)
88 e0 = pm(23,mx)
89 gamma = pm(32,mx)
90 p0 = pm(31,mx)
91 psh(1:nel) = pm(88,mx)
92 t0 = pm(35,mx)
93 sph = pm(69,mx)
94 DO i=1,nel
95 pp = (gamma-one)*(one+mu(i))*espe(i)
96 dpdm(i) = (gamma-one)*(espe(i)+pp*df(i))
97 dpde(i) = (gamma-one)*(one+mu(i))
98 pnew(i) = (
max(pp,zero)-psh(i))*off(i)
99 ENDDO
100
101 ELSEIF(iflag == 1) THEN
102 mx = mat(1)
103 e0 = pm(23,mx)
104 gamma = pm(32,mx)
105 p0 = pm(31,mx)
106 psh(1:nel) = pm(88,mx)
107 t0 = pm(35,mx)
108 sph = pm(69,mx)
109
110 DO i=1,nel
111 bb = (gamma-one)*(one+mu(i))
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) = (
max(pnew(i),zero)-psh(i))*off(i)
116 eint(i) = eint(i) - half*dvol(i)*(pnew(i)+psh(i))
117 ENDDO
118
119 ELSEIF (iflag == 2) THEN
120 mx = mat(1)
121 e0 = pm(23,mx)
122 gamma = pm(32,mx)
123 p0 = pm(31,mx)
124 psh(1:nel) = pm(88,mx)
125 t0 = pm(35,mx)
126 sph = pm(69,mx)
127 DO i=1, nel
128 IF (vnew(i) > zero) THEN
129 pp = (gamma-one)*(one+mu(i))*espe(i) - psh(i)
130 dpdm(i) = (gamma-one)*(espe(i)+(pp+psh(i))*df(i))
131 dpde(i) = (gamma-one)*(one+mu(i))
132 pnew(i) = pp
133 ENDIF
134 ENDDO
135 ENDIF
136
137 RETURN