OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_eos_sesame.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_sesame (iout, pm, unitab, iunit, lsubmodel, imideos, imid, titr, bufmat, mfi, idf, mat_param)

Function/Subroutine Documentation

◆ hm_read_eos_sesame()

subroutine hm_read_eos_sesame ( integer iout,
pm,
type (unit_type_), intent(in) unitab,
integer iunit,
type(submodel_data), dimension(nsubmod), intent(in) lsubmodel,
integer, intent(in) imideos,
integer, intent(in) imid,
character(len=nchartitle) titr,
bufmat,
integer, intent(inout) mfi,
integer, intent(inout) idf,
type(matparam_struct_), intent(inout) mat_param )

Definition at line 40 of file hm_read_eos_sesame.F.

41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE unitab_mod
45 USE submodel_mod
46 USE message_mod
49 USE matparam_def_mod, ONLY : matparam_struct_
50C-----------------------------------------------
51C D e s c r i p t i o n
52C-----------------------------------------------
53C reading parameters for
54C NOBLE-ABEL EQUATION OF STATE
55C-----------------------------------------------
56C C o m m e n t s
57C-----------------------------------------------
58C RHOI = PM(89) -> provided by /MAT
59C RHOR = PM(01) -> provided by /MAT (can be erased by EOS if present : obsolete)
60C => MU0 = RHO/RHOR-1.
61C PM(31) = P(MU0,E0) -> will be used to initialize diagonal of stress tensor SIG(1:3,*)
62C-----------------------------------------------
63C I m p l i c i t T y p e s
64C-----------------------------------------------
65#include "implicit_f.inc"
66#include "param_c.inc"
67C-----------------------------------------------
68C D u m m y A r g u m e n t s
69C-----------------------------------------------
70 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
71 INTEGER IOUT,IUNIT
72 INTEGER,INTENT(INOUT) :: MFI, IDF
73 INTEGER,INTENT(IN) :: IMID
74 my_real pm(npropm),bufmat(*)
75 TYPE(SUBMODEL_DATA), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
76 TYPE(MATPARAM_STRUCT_),INTENT(INOUT) :: MAT_PARAM
77 INTEGER,INTENT(IN) :: IMIDEOS
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 INTEGER NR, NT, IDR, IDT, IDP, IDE
82 my_real e0, rho0, rho0i, p0, t0, xnr, xnt, dpdr, rho
83 my_real dydz,rhoi,rhor
84 my_real mu0,df,ssp0,g0,dpdmu
85 CHARACTER FILE*(ncharline),FILE_TMP*(ncharline)
86 INTEGER :: FILE_LEN
87 LOGICAL :: IS_ENCRYPTED, IS_AVAILABLE, IS_AVAILABLE_RHO0
88 CHARACTER(LEN=NCHARTITLE) :: TITR
89C-----------------------------------------------
90C S o u r c e L i n e s
91C-----------------------------------------------
92 is_encrypted = .false.
93 is_available = .false.
94 is_available_rho0 = .false.
95
96 CALL hm_option_is_encrypted(is_encrypted)
97
98 CALL hm_get_floatv('MAT_EA', e0, is_available,lsubmodel,unitab)
99 CALL hm_get_floatv('SESAME_RHO', rho0, is_available_rho0,lsubmodel,unitab)
100 CALL hm_get_string('ISRTY',file, ncharline,is_available)
101
102 rhor = pm(1)
103 rhoi = pm(89)
104
105 IF(rho0 > zero) THEN
106 rhor = rho0
107 pm(1)= rho0
108 mat_param%RHO = rho0
109 ELSE
110 rho0=rhor
111 ENDIF
112
113 pm(23) = e0
114C----------------
115C READ TABLE
116C----------------
117 file_len = len_trim(file)
118 file_tmp(1:file_len) = file(1:file_len)
119 file = infile_name(1:infile_name_len)//file_tmp(1:file_len)
120 file_len = file_len + infile_name_len
121 OPEN(unit=31,file=file(1:file_len),err=999,status='OLD',form='FORMATTED')
122 READ(31,*)
123 READ(31,'(2E15.0)')xnr,xnt
124 rewind(31)
125 nr = nint(xnr)
126 nt = nint(xnt)
127
128 mat_param%EOS%NUPARAM = 0
129 mat_param%EOS%NIPARAM = 3
130 mat_param%EOS%NFUNC = 0
131 mat_param%EOS%NTABLE = 0
132 CALL mat_param%EOS%CONSTRUCT() !allocations
133
134 IF (mat_param%THERM%TINI == zero) THEN
135 mat_param%THERM%TINI =three100
136 pm(79) = three100
137 END IF
138
139 IF(pm(79) == zero)pm(79)=three100
140 idr = idf
141 idt = idr + nr
142 idp = idt + nt
143 ide = idp + nr * nt
144 idf = ide + nr * nt
145 mfi = mfi + idf - idr
146
147 mat_param%EOS%IPARAM(1) = nr ! PM(33)
148 mat_param%EOS%IPARAM(2) = nt ! PM(34)
149 mat_param%EOS%IPARAM(3) = idr ! PM(35)
150C
151 bufmat(idr:idf-1) = zero
152C
153 CALL mrdse2(bufmat(idr),nr,bufmat(idt),nt,bufmat(idp),bufmat(ide))
154 CLOSE(31)
155C
156 CALL tb2si1(bufmat(idr),bufmat(idp),bufmat(ide),nr,nt)
157 CALL tbusr1(bufmat(idr),bufmat(idp),bufmat(ide),nr,nt,unitab)
158C
159 rho = pm(89)
160
161 CALL mintp_re(bufmat(idr),nr,bufmat(idt),nt,bufmat(ide),rho,t0,e0/rho0,dydz)
162 CALL mintp_rt(bufmat(idr),nr,bufmat(idt),nt,bufmat(idp),rho,t0,p0,dpdr)
163C
164 WRITE(iout,1000)
165 IF(is_encrypted)THEN
166 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
167 ELSE
168 WRITE(iout,1500)e0,file,p0,t0
169 IF(is_available_rho0)WRITE(iout,1501)pm(1)
170 ENDIF
171
172 pm(31) = p0
173
174 !SSP0
175 IF(rhoi == zero)THEN
176 mu0 = zero ! error 683 already displayed
177 ELSE
178 IF(rhor /= zero)THEN
179 mu0 = rhoi/rhor-one
180 ELSE
181 mu0 = zero ! error 683 already displayed
182 ENDIF
183 ENDIF
184
185 IF(rhoi /= zero)THEN
186 df = rhor/rhoi
187 ELSE
188 df = zero
189 ENDIF
190
191 rho0i=pm(89)
192 ssp0 = zero
193 g0 = pm(22)
194 rhoi = pm(89)
195 dpdmu=rho0i*dpdr
196 dpdmu=max(zero,dpdmu)
197 IF(rhor > zero) ssp0 = sqrt((dpdmu + two_third*g0)/rhor)
198 pm(27)=ssp0
199
200 RETURN
201 999 CONTINUE
202 CALL ancmsg(msgid=19,msgtype=msgerror,anmode=aninfo,i1=imid,c1='EOS',c2='EOS',c3=titr,c4=file)
203 RETURN
204
205 1000 FORMAT(
206 & 5x,' SESAME TABLE EOS ',/,
207 & 5x,' ---------------- ',/)
208 1500 FORMAT(
209 & 5x,'INITIAL INTERNAL ENERGY PER UNIT VOLUME. =',1pg20.13/,
210 & 5x,'SESAME TABLE 301 . . . . . . . . . . . . =',a70/,
211 & 5x,'INITIAL PRESSURE . . . . . . . . . . . . =',1pg20.13/,
212 & 5x,'INITIAL TEMPERATURE. . . . . . . . . . . =',1pg20.13)
213 1501 FORMAT(
214 & 5x,'EOS REFERENCE DENSITY . . . . . . . . . .=',1pg20.13)
215C
216 RETURN
#define my_real
Definition cppsort.cpp:32
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_string(name, sval, size, is_available)
subroutine hm_option_is_encrypted(is_encrypted)
#define max(a, b)
Definition macros.h:21
subroutine mintp_re(xx, nx, yy, ny, zz, x, y, z, dydz)
Definition mintp_re.F:34
subroutine mintp_rt(xx, nx, yy, ny, zz, x, y, z, dzdx)
Definition mintp_rt.F:35
subroutine mrdse2(rr, nr, tt, nt, pp, ee)
Definition mrdse2.F:31
integer infile_name_len
character(len=infile_char_len) infile_name
integer, parameter nchartitle
integer, parameter ncharline
subroutine tbusr1(r, p, e, nr, nt, unitab)
subroutine tb2si1(dens, pres, ener, nr, nt)
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