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, e0, psh, rho0,fac_l,fac_t,fac_m,fac_c,pstar,rhoi,rhor,mu0,pp,df,ssp0,g0,dpdmu
74 LOGICAL :: IS_ENCRYPTED, IS_AVAILABLE, IS_AVAILABLE_RHO0
75
76
77
78 is_encrypted = .false.
79 is_available = .false.
80 is_available_rho0 = .false.
81
83
84 CALL hm_get_floatv(
'Gamma', gamma, is_available,lsubmodel,unitab)
85 CALL hm_get_floatv(
'LAW5_P0', p0, is_available,lsubmodel,unitab)
86 CALL hm_get_floatv(
'LAW5_PSH', psh, is_available,lsubmodel,unitab)
87 CALL hm_get_floatv(
'P_star', pstar, is_available,lsubmodel,unitab)
88 CALL hm_get_floatv(
'Refer_Rho', rho0, is_available_rho0,lsubmodel,unitab)
89
90 rhor = pm(1)
91 rhoi = pm(89)
92
93 IF(rho0 > zero) THEN
94 rhor = rho0
95 pm(1)= rho0
96 ELSE
97 rho0=rhor
98 ENDIF
99
100 IF(gamma /= one)THEN
101 e0=(p0+gamma*pstar)/(gamma-one)
102 ELSE
103 e0 = zero
104 ENDIf
105
106
107
108
109 IF(gamma <= one)THEN
110 CALL ancmsg(msgid=67,msgtype=msgerror,anmode=aninfo,i1=imideos,c1=
'/EOS/STIFF-GAS',c2=
'GAMMA MUST BE GREATER THAN 1.0')
111 ENDIF
112
113
114 pm(34)=gamma
115 pm(32)=p0
116 pm(88)=psh
117 pm(23)=e0
118 pm(35)=pstar
119
120
121 IF(rhoi == zero)THEN
122 mu0 = zero
123 ELSE
124 IF(rhor /= zero)THEN
125 mu0 = rhoi/rhor-one
126 ELSE
127 mu0 = zero
128 ENDIF
129 ENDIF
130
131 IF(rhoi /= zero)THEN
132 df = rhor/rhoi
133 ELSE
134 df = zero
135 ENDIF
136
137 pp = -gamma*pstar-psh + (gamma-one)*(one+mu0)*e0
138 pm(31)=p0-psh
139 IF(pm(79)==zero)pm(79)=three100
140 pm(104)=p0-psh
141
142
143 ssp0 = zero
144 g0 = pm(22)
145 rhoi = pm(89)
146 dpdmu = (gamma-one) *e0+(gamma-one)*(one+mu0)*df*df*(pp+psh)
147 dpdmu=
max(zero,dpdmu)
148 IF(rhor > zero) ssp0 = sqrt((dpdmu + two_third*g0)/rhor)
149 pm(27)=ssp0
150
151 WRITE(iout,1000)
152
153 IF(is_encrypted)THEN
154 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
155 ELSE
156 WRITE(iout,1500)gamma,p0,psh,pstar,e0
157 IF(is_available_rho0)WRITE(iout,1501)pm(1)
158 ENDIF
159
160 RETURN
161 1000 FORMAT(
162 & 5x,' STIFFENED GAS EOS ',/,
163 & 5x,' ----------------- ',/)
164 1500 FORMAT(
165 & 5x,'GAMMA . . . . . . . . . . . . . . . . . .=',1pg20.13/,
166 & 5x,'P0. . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
167 & 5x,'PSH . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
168 & 5x,'PSTAR . . . . . . . . . . . . . . . . . .=',1pg20.13/,
169 & 5x,'COMPUTED E0 . . . . . . . . . . . . . . .=',1pg20.13)
170 1501 FORMAT(
171 & 5x,'EOS REFERENCE DENSITY . . . . . . . . . .=',1pg20.13)
172
173 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)