35
36
37
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56#include "implicit_f.inc"
57
58
59
60 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
61 INTEGER IIN,IOUT,IUNIT
63 TYPE(SUBMODEL_DATA), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
64 INTEGER,INTENT(IN) :: IMIDEOS
65
66
67
68#include "param_c.inc"
69
70
71
73 . c0, c1, c2, c3, c4, c5, e0, psh, rho0,
74 . fac_l,fac_t,fac_m,fac_c,bb,gamma,aa,pp,denom,mu,rhoi,rhor,dpdmu,dpde
76 LOGICAL :: IS_ENCRYPTED, IS_AVAILABLE,
77
78
79
80 is_encrypted = .false.
81 is_available = .false.
82 is_available_rho0 = .false.
83
85 CALL hm_get_floatv(
'b_Covolume',bb, is_available,lsubmodel,unitab)
86 CALL hm_get_floatv(
'Gamma_Constant', gamma, is_available,lsubmodel,unitab)
88 CALL hm_get_floatv(
'LAW5_PSH', psh ,is_available,lsubmodel,unitab)
89 CALL hm_get_floatv(
'Refer_Rho', rho0 ,is_available_rho0,lsubmodel,unitab)
90
91 rhor = pm(1)
92 rhoi = pm(89)
93
94 IF(rho0 > zero) THEN
95 rhor = rho0
96 pm(1)= rho0
97 ELSE
98 rho0=rhor
99 ENDIF
100
101 pm( 23) = e0
102 pm( 32) = bb
103 pm( 33) = gamma-one
104 pm( 34) = rho0
105 pm( 88) = psh
106 IF(pm(79)==zero)pm(79)=three100
107
108
109 mu=rhoi/rhor-one
110 denom = one-bb*rhor*(one+mu)
111 bb = (gamma-one)*(one+mu)/denom
112 pp = bb*e0
113 pm(31) = pp - psh
114 pm(104) = pp - psh
115
116
117 IF(rhoi == zero)THEN
118 mu0 = zero
119 ELSE
120 IF(rhor /= zero)THEN
121 mu0 = rhoi/rhor-one
122 ELSE
123 mu0 = zero
124 ENDIF
125 ENDIF
126
127 IF(rhoi /= zero)THEN
128 df = rhor/rhoi
129 ELSE
130 df = zero
131 ENDIF
132
133 mu2 = mu0*mu0
134 pp = pm(31)+psh
135 ssp0 = zero
136 g0 = pm(22)
137 rhoi = pm(89)
138 dpde = (gamma-one)*(one+mu0)/denom
139 dpdmu = (gamma-one)*e0/denom + pp/denom*bb*rhoi + pp*df*df*dpde
140
141 dpdmu=
max(zero,dpdmu)
142 IF(rhor > zero) ssp0 = sqrt((dpdmu + two_third*g0)/rhor)
143 pm(27)=ssp0
144
145 WRITE(iout,1000)
146 IF(is_encrypted)THEN
147 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
148 ELSE
149 WRITE(iout,1500)bb,gamma,pm(31),e0,psh
150 IF(is_available_rho0)WRITE(iout,1501)pm(1)
151 ENDIF
152
153 RETURN
154 1000 FORMAT(
155 & 5x,' NOBLE-ABEL EOS ',/,
156 & 5x,' -------------- ',/)
157 1500 FORMAT(
158 & 5x,'COVOLUME. . . . . . . . . . . . . . . . .=',1pg20.13/,
159 & 5x,'GAMMA GAS CONSTANT. . . . . . . . . . . .=',1pg20.13/,
160 & 5x,'INITIAL PRESSURE. . . . . . . . . . . . .=',1pg20.13/,
161 & 5x,'INITIAL INTERNAL ENERGY PER UNIT VOLUME .=',1pg20.13/,
162 & 5x,'PRESSURE SHIFT. . . . . . . . . . . . . .=',1pg20.13)
163 1501 FORMAT(
164 & 5x,'EOS REFERENCE DENSITY . . . . . . . . . .=',1pg20.13)
165
166 RETURN
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_option_is_encrypted(is_encrypted)