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,cv,t0,b,q,q_
75 LOGICAL :: IS_ENCRYPTED, IS_AVAILABLE, IS_AVAILABLE_RHO0
76 my_real :: pp,dpde,dpdmu ,g0,ssp0,mu0,df
77
78
79
80 is_encrypted = .false.
81 is_available = .false.
82 is_available_rho0 = .false.
83
85
86 CALL hm_get_floatv(
'b_Covolume', b, is_available,lsubmodel,unitab)
87 CALL hm_get_floatv(
'Gamma_Constant', gamma, is_available,lsubmodel,unitab)
88 CALL hm_get_floatv(
'P_star', pstar, is_available,lsubmodel,unitab)
90
91 CALL hm_get_floatv(
'LAW5_PSH', psh, is_available,lsubmodel,unitab)
92 CALL hm_get_floatv(
'LAW5_P0', p0, is_available,lsubmodel,unitab)
93 CALL hm_get_floatv(
'EOS_C0', cv, is_available,lsubmodel,unitab)
94 CALL hm_get_floatv(
'Refer_Rho', rho0, is_available_rho0,lsubmodel,unitab)
95
96
97 rhor = pm(1)
98 rhoi = pm(89)
99 IF(rho0 > zero) THEN
100 rhor = rho0
101 pm(1)= rho0
102 ELSE
103 rho0=rhor
104 ENDIF
105
106
107 t0=(one/rho0-b)*(p0+pstar)/(gamma-one)/cv
108 e0=(p0+gamma*pstar)*(one-rho0*b)/(gamma-1)+rho0*q
109
110
111
112
113 IF(gamma <= one)THEN
114 CALL ancmsg(msgid=67,msgtype=msgerror,anmode=aninfo,
115 . i1=imideos,
116 . c1='/EOS/NASG',
117 . c2='GAMMA MUST BE GREATER THAN 1.0')
118 ENDIF
119
120 IF(e0 <= zero)THEN
121 CALL ancmsg(msgid=67,msgtype=msgerror,anmode=aninfo,
122 . i1=imideos,
123 . c1='/EOS/NASG',
124 . c2='PARAMETERS ARE RESULTING INTO A NEGATIVE ENERGY : E0')
125 ENDIF
126
127 q_ = zero
128
129 pm(034)=gamma
130 pm(032)=p0
131 pm(088)=psh
132 pm(023)=e0
133 pm(160)=pstar
134 pm(031)=p0
135 pm(035)=q
136 pm(036)=q_
137 pm(161)=b
138 pm(162)=cv
139 pm(079)=t0
140 IF(pm(79)==zero)pm(79)=three100
141
142
143 IF(rhoi == zero)THEN
144 mu0 = zero
145 ELSE
146 IF(rhor /= zero)THEN
147 mu0 = rhoi/rhor-one
148 ELSE
149 mu0 = zero
150 ENDIF
151 ENDIF
152
153 IF(rhoi /= zero)THEN
154 df = rhor/rhoi
155 ELSE
156 df = zero
157 ENDIF
158
159
160 ssp0 = zero
161 g0 = pm(22)
162 rhoi = pm(89)
163 unpmu = one+mu0
164 denom = (one-rhoi*b*unpmu)
165 num = (e0-rhoi*q)
166 pp = p0
167 dpde = (gamma-one)*unpmu / denom
168 dpdmu = (gamma-one)*num/denom/denom + dpde*(pp)/unpmu/unpmu
169
170 dpdmu=
max(zero,dpdmu)
171 IF(rhor > zero) ssp0 = sqrt((dpdmu + two_third*g0)/rhor)
172 pm(27)=ssp0
173
174
175 WRITE(iout,1000)
176 IF(is_encrypted)THEN
177 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
178 ELSE
179 WRITE(iout,1500)gamma,b,q,psh,pstar,cv,p0,e0
180 IF(is_available_rho0)WRITE(iout,1501)pm(1)
181 ENDIF
182
183 RETURN
184 1000 FORMAT(
185 & 5x,' NOBLE-ABEL-STIFFENED GAS EOS',/,
186 & 5x,' ----------------------------',/)
187 1500 FORMAT(
188 & 5x,'GAMMA . . . . . . . . . . . . . . . . . .=',1pg20.13/,
189 & 5x,'b . . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
190 & 5x,'q . . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
191
192 & 5x,'PSH . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
193 & 5x,'PSTAR . . . . . . . . . . . . . . . . . .=',1pg20.13/,
194 & 5x,'Cv. . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
195 & 5x,'P0. . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
196
197 & 5x,'E0 . . . . . . . . . . . . . . . . . . .=',1pg20.13)
198 1501 FORMAT(
199 & 5x,'EOS REFERENCE DENSITY . . . . . . . . . .=',1pg20.13)
200
201 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)