43 USE eos_param_mod ,
ONLY : eos_param_
59#include "implicit_f.inc"
63 TYPE (UNIT_TYPE_),
INTENT(IN) ::UNITAB
66 TYPE(
submodel_data),
DIMENSION(NSUBMOD),
INTENT(IN) :: LSUBMODEL
67 INTEGER,
INTENT(IN) :: IMIDEOS
68 TYPE(eos_param_),
INTENT(INOUT) :: EOS_STRUCT
76 my_real :: p0, e0, psh, rho0,mu0,rhoi,rhor,g0,ssp0,dpdmu,df
77 my_real :: xscale_a, xscale_b, fscale_a, fscale_b
78 LOGICAL :: IS_ENCRYPTED, IS_AVAILABLE, IS_AVAILABLE_RHO0
79 INTEGER :: A_FUN_ID, B_FUN_ID
83 is_encrypted = .false.
84 is_available = .false.
85 is_available_rho0 = .false.
89 CALL hm_get_intv (
'A_FUNC' ,a_fun_id ,is_available,lsubmodel)
90 CALL hm_get_intv (
'B_FUNC' ,b_fun_id ,is_available,lsubmodel)
92 CALL hm_get_floatv(
'XscaleA', xscale_a, is_available,lsubmodel,unitab)
93 CALL hm_get_floatv(
'XscaleB', xscale_b, is_available,lsubmodel,unitab)
95 CALL hm_get_floatv(
'FscaleA', fscale_a, is_available,lsubmodel,unitab)
96 CALL hm_get_floatv(
'FscaleB', fscale_b, is_available,lsubmodel,unitab)
100 CALL hm_get_floatv(
'Refer_Rho', rho0, is_available_rho0,lsubmodel,unitab)
103 IF(a_fun_id+b_fun_id == 0)
THEN
104 CALL ancmsg(msgid=67,msgtype=msgerror,anmode=aninfo,
106 . c1=
'/EOS/TABULATED',
107 . c2=
'NO INPUT FUNCTION')
110 IF(is_available_rho0 .AND. rho0 < zero)
THEN
111 CALL ancmsg(msgid=67,msgtype=msgerror,anmode=aninfo,
113 . c1=
'/EOS/TABULATED',
114 . c2=
'REFERENCE DENSITY MUST BE STRICTLY POSITIVE')
153 dpdmu=
max(zero,dpdmu)
154 IF(rhor > zero) ssp0 = sqrt((dpdmu + two_third*g0)/rhor)
164 eos_struct%NUPARAM = 4
165 eos_struct%NIPARAM = 2
167 eos_struct%NTABLE = 0
168 CALL eos_struct%CONSTRUCT()
170 eos_struct%UPARAM(1) = xscale_a
171 eos_struct%UPARAM(2) = xscale_b
172 eos_struct%UPARAM(3) = fscale_a
173 eos_struct%UPARAM(4) = fscale_b
175 eos_struct%IPARAM(1) = a_fun_id
176 eos_struct%IPARAM(2) = b_fun_id
184 WRITE(iout,
'(5X,A,//)')
'CONFIDENTIAL DATA'
186 WRITE(iout,1500)a_fun_id,xscale_a,fscale_a,b_fun_id,xscale_b,fscale_b,e0,psh
187 IF(is_available_rho0)
WRITE(iout,1501)pm(1)
192 & 5x,
' TABULATED EOS '
193 & 5x,
' ------------- ',/)
195 & 5x,
'FUNCTION A IDENTIFIER . . . . . . . . . .=',1pg20.13/,
196 & 5x,
'XSCALE_A. . . . . . . . . . . . . . . . .='
197 & 5x,
'FSCALE_A. . . . . . . . . . . . . . . . .=',1pg20.13/,
198 & 5x,
'FUNCTION B IDENTIFIER . . . . . . . . . .=',1pg20.13/,
199 & 5x,
'XSCALE_B. . . . . . . . . . . . . . . . .=',1pg20.13/,
200 & 5x,
'FSCALE_B. . . . . . . . . . . . . . . . .=',1pg20.13/,
201 & 5x,
'E0. . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
202 & 5x,
'PSH . . . . . . . . . . . . . . . . . . .=',1pg20.13)
204 & 5x,
'EOS REFERENCE DENSITY . . . . . . . . . .=',1pg20.13)
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)