36
37
38
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57#include "implicit_f.inc"
58
59
60
61 TYPE (UNIT_TYPE_),INTENT(IN) ::
62 INTEGER IIN,IOUT,IUNIT
64 TYPE(SUBMODEL_DATA), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
65 INTEGER,INTENT(IN) :: IMIDEOS
66
67
68
69#include "param_c.inc"
70
71
72
73 my_real :: c, s1, s2, s3, gama0, a, e0
74 my_real :: mu,mu2,fac1,dpdmu,pp,bb,aa
75 my_real :: mu0, df, ssp0, g0, fac, ff, fg, xx, dff, dfg
78 LOGICAL :: IS_ENCRYPTED, IS_AVAILABLE, IS_AVAILABLE_RHO0
79
80
81
82 is_encrypted = .false.
83 is_available = .false.
84 is_available_rho0 = .false.
85
87
92
93 CALL hm_get_floatv(
'GAMMA',gama0, is_available,lsubmodel,unitab)
98 CALL hm_get_floatv(
'Refer_Rho', rho0 ,is_available_rho0,lsubmodel,unitab)
99
100 IF(a == zero) a=gama0
101
102
103 IF(p0 < zero)THEN
104 CALL ancmsg(msgid=67,msgtype=msgerror,anmode=aninfo,i1=imideos,
105 . c1='/EOS/GRUNEISEN',
106 . c2='INITIAL PRESSURE MUST BE STRICTLY POSITIVE (TOTAL PRESSURE). USE PSH PARAMETER TO SHIFT THE PRESSURE'
107 ENDIF
108
109 IF(p0 > zero .AND. e0 /= zero)THEN
110 CALL ancmsg(msgid=67,msgtype=msgerror,anmode=aninfo,i1=imideos,
111 . c1='/EOS/GRUNEISEN',
112 . c2='INITIAL PRESSURE PROVIDED. E0 IS CONSEQUENTLY REDEFINED SUCH AS P(RHO0,E0)=P0')
113 ENDIF
114
115 rhor = pm(1)
116 rhoi = pm(89)
117
118 IF(rho0 > zero) THEN
119 rhor = rho0
120 pm(1)= rho0
121 ELSE
122 rho0=rhor
123 ENDIF
124
125
126
127 IF(rhoi == zero)THEN
128 mu0 = zero
129 ELSE
130 IF(rhor /= zero)THEN
131 mu0 = rhoi/rhor-one
132 ELSE
133 mu0 = zero
134 ENDIF
135 ENDIF
136
137 IF(p0 > zero)THEN
138 if(gama0 /= zero)then
139 e0 = (p0-rho0*c*c*mu0)/(gama0+a*mu0)
140 endif
141 ENDIF
142
143 IF(rhoi /= zero)THEN
144 df = rhor/rhoi
145 ELSE
146 df = zero
147 ENDIF
148
149 mu2=mu0*mu0
150 ssp0 = zero
151 g0 = pm(22)
152 rhoi = pm(89)
153 fac=one
154 fac1=one
155 IF(mu0>0)THEN
156 xx= mu0/(one+mu0)
157 ff=one+(one-half*gama0)*mu0-half*a*mu2
158 fg=one-(s1-one+s2*xx+s3*xx*xx)*mu0
159 fac=ff/(fg*fg)
160 dff=one-half*gama0-a*mu0
161 dfg=one-s1+xx*(-two*s2+xx*(s2-three*s3)+two*s3*xx*xx)
162 fac1=fac*(one+mu0*(dff/ff-two*dfg/fg))
163 ENDIF
164 aa=fac*rhor*c*c*mu0
165 bb=gama0+a*mu0
166 pp=
max(aa+bb*e0,pm(37))
167
168 dpdmu=fac1*rhoi*c*c+pp*df*df*bb+a*e0
169 dpdmu=
max(zero,dpdmu)
170 IF(rhor > zero) ssp0 = sqrt((dpdmu + two_third*g0)/rhor)
171
172
173 pm(23) = e0
174 pm(32) = pm(1)*c*c
175 pm(33) = c
176 pm(34) = s1
177 pm(35) = gama0
178 pm(36) = a
179 pm(88) = psh
180 pm(160) = s2
181 pm(161) = s3
182 IF(pm(79)==zero)pm(79)=three100
183 pm(27) = ssp0
184 pm(31) = pp - psh
185 pm(104) = pp - psh
186
187 WRITE(iout,1000)
188 IF(is_encrypted)THEN
189 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
190 ELSE
191 WRITE(iout,1500)c,s1,s2,s3,gama0,a,e0,pp,psh,pp-psh
192 IF(is_available_rho0)WRITE(iout,1501)pm(1)
193 ENDIF
194
195 RETURN
196
197 1000 FORMAT(
198 & 5x,' MIE-GRUNEISEN EOS ',/,
199 & 5x,' ----------------- ',/)
200 1500 FORMAT(
201 & 5x,'C . . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
202 & 5x,'S1. . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
203 & 5x,'S2. . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
204 & 5x,'S3. . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
205 & 5x,'GAMA0 . . . . . . . . . . . . . . . . . .=',1pg20.13/,
206 & 5x,'A . . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
207 & 5x,'INITIAL INTERNAL ENERGY PER UNIT VOLUME .=',1pg20.13/,
208 & 5x,'INITIAL PRESSURE . . . . . . . . . . . .=',1pg20.13/,
209 & 5x,'PRESSURE SHIFT . . . . . . . . . . . . .=',1pg20.13/,
210 & 5x,'INITIAL PRESSURE (SHIFTED) . . . . . . .=',1pg20.13)
211 1501 FORMAT(
212 & 5x,'EOS REFERENCE DENSITY . . . . . . . . . .=',1pg20.13)
213
214 RETURN
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_option_is_encrypted(is_encrypted)
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)