OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_eos_tabulated.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_eos_tabulated (iout, pm, unitab, iunit, lsubmodel, imideos, eos_struct)

Function/Subroutine Documentation

◆ hm_read_eos_tabulated()

subroutine hm_read_eos_tabulated ( integer iout,
pm,
type (unit_type_), intent(in) unitab,
integer iunit,
type(submodel_data), dimension(nsubmod), intent(in) lsubmodel,
integer, intent(in) imideos,
type(eos_param_), intent(inout) eos_struct )

Definition at line 36 of file hm_read_eos_tabulated.F.

37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE unitab_mod
41 USE submodel_mod
42 USE message_mod
43 USE eos_param_mod , ONLY : eos_param_
44C-----------------------------------------------
45C D e s c r i p t i o n
46C-----------------------------------------------
47C reading parameters for
48C IDEAL-GAS EQUATION OF STATE
49C-----------------------------------------------
50C C o m m e n t s
51C-----------------------------------------------
52C RHOI = PM(89) -> provided by /MAT
53C RHOR = PM(01) -> provided by /MAT (can be erased by EOS if present : obsolete)
54C => MU0 = RHO/RHOR-1.
55C PM(31) = P(MU0,E0) -> will be used to initialize diagonal of stress tensor SIG(1:3,*)
56C-----------------------------------------------
57C I m p l i c i t T y p e s
58C-----------------------------------------------
59#include "implicit_f.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
64 INTEGER IOUT,IUNIT
65 my_real pm(npropm)
66 TYPE(SUBMODEL_DATA), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
67 INTEGER,INTENT(IN) :: IMIDEOS
68 TYPE(EOS_PARAM_),INTENT(INOUT) :: EOS_STRUCT
69C-----------------------------------------------
70C C o m m o n B l o c k s
71C-----------------------------------------------
72#include "param_c.inc"
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
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
80C-----------------------------------------------
81C S o u r c e L i n e s
82C-----------------------------------------------
83 is_encrypted = .false.
84 is_available = .false.
85 is_available_rho0 = .false.
86
87 CALL hm_option_is_encrypted(is_encrypted)
88
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)
91
92 CALL hm_get_floatv('XscaleA', xscale_a, is_available,lsubmodel,unitab)
93 CALL hm_get_floatv('XscaleB', xscale_b, is_available,lsubmodel,unitab)
94
95 CALL hm_get_floatv('FscaleA', fscale_a, is_available,lsubmodel,unitab)
96 CALL hm_get_floatv('FscaleB', fscale_b, is_available,lsubmodel,unitab)
97
98 CALL hm_get_floatv('PSH', psh, is_available,lsubmodel,unitab)
99 CALL hm_get_floatv('E0', e0, is_available,lsubmodel,unitab)
100 CALL hm_get_floatv('Refer_Rho', rho0, is_available_rho0,lsubmodel,unitab)
101
102 !MANAGING INPUT ERRORS :
103 IF(a_fun_id+b_fun_id == 0)THEN
104 CALL ancmsg(msgid=67,msgtype=msgerror,anmode=aninfo,
105 . i1=imideos,
106 . c1='/EOS/TABULATED',
107 . c2='NO INPUT FUNCTION')
108 ENDIF
109
110 IF(is_available_rho0 .AND. rho0 < zero)THEN
111 CALL ancmsg(msgid=67,msgtype=msgerror,anmode=aninfo,
112 . i1=imideos,
113 . c1='/EOS/TABULATED',
114 . c2='REFERENCE DENSITY MUST BE STRICTLY POSITIVE')
115 ENDIF
116
117 !REFERENCE DENSITY
118 rhor = pm(1)
119 rhoi = pm(89)
120
121 IF(rho0 > zero) THEN
122 rhor = rho0
123 pm(1)= rho0
124 ELSE
125 rho0=rhor
126 ENDIF
127
128 !COMPUTE P0 (stress tensor)
129 IF(rhoi == zero)THEN
130 mu0 = zero ! error 683 already displayed
131 ELSE
132 IF(rhor /= zero)THEN
133 mu0 = rhoi/rhor-one
134 ELSE
135 mu0 = zero ! error 683 already displayed
136 ENDIF
137 ENDIF
138
139 IF(rhoi /= zero)THEN
140 df = rhor/rhoi
141 ELSE
142 df = zero
143 ENDIF
144
145 p0 = zero ! A(MU0) + B(MU0)*E0
146
147 !SSP0
148 ssp0 = zero
149 g0 = zero
150 rhoi = pm(89)
151 dpdmu = zero ! A'(MU0) + B'(MU0)*E0+B(MU0)/(ONE+MU0)/(ONE+MU0)*P0
152
153 dpdmu=max(zero,dpdmu)
154 IF(rhor > zero) ssp0 = sqrt((dpdmu + two_third*g0)/rhor)
155
156 !STORAGE
157 pm(23) = e0
158 pm(27) = ssp0
159 pm(32) = zero
160 pm(88) = psh
161 pm(31) = p0-psh
162 pm(104)= p0-psh
163
164 eos_struct%NUPARAM = 4
165 eos_struct%NIPARAM = 2
166 eos_struct%NFUNC = 0
167 eos_struct%NTABLE = 0
168 CALL eos_struct%CONSTRUCT() !allocations
169
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
174
175 eos_struct%IPARAM(1) = a_fun_id
176 eos_struct%IPARAM(2) = b_fun_id
177
178 eos_struct%E0 = e0
179 eos_struct%PSH = psh
180
181 WRITE(iout,1000)
182
183 IF(is_encrypted)THEN
184 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
185 ELSE
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)
188 ENDIF
189
190 RETURN
191 1000 FORMAT(
192 & 5x,' TABULATED EOS ',/,
193 & 5x,' ------------- ',/)
194 1500 FORMAT(
195 & 5x,'FUNCTION A IDENTIFIER . . . . . . . . . .=',1pg20.13/,
196 & 5x,'XSCALE_A. . . . . . . . . . . . . . . . .=',1pg20.13/,
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)
203 1501 FORMAT(
204 & 5X,'eos reference density . . . . . . . . . .=',1PG20.13)
205
206 RETURN
207
#define my_real
Definition cppsort.cpp:32
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_is_encrypted(is_encrypted)
#define max(a, b)
Definition macros.h:21
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)
Definition message.F:895