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
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-----------------------------------------------
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 :: IBID, 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.OR..OR..AND. IF((QOPT == 0 QOPT == 1 QOPT == 2) 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.AND. ELSEIF(QOPT == 3 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: MODULE EQUIVALENT POUR LES RIGIDITES D'interfaces
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
#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)
subroutine hm_read_mat05(uparam, maxuparam, nuparam, israte, imatvis, nuvar, ifunc, maxfunc, nfunc, parmat, unitab, mat_id, titr, mtag, lsubmodel, pm, ipm, uid, matparam)
subroutine init_mat_keyword(matparam, keyword)
integer, parameter nchartitle