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
72 my_real c0, c1, c2, c3, c4, c5, psh, rho0,rhor,mu0, fac_l,fac_t,fac_m,fac_c,rhoi,g0,ssp0,dpdmu
73 LOGICAL :: IS_ENCRYPTED, IS_AVAILABLE , IS_AVAILABLE_RHO0
74
75
76
77 is_encrypted = .false.
78 is_available = .false.
79 is_available_rho0 = .false.
80
82
83 CALL hm_get_floatv(
'LAW5_P0', c0, is_available,lsubmodel,unitab)
84 CALL hm_get_floatv(
'MAT_BULK', c1, is_available,lsubmodel,unitab)
85 CALL hm_get_floatv(
'LAW5_PSH', psh, is_available,lsubmodel,unitab)
86 CALL hm_get_floatv(
'Refer_Rho', rho0, is_available_rho0,lsubmodel,unitab)
87
88 rhor = pm(1)
89 rhoi = pm(89)
90
91 IF(rho0 > zero) THEN
92 rhor = rho0
93 pm(1)= rho0
94 ELSE
95 rho0=rhor
96 ENDIF
97
98 pm( 23)=zero
99 pm(104)=c0-psh
100 pm( 32)=c1
101 pm( 33)=zero
102 pm( 34)=zero
103 pm( 35)=zero
104 pm( 36)=zero
105 pm( 88)=psh
106 IF(pm(79)==zero)pm(79)=three100
107
108
109 IF(rhoi == zero)THEN
110 mu0 = zero
111 ELSE
112 IF(rhor /= zero)THEN
113 mu0 = rhoi/rhor-one
114 ELSE
115 mu0 = zero
116 ENDIF
117 ENDIF
118
119 pm(31)=c0-psh+c1*mu0
120
121
122 ssp0 = zero
123 g0 = pm(22)
124 rhoi = pm(89)
125 dpdmu = c1
126
127 dpdmu=
max(zero,dpdmu)
128 IF(rhor > zero) ssp0 = sqrt((dpdmu + two_third*g0)/rhor)
129 pm(27)=ssp0
130
131 WRITE(iout,1000)
132 IF(is_encrypted)THEN
133 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
134 ELSE
135 WRITE(iout,1500)c0,c1,psh
136 IF(is_available_rho0)WRITE(iout,1501)pm(1)
137 ENDIF
138
139 RETURN
140 1000 FORMAT(
141 & 5x,' LINEAR EOS ',/,
142 & 5x,' ---------- ',/)
143 1500 FORMAT(
144 & 5x,'INITIAL PRESSURE. . . . . . . . . . . . .=',1pg20.13/,
145 & 5x,'BULK MODULUS. . . . . . . . . . . . . . .=',1pg20.13/,
146 & 5x,'PRESSURE SHIFT. . . . . . . . . . . . . .=',1pg20.13)
147 1501 FORMAT(
148 & 5x,'EOS REFERENCE DENSITY . . . . . . . . . .=',1pg20.13)
149
150 RETURN
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_option_is_encrypted(is_encrypted)