OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat05.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| hm_read_mat05 ../starter/source/materials/mat/mat005/hm_read_mat05.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_mat ../starter/source/materials/mat/hm_read_mat.F90
27!||--- calls -----------------------------------------------------
28!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
29!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
30!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.f
31!|| init_mat_keyword ../starter/source/materials/mat/init_mat_keyword.F
32!||--- uses -----------------------------------------------------
33!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
34!|| message_mod ../starter/share/message_module/message_mod.F
35!|| submodel_mod ../starter/share/modules1/submodel_mod.F
36!||====================================================================
37 SUBROUTINE hm_read_mat05(UPARAM ,MAXUPARAM,NUPARAM ,ISRATE , IMATVIS ,
38 . NUVAR ,IFUNC ,MAXFUNC ,NFUNC , PARMAT ,
39 . UNITAB ,MAT_ID ,TITR ,MTAG , LSUBMODEL,
40 . PM ,IPM ,UID ,MATPARAM )
41C-----------------------------------------------
42C D e s c r i p t i o n
43C-----------------------------------------------
44C READ MAT LAW05 WITH HM READER
45C
46C DUMMY ARGUMENTS DESCRIPTION:
47C ===================
48C
49C NAME DESCRIPTION
50C
51C PM MATERIAL ARRAY(REAL)
52C UNITAB UNITS ARRAY
53C ID MATERIAL ID(INTEGER)
54C TITR MATERIAL TITLE
55C LSUBMODEL SUBMODEL STRUCTURE
56C
57C-----------------------------------------------
58C M o d u l e s
59C-----------------------------------------------
60 USE elbuftag_mod
61 USE message_mod
62 USE submodel_mod
63 USE matparam_def_mod
64 USE unitab_mod
65 USE names_and_titles_mod , ONLY : nchartitle
66C-----------------------------------------------
67C I m p l i c i t T y p e s
68C-----------------------------------------------
69#include "implicit_f.inc"
70C-----------------------------------------------
71C C o m m o n B l o c k s
72C-----------------------------------------------
73#include "units_c.inc"
74#include "param_c.inc"
75C-----------------------------------------------
76C D u m m y A r g u m e n t s
77C-----------------------------------------------
78 my_real, INTENT(INOUT) :: pm(npropm),parmat(100),uparam(maxuparam)
79 INTEGER, INTENT(INOUT) :: IPM(NPROPMI),ISRATE,IFUNC(MAXFUNC),NFUNC,MAXFUNC,MAXUPARAM,NUPARAM, NUVAR,IMATVIS
80 INTEGER, INTENT(IN) :: UID
81 TYPE(mlaw_tag_),INTENT(INOUT) :: MTAG
82 INTEGER,INTENT(IN) :: MAT_ID
83 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
84 TYPE(unit_type_), INTENT(IN) :: UNITAB
85 TYPE(submodel_data),INTENT(IN) :: LSUBMODEL(NSUBMOD)
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 . a, b, r1, r2, w, d, pcj, e0, c0, c1, vcj,
92 . eadd, tbegin, tend,
93 . psh,reaction_rate,reaction_rate2,a_mil,m_mil,n_mil,alpha_unit,
94 . bid, val(5), bulk
95 INTEGER :: IBFRAC, QOPT, I_ERROR, IFLAGUNIT, J
96 my_real :: RHO0, RHOR
97 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
98C-----------------------------------------------
99C S o u r c e L i n e s
100C-----------------------------------------------
101 ipm(4) = 15 ! internal EOS TYPE
102! MATPARAM%IEOS = 15
103 tbegin = zero
104 tend = infinity
105 ibfrac = 0
106 psh = zero
107 c0 = zero
108 eadd = zero
109 reaction_rate = zero
110 reaction_rate2 = zero
111 a_mil = zero
112 m_mil = zero
113 n_mil = zero
114 alpha_unit = zero
115 bid = zero
116 i_error = 0
117 val(1:5) = zero
118 bulk = zero
119
120 is_encrypted = .false.
121 is_available = .false.
122 israte = 0
123 imatvis = 0
124
125 !unit needed for millers extension
126 iflagunit = 0
127 DO j=1,unitab%NUNITS
128 IF (unitab%UNIT_ID(j) == uid) THEN
129 iflagunit = 1
130 EXIT
131 ENDIF
132 ENDDO
133
134 !======== READING INPUT FILE ===========!
135 CALL hm_option_is_encrypted(is_encrypted)
136 !line+1
137 CALL hm_get_floatv('MAT_RHO', rho0, is_available, lsubmodel, unitab)
138 CALL hm_get_floatv('Refer_Rho', rhor, is_available, lsubmodel, unitab)
139 !line-2
140 CALL hm_get_floatv('MAT_A', a, is_available, lsubmodel, unitab)
141 CALL hm_get_floatv('MAT_B', b, is_available, lsubmodel, unitab)
142 CALL hm_get_floatv('MAT_PDIR1', r1, is_available, lsubmodel, unitab)
143 CALL hm_get_floatv('MAT_PDIR2', r2, is_available, lsubmodel, unitab)
144 CALL hm_get_floatv('Omega', w, is_available, lsubmodel, unitab)
145 !line-3
146 CALL hm_get_floatv('MAT_D', d, is_available, lsubmodel, unitab)
147 CALL hm_get_floatv('MAT_PC', pcj, is_available, lsubmodel, unitab)
148 CALL hm_get_floatv('MAT_E0', e0, is_available, lsubmodel, unitab)
149 CALL hm_get_floatv('MAT_E', eadd, is_available, lsubmodel, unitab)
150 CALL hm_get_intv('MAT_IBFRAC', ibfrac, is_available, lsubmodel)
151 CALL hm_get_intv('QOPT', qopt, is_available, lsubmodel)
152
153 IF(qopt < 0 .OR. qopt > 3)THEN
154 qopt = 0
155 ENDIF
156
157 !line-4
158 CALL hm_get_floatv('LAW5_P0', c0, is_available, lsubmodel, unitab)
159 CALL hm_get_floatv('LAW5_PSH', psh, is_available, lsubmodel, unitab)
160 CALL hm_get_floatv('BUNREACTED', bulk, is_available, lsubmodel, unitab)
161
162 !-----AFTERBURNING
163 IF((qopt == 0 .OR. qopt == 1 .OR. qopt == 2) .AND. eadd > 0)THEN
164 !line-4
165 CALL hm_get_floatv('TSTART', tbegin, is_available, lsubmodel, unitab)
166 CALL hm_get_floatv('TSTOP', tend, is_available, lsubmodel, unitab)
167 IF(tend==zero) tend=infinity
168 IF(eadd>zero)THEN
169 IF(tbegin==tend)THEN
170 !Dirac function release : this means instantaneous
171 qopt = 0
172 ENDIF
173 ENDIF
174 ELSEIF(qopt == 3 .AND. eadd > 0)THEN
175 CALL hm_get_floatv('LAW5_A', a_mil, is_available, lsubmodel, unitab)
176 CALL hm_get_floatv('LAW5_M', m_mil, is_available, lsubmodel, unitab)
177 CALL hm_get_floatv('LAW5_N', n_mil, is_available, lsubmodel, unitab)
178 ENDIF
179
180 !========AFTERBURNING REACTION RATE===========!
181 reaction_rate = zero
182 reaction_rate2 = zero
183 SELECT CASE(qopt)
184 CASE(0)
185 !---INSTANTANEOUS
186 reaction_rate = zero
187 reaction_rate2 = zero
188 CASE(1)
189 !---CONSTANT AFTERBURNING RATE
190 reaction_rate = one/(tend-tbegin)
191 reaction_rate2 = zero
192 CASE(2)
193 !---LINEAR AFTERBURNING RATE
194 reaction_rate = two/(tend-tbegin)**2
195 reaction_rate2 = tbegin**2/(tend-tbegin)**2
196 CASE(3)
197 !---MILLER S EXTENSION
198 reaction_rate = zero
199 reaction_rate2 = zero
200 IF(alpha_unit == zero)alpha_unit=one
201 CASE DEFAULT
202 !CLASSICAL MODEL
203 eadd = zero
204 reaction_rate = zero
205 END SELECT
206
207 !========C1: EQUIVALENT MODULE FOR INTERFACE RIGIDITIES
208 IF(bulk>zero)THEN
209 c1 = bulk
210 ELSE
211 c1 = w*(pcj+e0)
212 ENDIF
213
214 !---DEFAULT VALUES
215 IF(rhor == zero)rhor=rho0
216 pm(01) = rhor
217 pm(89) = rho0
218 !========STORAGE
219 pm(23) = e0
220 pm(31) = c0-psh
221 pm(32) = c1
222 pm(33) = a
223 pm(34) = b
224 pm(35) = r1
225 pm(36) = r2
226 pm(37) = -psh
227 pm(45) = w
228 pm(38) = d
229 pm(39) = pcj
230 pm(40) = pm(1)*d**2/pcj
231 pm(41) = ibfrac
232 pm(42) = qopt
233 pm(43) = c0
234 pm(44) = bulk
235 vcj = one-one/pm(40)
236 pm(104) = c0-psh
237 pm(160) = eadd
238 pm(161) = tbegin
239 pm(162) = tend
240 pm(163) = reaction_rate
241 pm(164) = a_mil
242 pm(165) = m_mil
243 pm(166) = n_mil
244 pm(167) = reaction_rate2
245 pm(168) = alpha_unit
246 pm(88) = psh
247 !ssp0
248 pm(27) = d
249
250 !======== BUFFER ALLOCATION SIZES
251 mtag%G_TB = 1
252 mtag%G_TEMP = 1
253 mtag%G_BFRAC = 1
254 mtag%G_ABURN = 1
255 mtag%L_TB = 1
256 mtag%L_TEMP = 1
257 mtag%L_BFRAC = 1
258 mtag%L_ABURN = 1
259
260 !======== MATPARAM KEYWORDS
261 ! EOS/Thermo keyword
262 CALL init_mat_keyword(matparam,"HYDRO_EOS")
263 ! Properties compatibility
264 CALL init_mat_keyword(matparam,"SOLID_ISOTROPIC")
265 CALL init_mat_keyword(matparam,"SPH")
266
267 !======== LISTING OUTPUT
268 WRITE(iout,1001) trim(titr),mat_id,5
269 WRITE(iout,1000)
270 IF(is_encrypted)THEN
271 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
272 ELSE
273 WRITE(iout,1002)rho0,rhor
274 WRITE(iout,1300)a,b,r1,r2,w
275 WRITE(iout,1400)d,pcj,vcj,e0,c0,psh,bulk,ibfrac
276 !AFTERBURNING OPTIONAL MODEL
277 IF(eadd == zero) THEN
278 WRITE(iout,1500)
279 ELSE
280 IF(qopt == 0) THEN
281 WRITE(iout,1504)eadd,tbegin
282 ELSEIF(qopt == 1) THEN
283 WRITE(iout,1501)eadd,tbegin,tend
284 ELSEIF(qopt == 2) THEN
285 WRITE(iout,1502)eadd,tbegin,tend
286 ELSEIF(qopt == 3) THEN
287 WRITE(iout,1503)eadd,a_mil,m_mil,n_mil, alpha_unit
288 ENDIF
289 ENDIF
290 ENDIF
291
292 RETURN
293 1000 FORMAT(
294 & 5x,' J.W.L. EXPLOSIVE ',/,
295 & 5x,' ---------------- ',//)
296 1001 FORMAT(
297 & 5x,a,/,
298 & 5x,'MATERIAL NUMBER . . . . . . . . . . . . =',i10/,
299 & 5x,'MATERIAL LAW. . . . . . . . . . . . . . =',i10/)
300 1002 FORMAT(
301 & 5x,'INITIAL DENSITY . . . . . . . . . . . . =',1pg20.13/,
302 & 5x,'REFERENCE DENSITY . . . . . . . . . . . =',1pg20.13/)
303 1300 FORMAT(
304 & 5x,'A . . . . . . . . . . . . . . . . . . .=',e12.4/,
305 & 5x,'B . . . . . . . . . . . . . . . . . . .=',e12.4/,
306 & 5x,'R1. . . . . . . . . . . . . . . . . . .=',e12.4/,
307 & 5x,'R2. . . . . . . . . . . . . . . . . . .=',e12.4/,
308 & 5x,'W . . . . . . . . . . . . . . . . . . .=',e12.4//)
309 1400 FORMAT(
310 & 5x,'DETONATION VELOCITY . . . . . . . . . .=',e12.4/,
311 & 5x,'CHAPMAN JOUGUET PRESSURE. . . . . . . .=',e12.4/,
312 & 5x,'CHAPMAN JOUGUET VOLUME. . . . . . . . .=',e12.4/,
313 & 5x,'INITIAL ENERGY PER UNIT VOLUME. . . . .=',e12.4/,
314 & 5x,'INITIAL PRESSURE OF UNREACTED EXPLO.. .=',e12.4/,
315 & 5x,'PRESSURE SHIFT. . . . . . . . . . . . .=',e12.4/,
316 & 5x,'UNREACTED EXPLOSIVE BULK MODULUS. . . .=',e12.4/,
317 & 5x,'BURN FRACTION METHOD. . . . . . . . . .=',i12/)
318 1500 FORMAT(
319 & 5x,'NO AFTERBURNING MODELING '//)
320 1501 FORMAT(
321 & 5x,'AFTERBURNING MODEL : CONSTANT REACTION RATE ',/,
322 & 5x,'ADDITIONAL ENERGY PER UNIT VOLUME . . .=',e12.4/,
323 & 5x,'BEGIN TIME. . . . . . . . . . . . . . .=',e12.4/,
324 & 5x,'END TIME. . . . . . . . . . . . . . . .=',e12.4//)
325 1502 FORMAT(
326 & 5x,'AFTERBURNING : LINEAR REACTION RATE ',/,
327 & 5x,'ADDITIONAL ENERGY PER UNIT VOLUME . . .=',e12.4/,
328 & 5x,'BEGIN TIME. . . . . . . . . . . . . . .=',e12.4/,
329 & 5x,'END TIME. . . . . . . . . . . . . . . .=',e12.4//)
330 1503 FORMAT(
331 & 5x,'AFTERBURNING : MILLER S EXTENSION ',/,
332 & 5x,'ADDITIONAL ENERGY PER UNIT VOLUME . . .=',e12.4/,
333 & 5x,'a PARAMETER . . . . . . . . . . . . . .=',e12.4/,
334 & 5x,'m PARAMETER . . . . . . . . . . . . . .=',e12.4/,
335 & 5x,'n PARAMETER . . . . . . . . . . . . . .=',e12.4/,
336 & 5x,'PRESSURE TRANSLATION FACTOR . . . . . .=',e12.4//)
337 1504 FORMAT(
338 & 5x,'AFTERBURNING : INSTANTANEOUS ',/,
339 & 5x,'ADDITIONAL ENERGY PER UNIT VOLUME . . .=',e12.4/,
340 & 5x,'BEGIN TIME. . . . . . . . . . . . . . .=',e12.4//)
341 RETURN
342 END
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:418
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:288
hm_read_mat05
subroutine hm_read_mat05(uparam, maxuparam, nuparam, israte, imatvis, nuvar, ifunc, maxfunc, nfunc, parmat, unitab, mat_id, titr, mtag, lsubmodel, pm, ipm, uid, matparam)
Definition hm_read_mat05.F:41
init_mat_keyword
subroutine init_mat_keyword(matparam, keyword)
Definition init_mat_keyword.F:153
elbuftag_mod
Definition elbuftag_mod.F:230
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
starter
program starter
Definition starter.F:39
elbuftag_mod::mlaw_tag_
Definition elbuftag_mod.F:235
submodel_mod::submodel_data
Definition submodel_mod.F:728
unitab_mod::unit_type_
Definition unitab_mod.F:524