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) ::UNITAB
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 gamma, p0,t0, e0, psh, rho0,fac_l,fac_t,fac_m,fac_c, fac_e
74 my_real a1,a2,b0,b1,b2,c0,c1,d0,rhoi,rhor,dpdmu_partial,dpde,df,mu0,dpdmu,a2_,g0,ssp0, denom
75 LOGICAL :: IS_ENCRYPTED, , IS_AVAILABLE_RHO0
76
77
78
79 is_encrypted = .false.
80 is_available = .false.
81 is_available_rho0 = .false.
82
84
85 CALL hm_get_floatv(
'EOS_A1', a1, is_available,lsubmodel,unitab)
86 CALL hm_get_floatv(
'EOS_A2', a2, is_available,lsubmodel,unitab)
87 CALL hm_get_floatv(
'EOS_B0', b0, is_available,lsubmodel,unitab)
88 CALL hm_get_floatv(
'EOS_B1', b1, is_available,lsubmodel,unitab)
89 CALL hm_get_floatv(
'EOS_B2', b2, is_available,lsubmodel,unitab)
90
91 CALL hm_get_floatv(
'EOS_C0', c0, is_available,lsubmodel,unitab)
92 CALL hm_get_floatv(
'EOS_C_1', c1, is_available,lsubmodel,unitab)
93 CALL hm_get_floatv(
'EOS_D0', d0, is_available,lsubmodel,unitab)
94 CALL hm_get_floatv(
'LAW5_P0', p0, is_available,lsubmodel,unitab)
95
96 CALL hm_get_floatv(
'Refer_Rho', rho0, is_available_rho0,lsubmodel,unitab)
97
98 rhor = pm(1)
99 rhoi = pm(89)
100
101 IF(rho0 > zero) THEN
102 rhor = rho0
103 pm(1)= rho0
104 ELSE
105 rho0=rhor
106 ENDIF
107
108 IF(
109 . a1 <= zero .OR.
110 . a2 <= zero .OR.
111 . b0 <= zero .OR.
112 . b1 <= zero .OR.
113 . b2 <= zero .OR.
114 . c0 <= zero .OR.
115 . c1 <= zero .OR.
116 . d0 <= zero .OR.
117 . rho0 <= zero
118 . )THEN
119 CALL ancmsg(msgid=67, msgtype=msgerror, anmode=aninfo,
120 . i1=imideos,
121 . c1='/EOS/OSBORNE',
122 . c2='PARAMETERS MUST BE STRICTLY POSITIVE')
123 ENDIF
124
125
126
127 e0 =-half*(b0-p0-sqrt(four*c0*d0*p0+b0**two-two*b0*p0+p0**two))/c0
128
129
130 pm(23) = e0
131 pm(164) = a1
132 pm(32) = a2
133 pm(33) = b0
134 pm(35) = b1
135 pm(36) = b2
136 pm(160) = c0
137 pm(161) = c1
138 pm(162) = d0
139 pm(163) = p0
140 psh = zero
141 pm(88) = psh
142 pm(31) = p0
143 IF(pm(79)==zero)pm(79)=three100
144
145
146 IF(rhoi == zero)THEN
147 mu0 = zero
148 ELSE
149 IF(rhor /= zero)THEN
150 mu0 = rhoi/rhor-one
151 ELSE
152 mu0 = zero
153 ENDIF
154 ENDIF
155
156 IF(rhoi /= zero)THEN
157 df = rhor/rhoi
158 ELSE
159 df = zero
160 ENDIF
161
162
163 ssp0 = zero
164 g0 = pm(22)
165 rhoi = pm(89)
166
167 a2_=a2
168 IF(mu0 < zero)a2_=-a2
169 denom = (e0+d0)
170 dpdmu_partial = (a1+2*a2_*mu0+(two*b2*mu0+b1)*e0+c1*e0*e0)/denom
171 dpde = (((b2*mu0+b1)*mu0+b0)+(two*(c1*mu0+c0))*e0 - p0/denom)/denom
172 dpdmu = dpdmu_partial + dpde*df*df*(p0)
173
174 dpdmu=
max(zero,dpdmu)
175 IF(rhor > zero) ssp0 = sqrt((dpdmu + two_third*g0)/rhor)
176 pm(27)=ssp0
177
178 WRITE(iout,1000)
179
180 IF(is_encrypted)THEN
181 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
182 ELSE
183 WRITE(iout,1500)a1,a2,b0,b1,b2,c0,c1,d0,p0
184 IF(is_available_rho0)WRITE(iout,1501)pm(1)
185 ENDIF
186
187 RETURN
188 1000 FORMAT(
189 & 5x,' OSBORNE EOS ',/,
190 & 5x,' ----------- ',/)
191 1500 FORMAT(
192 & 5x,'A1. . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
193 & 5x,'A2. . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
194 & 5x,'B0. . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
195 & 5x,'B1. . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
196 & 5x,'B2. . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
197 & 5x,'C0. . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
198 & 5x,'C1. . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
199 & 5x,'D0. . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
200 & 5x,'P0. . . . . . . . . . . . . . . . . . . .=',1pg20.13)
201 1501 FORMAT(
202 & 5x,'EOS REFERENCE DENSITY . . . . . . . . . .=',1pg20.13)
203
204 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)