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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_mat16 (mtag, pm, mat_id, titr, ipm, lsubmodel, unitab, matparam)

Function/Subroutine Documentation

◆ hm_read_mat16()

subroutine hm_read_mat16 ( type(mlaw_tag_), intent(inout) mtag,
intent(inout) pm,
integer, intent(in) mat_id,
character(len=nchartitle), intent(in) titr,
integer, dimension(npropmi), intent(inout) ipm,
type(submodel_data), dimension(nsubmod), intent(in) lsubmodel,
type(unit_type_), intent(in) unitab,
type(matparam_struct_), intent(inout) matparam )

Definition at line 38 of file hm_read_mat16.F.

41C-----------------------------------------------
42C FAC_M FACL FAC_T : enable to convert (custom) input unit to working unit system
43C FAC_MASS, FAC_LENGTH, FAC_TIME : enable to convert working unit system into International Unit system
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE elbuftag_mod
48 USE message_mod
49 USE submodel_mod
50 USE matparam_def_mod
51 USE unitab_mod
52 USE names_and_titles_mod , ONLY : nchartitle
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "param_c.inc"
61#include "units_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
66 INTEGER, INTENT(IN) :: MAT_ID
67 INTEGER, DIMENSION(NPROPMI) ,INTENT(INOUT) :: IPM
68 my_real, DIMENSION(NPROPM) ,INTENT(INOUT) :: pm
69 TYPE(UNIT_TYPE_) ,INTENT(IN) :: UNITAB
70 TYPE(SUBMODEL_DATA), DIMENSION(NSUBMOD),INTENT(IN) :: LSUBMODEL
71 TYPE(MLAW_TAG_), INTENT(INOUT) :: MTAG
72 TYPE(MATPARAM_STRUCT_) ,INTENT(INOUT) :: MATPARAM
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER ILAW,J
77 my_real
78 . young, anu, ca, cb, cn, epsm, sigm, c0, c, s, gam0, a, aw,
79 . pmin, e0, cc, eps0, cm, tmelt, tmax, gam0m, am, game, ge, ds,
80 . tm0, vj, vb, unit, e0h, ay, thet, g, rho, alpha, r, xm, rp3,
81 . gp, dsp, alphap, rp, pcc, e00, apy, xj, x, zj, e0j, xp, tmj,
82 . xlamj, d1, d2, d3, e, g0ax, p1j, c1, c2, c3,eps0_unit,ener_unit,ds_unit,
83 . fac_m_bb,fac_l_bb,fac_t_bb,rho0, rhor
84 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
85C-----------------------------------------------
86!
87 ilaw = 16
88 is_encrypted = .false.
89 is_available = .false.
90!-----------------------
91 CALL hm_option_is_encrypted(is_encrypted)
92!-----------------------
93! LINE 1
94 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
95 CALL hm_get_floatv('Refer_Rho' ,rhor ,is_available, lsubmodel, unitab)
96! LINE 2
97 CALL hm_get_floatv('MAT_E' ,young ,is_available, lsubmodel, unitab)
98 CALL hm_get_floatv('MAT_NU' ,anu ,is_available, lsubmodel, unitab)
99! LINE 3
100 CALL hm_get_floatv('MAT_SIGY' ,ca ,is_available, lsubmodel, unitab)
101 CALL hm_get_floatv('MAT_BETA' ,cb ,is_available, lsubmodel, unitab)
102 CALL hm_get_floatv('MAT_HARD' ,cn ,is_available, lsubmodel, unitab)
103 CALL hm_get_floatv('MAT_EPS' ,epsm ,is_available, lsubmodel, unitab)
104 CALL hm_get_floatv('MAT_SIG' ,sigm ,is_available, lsubmodel, unitab)
105! LINE 4
106 CALL hm_get_floatv('MAT_P0' ,c0 ,is_available, lsubmodel, unitab)
107 CALL hm_get_floatv('MAT_C' ,c ,is_available, lsubmodel, unitab)
108 CALL hm_get_floatv('MAT_S' ,s ,is_available, lsubmodel, unitab)
109 CALL hm_get_floatv('MAT_GAMA0' ,gam0 ,is_available, lsubmodel, unitab)
110 CALL hm_get_floatv('MAT_A' ,a ,is_available, lsubmodel, unitab)
111! LINE 5
112 CALL hm_get_floatv('MAT_AW' ,aw ,is_available, lsubmodel, unitab)
113 CALL hm_get_floatv('MAT_PC' ,pmin ,is_available, lsubmodel, unitab)
114 CALL hm_get_floatv('MAT_E0' ,e0 ,is_available, lsubmodel, unitab)
115! LINE 6
116 CALL hm_get_floatv('MAT_SRC' ,cc ,is_available, lsubmodel, unitab)
117 CALL hm_get_floatv('MAT_SRP' ,eps0 ,is_available, lsubmodel, unitab)
118 CALL hm_get_floatv('MAT_M' ,cm ,is_available, lsubmodel, unitab)
119 CALL hm_get_floatv('MAT_TMELT' ,tmelt ,is_available, lsubmodel, unitab)
120 CALL hm_get_floatv('MAT_TMAX' ,tmax ,is_available, lsubmodel, unitab)
121! LINE 7
122 CALL hm_get_floatv('MAT_GAMAm' ,gam0m ,is_available, lsubmodel, unitab)
123 CALL hm_get_floatv('Acoeft1' ,am ,is_available, lsubmodel, unitab)
124 CALL hm_get_floatv('GAMMA' ,game ,is_available, lsubmodel, unitab)
125 CALL hm_get_floatv('MAT_G0' ,ge ,is_available, lsubmodel, unitab)
126 CALL hm_get_floatv('MAT_dS' ,ds ,is_available, lsubmodel, unitab)
127! LINE 8
128 CALL hm_get_floatv('T_melt_0' ,tm0 ,is_available, lsubmodel, unitab)
129 CALL hm_get_floatv('MAT_VOL' ,vj ,is_available, lsubmodel, unitab)
130 CALL hm_get_floatv('MAT_Vb' ,vb ,is_available, lsubmodel, unitab)
131! LINE 9
132!! - no more within doc - CALL HM_GET_FLOATV('MAT_U' ,UNIT ,IS_AVAILABLE, LSUBMODEL, UNITAB)
133 CALL hm_get_floatv('MAT_EOH' ,e0h ,is_available, lsubmodel, unitab)
134 CALL hm_get_floatv('MAT_Ay' ,ay ,is_available, lsubmodel, unitab)
135 CALL hm_get_floatv('MAT_Theta' ,thet ,is_available, lsubmodel, unitab)
136! DEFAULT UNITS
137 CALL hm_get_floatv_dim('MAT_SRP' ,eps0_unit ,is_available, lsubmodel, unitab)
138 CALL hm_get_floatv_dim('MAT_EOH' ,ener_unit ,is_available, lsubmodel, unitab)
139 CALL hm_get_floatv_dim('MAT_dS' ,ds_unit ,is_available, lsubmodel, unitab)
140!-----------------------
141 IF (pmin == zero) pmin = -infinity
142 IF (cn == zero .OR. cn == one) cn = onep0001
143 IF (epsm == zero) epsm = infinity
144 IF (sigm == zero) sigm = infinity
145 IF (cc == zero) eps0 = one*eps0_unit
146 IF (cm == zero) cm = one ! dimensionless
147 IF (tmelt == zero) THEN
148 tmelt = infinity
149 ELSEIF (tm0 == zero) THEN
150 tm0 = onep3*tmelt
151 ENDIF
152 IF (tmax == zero) tmax = infinity
153C
154 g=young/(two*(one+anu))
155C
156 IF (rhor == zero) rhor=rho0
157 pm(1) = rhor
158 pm(89)= rho0
159 pm(20)= young
160 pm(21)= anu
161 pm(22)= g
162 pm(23)= e0
163 pm(31)= c0
164 pm(32)= rhor*c**2
165 pm(37)= pmin
166 pm(38)= ca
167 pm(39)= cb
168 pm(40)= cn
169 pm(41)= epsm
170 pm(42)= sigm
171 pm(43)= cc
172 pm(44)= eps0
173 pm(45)= cm
174 pm(46)= tmelt
175 pm(47)= tmax
176 pm(80)= tmelt
177C
178C--------------------------------------
179C GRAY
180C--------------------------------------
181!
182 !translation from Working unit System to {big bang} unit system
183 fac_m_bb = unitab%FAC_MASS*ep03
184 fac_l_bb = unitab%FAC_LENGTH*ep02
185 fac_t_bb = unitab%FAC_TIME*ep06
186!
187 IF (a == zero) a = gam0-half
188 IF (gam0m == zero) gam0m = gam0
189 IF (am == zero) am = a
190 IF (game == zero) game = two_third
191 IF (thet == zero) thet = one
192!
193!!! UNIT = ONE * EP05 * ENER_UNIT ! (1.0 * Mbar * cm**3 en SI)
194 unit = one * (fac_t_bb * fac_t_bb)/(fac_m_bb*fac_l_bb**2)
195 IF (ds == zero) ds = ninep637em5 * (fac_t_bb * fac_t_bb)/(fac_l_bb * fac_l_bb)
196 IF (vb == zero) vb=half/rhor
197 alpha=unit*onep3em5
198 r=unit*eightp314em5
199 xm=ninep38
200C
201 rp3=three*r/aw
202 gp=ge/aw
203 dsp=ds/aw
204 alphap=alpha/aw
205 rp=r/aw
206 pcc=three100**2*gp*(gam0-game)*rhor*half
207 e00=-three100*(three*r + hundred50*ge)/aw
208 apy=ay/aw/aw
209 xj=one-rhor*vj
210 x=xj
211 zj=vb/vj
212 e0j=(c**2*x**2/(2*(one-s*x)))*
213 . (one
214 . +s*x*third
215 . +s**2*(one-gam0/s)*x**2/six)
216 . +e00*(one+gam0*x)+e0h
217C
218 xp=zero
219 IF (x >= zero) xp=one
220 tmj=tm0*((one-xp)*(
221 . one
222 . +two*(gam0m-four_over_3)*x
223 . +((two*gam0m-five_over_3)*(gam0m-four_over_3)-am)*x**2
224 . )/(one-x)**2
225 . +xp*(
226 . one
227 . +(two*gam0m-two_third)*x
228 . +((gam0m-third)*(two*gam0m+third)-am)*x**2))
229 xlamj=two_third-two*gam0m+two*am*x
230
231C
232 d1=e0j+tmj*(dsp-half*alphap*(one-xm**2))+apy*rhor/(one-x)
233 d2=three_half*rp-xm*alphap
234 d3=half*gp
235 e=d1-apy/vj
236 g0ax=gam0-a*x
237 p1j =pcc+c**2*x
238 . *(one-(one+half*gam0)*x+half*a*x**2)*rhor
239 . /((one-x)*(one-s*x)**2)
240 . +g0ax*(e-e0h)*rhor/(one-x)
241 c1=p1j-tmj*(xlamj+g0ax)*(dsp-half*alphap*(one-xm**2))*rhor/(one-x)
242 . +apy*(rhor/(one-x))**2
243 c2=g0ax*(d2+three_half*rp)*rhor/(one-x)
244 . +alphap*xm*(xlamj+g0ax)*rhor/(one-x)
245 . -rp*rhor*((one+zj+zj**2-zj**3)/(one-zj)**3)/(one-x)
246 c3=game*gp*rhor*half/(one-x)
247C
248 pm(24)=d2
249 pm(25)=d3
250 pm(26)=thet
251 pm(27)=apy
252 pm(28)=vb
253 pm(29)=tm0
254 pm(30)=e00
255 pm(33)=c
256 pm(34)=s
257 pm(35)=pcc
258 pm(36)=gam0
259 pm(48)=a
260 pm(49)=gam0m
261 pm(50)=am
262 pm(51)=game
263 pm(52)=gp
264 pm(53)=dsp
265 pm(54)=e0h
266 pm(55)=rp3
267 pm(56)=vj
268 pm(57)=c1
269 pm(58)=c2
270 pm(59)=c3
271 pm(60)=d1
272 pm(61)=alphap
273C--------------------
274C Formulation for solid elements time step computation.
275 ipm(252)= 2
276 pm(105) = (one -two*anu)/(one - anu)
277c-----------------
278 CALL init_mat_keyword(matparam,"TOTAL")
279 IF (anu > 0.49) THEN
280 CALL init_mat_keyword(matparam,"INCOMPRESSIBLE")
281 ELSE
282 CALL init_mat_keyword(matparam,"COMPRESSIBLE")
283 END IF
284
285 ! EOS/Thermo keyword for pressure treatment in elements
286 CALL init_mat_keyword(matparam,"HYDRO_EOS")
287
288 ! Properties compatibility
289 CALL init_mat_keyword(matparam,"SOLID_ISOTROPIC")
290c-----------------
291 WRITE(iout,1001)trim(titr),mat_id,ilaw
292 WRITE(iout,1000)
293 IF (is_encrypted) THEN
294 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
295 ELSE
296 WRITE(iout,1002)rho0,rhor
297 WRITE(iout,1300)young,anu,g
298 WRITE(iout,1400)ca,cb,cn,epsm,sigm
299 WRITE(iout,1500)c0,c,s,gam0,a,aw,pmin,e0
300 WRITE(iout,1600)cc,eps0,cm,tmelt,tmax
301 WRITE(iout,1700)gam0m,am,game,ge,ds,tm0,vj,vb
302 WRITE(iout,1800)unit,e0h,ay,thet
303C WRITE(IOUT,1900)C1,C2,C3,D1,D2,D3
304C WRITE(IOUT,2000)E0J,TMJ,P1J
305 ENDIF
306C--------------------
307 IF (eps0 == zero) THEN
308 CALL ancmsg(msgid=298,msgtype=msgerror,anmode=aninfo,
309 . i1=16,
310 . i2=mat_id,
311 . c1=titr)
312 ENDIF
313c
314C---- Definition des variables internes (stockage elementaire)
315c
316 mtag%G_PLA = 1
317 mtag%G_TEMP = 1
318 mtag%G_EPSD = 1
319c
320 mtag%L_PLA = 1
321 mtag%L_TEMP = 1
322 mtag%L_EPSD = 1
323 mtag%L_XST = 1
324C--------------------
325 RETURN
326C--------------------
327 1000 FORMAT(
328 & 5x,40h johnson cook - gray law ,/,
329 & 5x,40h ----------------------- ,//)
330 1001 FORMAT(
331 & 5x,a,/,
332 & 5x,'MATERIAL NUMBER . . . . . . . . . . . .=',i10/,
333 & 5x,'MATERIAL LAW. . . . . . . . . . . . . .=',i10/)
334 1002 FORMAT(
335 & 5x,'INITIAL DENSITY . . . . . . . . . . . .=',1pg20.13/,
336 & 5x,'REFERENCE DENSITY . . . . . . . . . . .=',1pg20.13/)
337 1300 FORMAT(
338 & 5x,40hyoung'S MODULUS . . . . . . . . . . . .=,1PG20.13/,
339 & 5X,40HPOISSON's ratio . . . . . . . . . . . .=,1pg20.13/,
340 & 5x,40hshear modulus . . . . . . . . . . . . .=,1pg20.13//)
341 1400 FORMAT(
342 & 5x,40hplasticity yield stress ca. . . . . . .=,1pg20.13/,
343 & 5x,40hplasticity hardening Parameter cb.. . .=,1pg20.13/,
344 & 5x,40hplasticity hardening exponent cn. . . .=,1pg20.13/,
345 & 5x,40heps-max . . . . . . . . . . . . . . . .=,1pg20.13/,
346 & 5x,40hsig-max . . . . . . . . . . . . . . . .=,1pg20.13//)
347 1500 FORMAT(
348 & 5x,40hc0 initial pressure(not active) . . . .=,1pg20.13/,
349 & 5x,40hc hugoniot parameters . . . . . . . . .=,1pg20.13/,
350 & 5x,40hs us=c+s up . . . . . . . . . . . . . .=,1pg20.13/,
351 & 5x,40hgam0. . . . . . . . . . . . . . . . . .=,1pg20.13/,
352 & 5x,40ha gama=gam0-a x . . . . . . . . . . . .=,1pg20.13/,
353 & 5x,40hatomic weight . . . . . . . . . . . . .=,1pg20.13/,
354 & 5x,40hpressure cutoff . . . . . . . . . . . .=,1pg20.13/,
355 & 5x,40hinitial internal energy per unit volume=,1pg20.13//)
356 1600 FORMAT(
357 & 5x,40hstrain rate coefficient cc. . . . . . .=,1pg20.13/,
358 & 5x,40hreference strain rate . . . . . . . . .=,1pg20.13/,
359 & 5x,40htemperature exponent. . . . . . . . . .=,1pg20.13/,
360 & 5x,40hmelting temperature degree k. . . . . .=,1pg20.13/,
361 & 5x,40htheta-max . . . . . . . . . . . . . . .=,1pg20.13//)
362 1700 FORMAT(
363 & 5x,40hgam0m melting gamma . . . . . . . . . .=,1pg20.13/,
364 & 5x,40ham gamam=gam0m-am x . . . . . . . . . .=,1pg20.13/,
365 & 5x,40hgame electronic gamma . . . . . . . . .=,1pg20.13/,
366 & 5x,40hge electronic energy. . . . . . . . . .=,1pg20.13/,
367 & 5x,40hds entropy of melting . . . . . . . . .=,1pg20.13/,
368 & 5x,40htm0 melting temperature PARAMETER . . .=,1pg20.13/,
369 & 5x,40hvj volume WHERE eos are joined. . . . .=,1pg20.13/,
370 & 5x,40hvb excluded volume for vapor phase. . .=,1pg20.13//)
371 1800 FORMAT(
372 & 5x,40hunit(1. mbar cm3)(1e5 si). . . . . . .=,1pg20.13/,
373 & 5x,40he0h energy at v=v0 t=300k p=0 . . . . .=,1pg20.13/,
374 & 5x,40hay attractive potential for vapor . . .=,1pg20.13/,
375 & 5x,40htheta join PARAMETER. . . . . . . . . .=,1pg20.13//)
376 1900 FORMAT(
377 & 5x,40hc1 . . . . . . . . . . . .. . . . . . .=,1pg20.13/,
378 & 5x,40hc2 . . . . . . . . . . . .. . . . . . .=,1pg20.13/,
379 & 5x,40hc3 . . . . . . . . . . . .. . . . . . .=,1pg20.13/,
380 & 5x,40hd1 . . . . . . . . . . . .. . . . . . .=,1pg20.13/,
381 & 5x,40hd2 . . . . . . . . . . . .. . . . . . .=,1pg20.13/,
382 & 5x,40hd3 . . . . . . . . . . . .. . . . . . .=,1pg20.13//)
383 2000 FORMAT(
384 & 5x,40he0j. . . . . . . . . . . .. . . . . . .=,1pg20.13/,
385 & 5x,40htmj. . . . . . . . . . . .. . . . . . .=,1pg20.13/,
386 & 5x,40hp1j. . . . . . . . . . . .. . . . . . .=,1pg20.13//)
387
388 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_floatv_dim
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
Definition hm_get_floatv_dim.F:159
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
max
#define max(a, b)
Definition macros.h:21
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
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