40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
86 USE matparam_def_mod
89
90
91
92#include "implicit_f.inc"
93
94
95
96#include "param_c.inc"
97#include "units_c.inc"
98
99
100
101 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
102 INTEGER,INTENT(IN) :: MAXUPARAM,MAXFUNC,IFUNC(MAXFUNC)
103 INTEGER,INTENT(INOUT) :: NUPARAM,NFUNC,NUVAR
104 my_real,
INTENT(INOUT) :: uparam(maxuparam),stifint
105 INTEGER,INTENT(IN) :: ID
106 CHARACTER(LEN=NCHARTITLE),INTENT(IN) :: TITR
107 TYPE(SUBMODEL_DATA),INTENT(IN) ::LSUBMODEL(*)
108 my_real,
INTENT(INOUT) :: pm(npropm)
109 TYPE(MATPARAM_STRUCT_) ,INTENT(INOUT) :: MATPARAM
110 TYPE(MLAW_TAG_),INTENT(INOUT) :: MTAG
111
112
113
114 INTEGER ITER,IREAC
115 my_real ar, br, r1r, r2r, r3r, wr,
116 . ap, bp, r1p, r2p, r3p, wp_coeff,
117 . cvr, cvp,
118 . enq, epsilon, ftol, i_, b_, x_, g1, d_, y_, cappa, chi, tol,
119 . ccrit, g2, c_, e_, g_, z_, figmax, fg1max, fg2min, shr, t,
120 . rho0, rhor
121 LOGICAL :: IS_ENCRYPTED, IS_AVAILABLE
122
123
124
125 is_encrypted = .false.
127 nuparam = 40
128
129
130 mtag%G_BFRAC = 1
131 mtag%L_BFRAC = 1
132 mtag%G_TEMP = 1
133 mtag%L_TEMP = 1
134
135
136 CALL hm_get_floatv(
'MAT_RHO', rho0, is_available, lsubmodel, unitab)
137 CALL hm_get_floatv(
'Refer_Rho', rhor, is_available, lsubmodel, unitab)
138
139 IF (rhor == zero) THEN
140 rhor = rho0
141 ENDIF
142 pm(1) = rhor
143 pm(89) = rho0
144
145 CALL hm_get_intv(
'Ireac', ireac, is_available, lsubmodel)
146
147 CALL hm_get_floatv(
'a_r', ar, is_available, lsubmodel, unitab)
148 CALL hm_get_floatv(
'b_r', br, is_available, lsubmodel, unitab)
149 CALL hm_get_floatv(
'r_1r', r1r, is_available, lsubmodel, unitab)
150 CALL hm_get_floatv(
'r_2r', r2r, is_available, lsubmodel, unitab)
151 CALL hm_get_floatv(
'r_3r', r3r, is_available, lsubmodel, unitab)
152
153 CALL hm_get_floatv(
'a_p', ap, is_available, lsubmodel, unitab)
154 CALL hm_get_floatv(
'b_p', bp, is_available, lsubmodel, unitab)
155 CALL hm_get_floatv(
'r_1p', r1p, is_available, lsubmodel, unitab)
156 CALL hm_get_floatv(
'r_2p', r2p, is_available, lsubmodel, unitab)
157 CALL hm_get_floatv(
'r_3p', r3p, is_available, lsubmodel, unitab)
158
159 CALL hm_get_floatv(
'C_vr', cvr, is_available, lsubmodel, unitab)
160 CALL hm_get_floatv(
'C_vp', cvp, is_available, lsubmodel, unitab)
161 CALL hm_get_floatv(
'enq', enq, is_available, lsubmodel, unitab)
162
163 CALL hm_get_intv(
'NITRS', iter, is_available, lsubmodel)
164 CALL hm_get_floatv(
'Epsilon_0', epsilon, is_available, lsubmodel, unitab)
165 CALL hm_get_floatv(
'ftol', ftol, is_available, lsubmodel, unitab)
166
167 CALL hm_get_floatv(
'I_', i_, is_available, lsubmodel, unitab)
169 CALL hm_get_floatv(
'x_', x_, is_available, lsubmodel, unitab)
170
171 CALL hm_get_floatv(
'g1', g1, is_available, lsubmodel, unitab)
172 CALL hm_get_floatv(
'd_', d_, is_available, lsubmodel, unitab)
173 CALL hm_get_floatv(
'y_', y_, is_available, lsubmodel, unitab)
174 CALL hm_get_floatv(
'c_', c_, is_available, lsubmodel, unitab)
175
176 CALL hm_get_floatv(
'Kn', cappa, is_available, lsubmodel, unitab
177 CALL hm_get_floatv(
'chi', chi, is_available, lsubmodel, unitab)
178 CALL hm_get_floatv(
'MAT_Tol', tol, is_available, lsubmodel, unitab)
179
180 CALL hm_get_floatv(
'g2', g2, is_available, lsubmodel, unitab)
181 CALL hm_get_floatv(
'e_', e_, is_available, lsubmodel, unitab)
182 CALL hm_get_floatv(
'g_', g_, is_available, lsubmodel, unitab)
183 CALL hm_get_floatv(
'z_', z_, is_available, lsubmodel, unitab)
184
185 CALL hm_get_floatv(
'ccrit', ccrit, is_available, lsubmodel, unitab)
186 CALL hm_get_floatv(
'figmax', figmax, is_available, lsubmodel, unitab)
187 CALL hm_get_floatv(
'fg1max', fg1max, is_available, lsubmodel, unitab)
188 CALL hm_get_floatv(
'fg2min', fg2min, is_available, lsubmodel, unitab)
189
190 CALL hm_get_floatv(
'MAT_G0', shr, is_available, lsubmodel, unitab)
191 CALL hm_get_floatv(
'T_Initial', t, is_available, lsubmodel, unitab)
192
193
194
195
196
197
198
199 IF(ireac/=1 .AND. ireac /=2)ireac=1
200 wr = r3r/cvr
201 wp_coeff = r3p/cvp
202 IF (epsilon==zero) epsilon = em3
203 IF (iter==0) iter = 80
204 IF (ftol==zero) ftol = em5
205 IF (cappa==zero) cappa = eighty19
206 IF (chi==zero) chi = eighty19
207 nfunc = 0
208 nuvar = 8
209 stifint = shr
210
211
212
213
214 uparam(1) = ireac
215 uparam(2) = ar
216 uparam(3) = br
217 uparam(4) = r1r
218 uparam(5) = r2r
219 uparam(6) = r3r
220 uparam(7) = wr
221 uparam(8) = ap
222 uparam(9) = bp
223 uparam(10) = r1p
224 uparam(11) = r2p
225 uparam(12) = r3p
226 uparam(13) = wp_coeff
227 uparam(14) = cvr
228 uparam(15) = cvp
229 uparam(16) = enq
230 uparam(17) = epsilon
231 uparam(18) = iter
232 uparam(19) = ftol
233 uparam(20) = i_
234 uparam(21) = b_
235 uparam(22) = x_
236 uparam(23) = g1
237 uparam(24) = d_
238 uparam(25) = y_
239 uparam(31) = c_
240 uparam(26) = cappa
241 uparam(27) = chi
242 uparam(28) = tol
243 uparam(32) = e_
244 uparam(33) = g_
245 uparam(34) = z_
246 uparam(30) = g2
247 uparam(29) = ccrit
248 uparam(35) = figmax
249 uparam(36) = fg1max
250 uparam(37) = fg2min
251 uparam(38) = shr
252 uparam(39) = t
253 uparam(40) = zero
254
256
257
259
260
262
263
266
267
268
269
270 IF(is_encrypted)THEN
271 WRITE(iout,7000)
272 ELSE
273 WRITE(iout,1000)uparam(1), uparam(2), uparam(3),
274 . uparam(4), uparam(5), uparam(6), uparam(7),
275 . uparam(8), uparam(9), uparam(10), uparam(11),
276 . uparam(12), uparam(13), uparam(14), uparam(15),
277 . uparam(16), uparam(17), uparam(18), uparam(19),
278 . uparam(20), uparam(21), uparam(22), uparam(23),
279 . uparam(24), uparam(25), uparam(26), uparam(27),
280 . uparam(28), uparam(29), uparam(31), uparam(30),
281 . uparam(32), uparam(33), uparam(34), uparam(35),
282 . uparam(36), uparam(37), uparam(38), uparam(39)
283 ENDIF
284
285 7000 FORMAT(
286 & 5x,' LEE TARVER REACTIVE EXPLOSIVE ',/,
287 & 5x,' ----------------------------- ',/,
288 & 5x, 'CONFIDENTIAL DATA'//)
289 1000 FORMAT(
290 & 5x,' LEE TARVER REACTIVE EXPLOSIVE ',/,
291 & 5x,' ----------------------------- ',/,
292 & 5x,'IREAC FLAG. . . . . . . . . . . . . . . =',1pg20.13/,
293 & 5x, ' 1:ORIGINAL 2-TERM-MODEL (1980) ',/,
294 & 5x, ' 2:EXTENDED 3-TERM-MODEL (1985) ',/,
295 & 5x,' REACTIVES JWL EQUATION OF STATES : ',/,
296 & 5x,'AR COEFFICIENT. . . . . . . . . . . . . =',1pg20.13/,
297 & 5x,'BR COEFFICIENT. . . . . . . . . . . . . =',1pg20.13/,
298 & 5x,'R1R COEFFICIENT . . . . . . . . . . . . =',1pg20.13/,
299 & 5x,'R2R COEFFICIENT . . . . . . . . . . . . =',1pg20.13/,
300 & 5x,'R3R COEFFICIENT . . . . . . . . . . . . =',1pg20.13/,
301 & 5x,'WR COEFFICIENT. . . . . . . . . . . . . =',1pg20.13/,
302 & 5x,' PRODUCTS JWL EQUATION OF STATES : ',/,
303 & 5x,'AP COEFFICIENT. . . . . . . . . . . . . =',1pg20.13/,
304 & 5x,'BP COEFFICIENT. . . . . . . . . . . . . =',1pg20.13/,
305 & 5x,'R1P COEFFICIENT . . . . . . . . . . . . =',1pg20.13/,
306 & 5x,'R2P COEFFICIENT . . . . . . . . . . . . =',1pg20.13/,
307 & 5x,'R3P COEFFICIENT . . . . . . . . . . . . =',1pg20.13/,
308 & 5x,'WP COEFFICIENT. . . . . . . . . . . . . =',1pg20.13/,
309 & /,
310 & 5x,'CVR REACTIVE SPECIFIC HEAT. . . . . . . =',1pg20.13/,
311 & 5x,'CVP PRODUCTS SPECIFIC HEAT. . . . . . . =',1pg20.13/,
312 & 5x,'ENQ REACTION ENERGY . . . . . . . . . . =',1pg20.13/,
313 & /,
314 & 5x,'EPSILON . . . . . . . . . . . . . . . . =',1pg20.13/,
315 & 5x,'MAXIMUM NUMBER OF ITERATIONS. . . . . . =',1pg20.13/,
316 & 5x,'FTOL . . . . . . . . . . . . . . . . . =',1pg20.13/,
317 & 5x,' KINETICAL PARAMETERS : ',/,
318 & 5x,' IGNITION TERM : ',/,
319 & 5x,'I COEFFICIENT . . . . . . . . . . . . . =',1pg20.13/,
320 & 5x,'b COEFFICIENT . . . . . . . . . . . . . =',1pg20.13/,
321 & 5x,'x COEFFICIENT . . . . . . . . . . . . . =',1pg20.13/,
322 & 5x,' GROWTH TERM 1 : ',/,
323 & 5x,'G1 COEFFICIENT . . . . . . . . . . . . =',1pg20.13/,
324 & 5x,'d COEFFICIENT . . . . . . . . . . . . . =',1pg20.13/,
325 & 5x,'y COEFFICIENT . . . . . . . . . . . . . =',1pg20.13/,
326 & 5x,' NUMERICAL LIMITORS ',/,
327 & 5x,'CAPPA . . . . . . . . . . . . . . . . . =',1pg20.13/,
328 & 5x,'CHI . . . . . . . . . . . . . . . . . . =',1pg20.13/,
329 & 5x,'TOL . . . . . . . . . . . . . . . . . . =',1pg20.13/,
330 & 5x,'a COEFFICIENT . . . . . . . . . . . . . =',1pg20.13/,
331 & 5x,' GROWTH TERM 2 ',/,
332 & 5x,'c COEFFICIENT . . . . . . . . . . . . . =',1pg20.13/,
333 & 5x,'G2 COEFFICIENT. . . . . . . . . . . . . =',1pg20.13/,
334 & 5x,'e COEFFICIENT . . . . . . . . . . . . . =',1pg20.13/,
335 & 5x,'g COEFFICIENT . . . . . . . . . . . . . =',1pg20.13/,
336 & 5x,'z COEFFICIENT . . . . . . . . . . . . . =',1pg20.13/,
337 & /,
338 & 5x,'Figmax (LIMITER FOR IGNITIONT TERM) . . =',1pg20.13/,
339 & 5x,'FG1max (LIMITER FOR GROWTH TERM 1). . . =',1pg20.13/,
340 & 5x,'FG2min (LIMITER FOR GROWTH TERM 2). . . =',1pg20.13/,
341 & /,
342 & 5x,'SHEAR MODULUS . . . . . . . . . . . . . =',1pg20.13/,
343 & 5x,'INITIAL TEMPERATURE (K) . . . . . . . . =',1pg20.13//)
344
345
346 RETURN
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 init_mat_keyword(matparam, keyword)
integer, parameter nchartitle