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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_mat97 (uparam, maxuparam, nuparam, israte, imatvis, nuvar, ifunc, maxfunc, nfunc, parmat, unitab, mat_id, titr, mtag, lsubmodel, pm, ipm, matparam)

Function/Subroutine Documentation

◆ hm_read_mat97()

subroutine hm_read_mat97 ( dimension(maxuparam), intent(inout) uparam,
integer, intent(inout) maxuparam,
integer, intent(inout) nuparam,
integer, intent(inout) israte,
integer, intent(inout) imatvis,
integer, intent(inout) nuvar,
integer, dimension(maxfunc), intent(inout) ifunc,
integer, intent(inout) maxfunc,
integer, intent(inout) nfunc,
dimension(100), intent(inout) parmat,
type (unit_type_), intent(in) unitab,
integer, intent(in) mat_id,
character(len=nchartitle), intent(in) titr,
type(mlaw_tag_), intent(inout) mtag,
type(submodel_data), dimension(*), intent(in) lsubmodel,
dimension(npropm), intent(inout) pm,
integer, dimension(npropmi), intent(inout) ipm,
type(matparam_struct_), intent(inout) matparam )

Definition at line 38 of file hm_read_mat97.F.

42C-----------------------------------------------
43C D e s c r i p t i o n
44C-----------------------------------------------
45C READ MAT LAW97 WITH HM READER ( TO BE COMPLETED )
46C
47C DUMMY ARGUMENTS DESCRIPTION:
48C ===================
49C
50C NAME DESCRIPTION
51C
52C PM MATERIAL ARRAY(REAL)
53C UNITAB UNITS ARRAY
54C MAT_ID MATERIAL ID(INTEGER)
55C TITR MATERIAL TITLE
56C LSUBMODEL SUBMODEL STRUCTURE
57C
58C-----------------------------------------------
59C M o d u l e s
60C-----------------------------------------------
61 USE unitab_mod
62 USE elbuftag_mod
63 USE message_mod
64 USE submodel_mod
65 USE matparam_def_mod
66 USE names_and_titles_mod , ONLY : nchartitle
67C-----------------------------------------------
68C I m p l i c i t T y p e s
69C-----------------------------------------------
70#include "implicit_f.inc"
71C-----------------------------------------------
72C C o m m o n B l o c k s
73C-----------------------------------------------
74#include "units_c.inc"
75#include "param_c.inc"
76C-----------------------------------------------
77C D u m m y A r g u m e n t s
78C-----------------------------------------------
79 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
80 my_real, INTENT(INOUT) :: pm(npropm),parmat(100),uparam(maxuparam)
81 INTEGER, INTENT(INOUT) :: IPM(NPROPMI),ISRATE,IFUNC(MAXFUNC),NFUNC,MAXFUNC,MAXUPARAM,NUPARAM, NUVAR,IMATVIS
82 TYPE(MLAW_TAG_),INTENT(INOUT) :: MTAG
83 INTEGER,INTENT(IN) :: MAT_ID
84 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
85 TYPE(SUBMODEL_DATA),INTENT(IN) :: LSUBMODEL(*)
86 TYPE(MATPARAM_STRUCT_) ,INTENT(INOUT) :: MATPARAM
87C-----------------------------------------------
88C L o c a l V a r i a b l e s
89C-----------------------------------------------
90 my_real
91 . w, d, pcj, e0, p0, c1, vcj,c,
92 . eadd, tbegin, tend, psh,rhor,rho0,
93 . a(5),
94 . r(5),
95 . al(5),
96 . bl(5),
97 . rl(5)
98 INTEGER :: IBFRAC, I
99 LOGICAL IS_AVAILABLE,IS_ENCRYPTED
100C-----------------------------------------------
101C S o u r c e L i n e s
102C-----------------------------------------------
103 is_encrypted = .false.
104 is_available = .false.
105 imatvis = 0
106 israte=0
107
108 nuvar = 5
109
110 !======== BUFFER ALLOCATION SIZES
111 mtag%G_TB = 1
112 mtag%G_TEMP = 1
113 mtag%G_BFRAC = 1
114 mtag%G_ABURN = 1
115 mtag%L_TB = 1
116 mtag%L_TEMP = 1
117 mtag%L_BFRAC = 1
118 mtag%L_ABURN = 1
119 mtag%L_SSP = 1
120 mtag%L_EINT = 1
121 mtag%G_EINT = 1
122 mtag%L_VK = 1
123
124 !======== INITIALIZATION
125 ibfrac = 0
126 psh = zero
127 p0 = zero
128 d = zero
129 pcj = zero
130 e0 = zero
131 w = zero
132 c = zero
133 a(1:5) = zero
134 r(1:5) = zero
135 al(1:5) = zero
136 bl(1:5) = zero
137 rl(1:5) = zero
138
139 !======== READING INPUT FILE ===========!
140
141 CALL hm_option_is_encrypted(is_encrypted)
142 !line-1
143 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
144 CALL hm_get_floatv('Refer_Rho' ,rhor ,is_available, lsubmodel, unitab)
145 !line-2
146 CALL hm_get_floatv('MAT_P0' , p0 ,is_available, lsubmodel, unitab)
147 CALL hm_get_floatv('MAT_PSH' , psh ,is_available, lsubmodel, unitab)
148 CALL hm_get_intv('MAT_IBFRAC' ,ibfrac ,is_available, lsubmodel)
149 !line-3
150 CALL hm_get_floatv('MLAW97_D' , d ,is_available, lsubmodel, unitab)
151 CALL hm_get_floatv('MLAW97_PCJ' , pcj ,is_available, lsubmodel, unitab)
152 CALL hm_get_floatv('MLAW97_E0' , e0 ,is_available, lsubmodel, unitab)
153 CALL hm_get_floatv('Omega' , w ,is_available, lsubmodel, unitab)
154 CALL hm_get_floatv('MLAW97_C' , c ,is_available, lsubmodel, unitab)
155 !line-4
156 CALL hm_get_floatv('MLAW97_A1' ,a(1) ,is_available, lsubmodel, unitab)
157 CALL hm_get_floatv('MLAW97_A2' ,a(2) ,is_available, lsubmodel, unitab)
158 CALL hm_get_floatv('MLAW97_A3' ,a(3) ,is_available, lsubmodel, unitab)
159 CALL hm_get_floatv('MLAW97_A4' ,a(4) ,is_available, lsubmodel, unitab)
160 CALL hm_get_floatv('MLAW97_A5' ,a(5) ,is_available, lsubmodel, unitab)
161 !line-5
162 CALL hm_get_floatv('MLAW97_R1' ,r(1) ,is_available, lsubmodel, unitab)
163 CALL hm_get_floatv('MLAW97_R2' ,r(2) ,is_available, lsubmodel, unitab)
164 CALL hm_get_floatv('MLAW97_R3' ,r(3) ,is_available, lsubmodel, unitab)
165 CALL hm_get_floatv('MLAW97_R4' ,r(4) ,is_available, lsubmodel, unitab)
166 CALL hm_get_floatv('MLAW97_R5' ,r(5) ,is_available, lsubmodel, unitab)
167 !line-6
168 CALL hm_get_floatv('MLAW97_AL1' ,al(1) ,is_available, lsubmodel, unitab)
169 CALL hm_get_floatv('MLAW97_AL2' ,al(2) ,is_available, lsubmodel, unitab)
170 CALL hm_get_floatv('MLAW97_AL3' ,al(3) ,is_available, lsubmodel, unitab)
171 CALL hm_get_floatv('MLAW97_AL4' ,al(4) ,is_available, lsubmodel, unitab)
172 CALL hm_get_floatv('MLAW97_AL5' ,al(5) ,is_available, lsubmodel, unitab)
173 !line-7
174 CALL hm_get_floatv('MLAW97_BL1' ,bl(1) ,is_available, lsubmodel, unitab)
175 CALL hm_get_floatv('MLAW97_BL2' ,bl(2) ,is_available, lsubmodel, unitab)
176 CALL hm_get_floatv('MLAW97_BL3' ,bl(3) ,is_available, lsubmodel, unitab)
177 CALL hm_get_floatv('MLAW97_BL4' ,bl(4) ,is_available, lsubmodel, unitab)
178 CALL hm_get_floatv('MLAW97_BL5' ,bl(5) ,is_available, lsubmodel, unitab)
179 !line-8
180 CALL hm_get_floatv('MLAW97_RL1' ,rl(1) ,is_available, lsubmodel, unitab)
181 CALL hm_get_floatv('MLAW97_RL2' ,rl(2) ,is_available, lsubmodel, unitab)
182 CALL hm_get_floatv('MLAW97_RL3' ,rl(3) ,is_available, lsubmodel, unitab)
183 CALL hm_get_floatv('MLAW97_RL4' ,rl(4) ,is_available, lsubmodel, unitab)
184 CALL hm_get_floatv('MLAW97_RL5' ,rl(5) ,is_available, lsubmodel, unitab)
185
186 !========== DEFAULT VALUES=============!
187 IF(rhor==zero)rhor=rho0
188 pm(1) =rhor
189 pm(89)=rho0
190
191 !========== PARAMETER CHECK============!
192 IF(w==zero)THEN
193 CALL ancmsg(
194 . msgid = 77 ,
195 . msgtype = msgerror ,
196 . anmode = aninfo_blind,
197 . i1 = mat_id
198 . )
199 ENDIF
200
201 DO i=1,5
202 IF (a(i)==zero)THEN
203 r(i)=one
204 ENDIF
205 IF(r(i)==zero)THEN
206 CALL ancmsg(
207 . msgid = 76 ,
208 . msgtype = msgerror ,
209 . anmode = aninfo_blind,
210 . i1 = mat_id
211 . )
212 ENDIF
213 ENDDO
214
215 !========== PARAMETER BACKUP===========!
216 uparam(01) = p0
217 uparam(02) = psh
218 uparam(03) = ibfrac
219 uparam(04) = d
220 uparam(05) = pcj
221 uparam(06) = e0
222 uparam(07) = w
223 uparam(08) = c
224 uparam(09:13) = a(1:5)
225 uparam(14:18) = r(1:5)
226 uparam(19:23) = al(1:5)
227 uparam(24:28) = bl(1:5)
228 uparam(29:33) = rl(1:5)
229 uparam(34) = rho0*d**2/pcj
230 vcj = one-one/uparam(34)
231 uparam(35) = vcj
232 nuparam = 35
233 nfunc = 0
234 parmat(1) = w*(pcj+e0) !RHO0*D**2
235 pm(38) = d
236
237 !P0
238 pm(31)=p0
239 pm(104)=p0
240
241 !SSP0
242 pm(27)=d
243
244 ! MATPARAM keywords
245
246 ! Material compatibility with /EOS option
247 CALL init_mat_keyword(matparam,"EOS")
248
249 ! EOS/Thermo keyword for pressure treatment in elements
250 CALL init_mat_keyword(matparam,"HYDRO_EOS")
251
252 ! Properties compatibility
253 CALL init_mat_keyword(matparam,"SOLID_ISOTROPIC")
254 CALL init_mat_keyword(matparam,"SPH")
255
256 !======== LISTING OUTPUT
257 WRITE(iout,1100) trim(titr),mat_id,97
258 WRITE(iout,1000)
259 IF(is_encrypted)THEN
260 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
261 ELSE
262 WRITE(iout,1200) rho0
263 WRITE(iout,1400) w,c,d,pcj,vcj,e0,p0,psh,ibfrac
264 WRITE(iout,1300) a(1:5)
265 WRITE(iout,1301) r(1:5)
266 WRITE(iout,1302)al(1:5)
267 WRITE(iout,1303)bl(1:5)
268 WRITE(iout,1304)rl(1:5)
269 ENDIF
270
271
272C-----------------------------------------------
273 RETURN
274C-----------------------------------------------
275
276
277 1000 FORMAT(
278 & 5x,' J.W.L.B. EXPLOSIVE ',/,
279 & 5x,' ------------------ ',//)
280 1100 FORMAT(/
281 & 5x,a,/,
282 & 5x,'MATERIAL NUMBER . . . . . . . . . . . .=',i10/,
283 & 5x,'MATERIAL LAW. . . . . . . . . . . . . .=',i10/)
284 1200 FORMAT(
285 & 5x,'INITIAL DENSITY . . . . . . . . . . . .=',1pg20.13/)
286 1300 FORMAT(
287 & 5x,'A1. . . . . . . . . . . . . . . . . . .=',e12.4/,
288 & 5x,'A2. . . . . . . . . . . . . . . . . . .=',e12.4/,
289 & 5x,'A3. . . . . . . . . . . . . . . . . . .=',e12.4/,
290 & 5x,'A4. . . . . . . . . . . . . . . . . . .=',e12.4/,
291 & 5x,'A5. . . . . . . . . . . . . . . . . . .=',e12.4//)
292 1301 FORMAT(
293 & 5x,'R1. . . . . . . . . . . . . . . . . . .=',e12.4/,
294 & 5x,'R2. . . . . . . . . . . . . . . . . . .=',e12.4/,
295 & 5x,'R3. . . . . . . . . . . . . . . . . . .=',e12.4/,
296 & 5x,'R4. . . . . . . . . . . . . . . . . . .=',e12.4/,
297 & 5x,'R5. . . . . . . . . . . . . . . . . . .=',e12.4//)
298 1302 FORMAT(
299 & 5x,'AL1 . . . . . . . . . . . . . . . . . .=',e12.4/,
300 & 5x,'AL2 . . . . . . . . . . . . . . . . . .=',e12.4/,
301 & 5x,'AL3 . . . . . . . . . . . . . . . . . .=',e12.4/,
302 & 5x,'AL4 . . . . . . . . . . . . . . . . . .=',e12.4/,
303 & 5x,'AL5 . . . . . . . . . . . . . . . . . .=',e12.4//)
304 1303 FORMAT(
305 & 5x,'BL1 . . . . . . . . . . . . . . . . . .=',e12.4/,
306 & 5x,'BL2 . . . . . . . . . . . . . . . . . .=',e12.4/,
307 & 5x,'BL3 . . . . . . . . . . . . . . . . . .=',e12.4/,
308 & 5x,'BL4 . . . . . . . . . . . . . . . . . .=',e12.4/,
309 & 5x,'BL5 . . . . . . . . . . . . . . . . . .=',e12.4//)
310 1304 FORMAT(
311 & 5x,'RL1 . . . . . . . . . . . . . . . . . .=',e12.4/,
312 & 5x,'RL2 . . . . . . . . . . . . . . . . . .=',e12.4/,
313 & 5x,'RL3 . . . . . . . . . . . . . . . . . .=',e12.4/,
314 & 5x,'RL4 . . . . . . . . . . . . . . . . . .=',e12.4/,
315 & 5x,'RL5 . . . . . . . . . . . . . . . . . .=',e12.4//)
316 1400 FORMAT(
317 & 5x,'OMEGA . . . . . . . . . . . . . . . . .=',e12.4/,
318 & 5x,'C PARAMETER . . . . . . . . . . . . . .=',e12.4/,
319 & 5x,'DETONATION VELOCITY . . . . . . . . . .=',e12.4/,
320 & 5x,'CHAPMAN JOUGUET PRESSURE. . . . . . . .=',e12.4/,
321 & 5x,'CHAPMAN JOUGUET VOLUME. . . . . . . . .=',e12.4/,
322 & 5x,'INITIAL ENERGY PER UNIT VOLUME. . . . .=',e12.4/,
323 & 5x,'INITIAL PRESSURE. . . . . . . . . . . .=',e12.4/,
324 & 5x,'PRESSURE SHIFT. . . . . . . . . . . . .=',e12.4/,
325 & 5x,'BURN FRACTION METHOD. . . . . . . . . .=',i10/)
326
327
328
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:284
init_mat_keyword
subroutine init_mat_keyword(matparam, keyword)
Definition init_mat_keyword.F:150
elbuftag_mod
Definition elbuftag_mod.F:227
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
ancmsg
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:889