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