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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_mat04 (lsubmodel, mtag, unitab, ipm, pm, mat_id, titr, israte, mat_param)

Function/Subroutine Documentation

◆ hm_read_mat04()

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

Definition at line 38 of file hm_read_mat04.F.

41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE elbuftag_mod
45 USE message_mod
46 USE submodel_mod
47 USE matparam_def_mod
48 USE unitab_mod
50C-----------------------------------------------
51C ROUTINE DESCRIPTION :
52C ===================
53C READ MAT LAW04 WITH HM READER
54C-----------------------------------------------
55C DUMMY ARGUMENTS DESCRIPTION:
56C ===================
57C UNITAB UNITS ARRAY
58C MAT_ID MATERIAL ID(INTEGER)
59C TITR MATERIAL TITLE
60C LSUBMODEL SUBMODEL STRUCTURE
61C-----------------------------------------------
62C I m p l i c i t T y p e s
63C-----------------------------------------------
64#include "implicit_f.inc"
65C-----------------------------------------------
66C C o m m o n B l o c k s
67C-----------------------------------------------
68#include "scr03_c.inc"
69#include "units_c.inc"
70#include "param_c.inc"
71C-----------------------------------------------
72C D u m m y A r g u m e n t s
73C-----------------------------------------------
74 INTEGER, INTENT(INOUT) :: MAT_ID
75 INTEGER, INTENT(INOUT) :: ISRATE
76 INTEGER, DIMENSION(NPROPMI) ,INTENT(INOUT) :: IPM
77 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
78 my_real, DIMENSION(NPROPM) ,INTENT(INOUT) :: pm
79 TYPE(UNIT_TYPE_) ,INTENT(IN) :: UNITAB
80 TYPE(SUBMODEL_DATA), DIMENSION(NSUBMOD),INTENT(IN) :: LSUBMODEL
81 TYPE(MLAW_TAG_), INTENT(INOUT) :: MTAG
82 TYPE(MATPARAM_STRUCT_),INTENT(INOUT) :: MAT_PARAM
83C-----------------------------------------------
84C L o c a l V a r i a b l e s
85C-----------------------------------------------
86 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED,IS_EOS, EOS_EMBEDDED
87 INTEGER JTUR, I, EMPTY_LINE,COUNT,IEOS,LAW6_OPT
88 INTEGER JTHE, IFLAGR
90 . young, anu, ca, cb, cn, epsm, sigm, bulk,
91 . pmin, cc, eps0, cm, tmelt, tmax, cs, t0, sph, as, bs,
92 . al, bl, g, tba, tbk, pco, fac_l, fac_t, fac_m, fac_c,
93 . bid2 ,bid3 ,bid4 ,bid5 ,
94 . bid2_,bid3_,bid4_,bid5_,
95 . c0,c1,c2,c3,c4,c5,e0,psh,ti,rho0,rhor
96C-----------------------------------------------
97C S o u r c e L i n e s
98C-----------------------------------------------
99 count = 0
100 is_eos=.false.
101 ieos = 0
102 eos_embedded=.false.
103 bulk=zero
104 israte = 0
105 is_encrypted = .false.
106 is_available = .false.
107!---
108 CALL hm_option_is_encrypted(is_encrypted)
109
110 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
111 CALL hm_get_floatv('Refer_Rho' ,rhor ,is_available, lsubmodel, unitab)
112
113 CALL hm_get_floatv('MAT_E' ,young ,is_available, lsubmodel, unitab)
114 CALL hm_get_floatv('MAT_NU' ,anu ,is_available, lsubmodel, unitab)
115
116 CALL hm_get_floatv('MAT_SIGY' ,ca ,is_available, lsubmodel, unitab)
117 CALL hm_get_floatv('MAT_BETA' ,cb ,is_available, lsubmodel, unitab)
118 CALL hm_get_floatv('MAT_HARD' ,cn ,is_available, lsubmodel, unitab)
119 CALL hm_get_floatv('MAT_EPS' ,epsm ,is_available, lsubmodel, unitab)
120 CALL hm_get_floatv('MAT_SIG' ,sigm ,is_available, lsubmodel, unitab)
121
122 CALL hm_get_floatv('MAT_PC' ,pmin ,is_available, lsubmodel, unitab)
123
124 CALL hm_get_floatv('MAT_SRC' ,cc ,is_available, lsubmodel, unitab)
125 CALL hm_get_floatv('MAT_SRP' ,eps0 ,is_available, lsubmodel, unitab)
126 CALL hm_get_floatv('MAT_M' ,cm ,is_available, lsubmodel, unitab)
127 CALL hm_get_floatv('MAT_TMELT' ,tmelt ,is_available, lsubmodel, unitab)
128 CALL hm_get_floatv('MAT_TMAX' ,tmax ,is_available, lsubmodel, unitab)
129
130 CALL hm_get_floatv('MAT_SPHEAT' ,cs ,is_available, lsubmodel, unitab)
131 CALL hm_get_floatv('MAT_T0' ,t0 ,is_available, lsubmodel, unitab)
132
133 CALL hm_get_intv ('Line_count' ,count ,is_available, lsubmodel)
134
135 IF(invers_init>=2018)THEN
136 eos_embedded=.false.
137 ELSEIF(invers_init>=110)THEN
138 IF(count==3)eos_embedded=.true.
139 ELSE
140 eos_embedded=.true.
141 ENDIF
142
143 !----------------------------------------------------
144 !CHECK IF OLD CARD FORMAT 100 IS USED (OBSOLETE)
145 ! MAKES IT COMPATIBLE + WARNING
146 !----------------------------------------------------
147 IF(eos_embedded)THEN ! will use POLYNOMIAL EOS
148 IF(invers_init>=140) THEN
149 CALL ancmsg(msgid=1072,
150 . msgtype=msgerror,
151 . anmode=aninfo,
152 . i1 = mat_id,
153 . c1 = titr)
154 RETURN
155 ENDIF
156 CALL hm_get_floatv('MAT_C0' ,c0 ,is_available, lsubmodel, unitab)
157 CALL hm_get_floatv('MAT_C1' ,c1 ,is_available, lsubmodel, unitab)
158 CALL hm_get_floatv('MAT_C2' ,c2 ,is_available, lsubmodel, unitab)
159 CALL hm_get_floatv('MAT_C3' ,c3 ,is_available, lsubmodel, unitab)
160 CALL hm_get_floatv('MAT_C4' ,c4 ,is_available, lsubmodel, unitab)
161 CALL hm_get_floatv('MAT_C5' ,c5 ,is_available, lsubmodel, unitab)
162 CALL hm_get_floatv('MAT_E0' ,e0 ,is_available, lsubmodel, unitab)
163 CALL hm_get_floatv('MAT_PSH' ,psh ,is_available, lsubmodel, unitab)
164 bulk = c1
165 pm(23)= e0
166 pm(31)= c0-psh
167 pm(32)= c1
168 pm(33)= c2
169 pm(34)= c3
170 pm(35)= c4
171 pm(36)= c5
172 pm(88)= psh
173 ieos = 1 ! Polynomial EOS
174 ELSE
175 ieos = 18 ! Linear EOS is used by default
176 ENDIF
177!
178 CALL init_mat_keyword(mat_param,"ELASTO_PLASTIC")
179 CALL init_mat_keyword(mat_param,"INCREMENTAL")
180 CALL init_mat_keyword(mat_param,"LARGE_STRAIN")
181 mat_param%IEOS = ieos
182 ipm(4) = ieos ! keep this temporarily for output and fluid sections
183
184 IF (pmin==zero) pmin=-ep20
185 IF (rhor==zero) rhor=rho0
186 pm(1) = rhor
187 pm(89)= rho0
188
189
190 IF(cs == zero.AND.tmelt == zero)THEN
191 CALL ancmsg(msgid=593,
192 . msgtype=msgwarning,
193 . anmode=aninfo_blind_1,
194 . i1=mat_id,
195 . c1=titr)
196 cs=ep20
197 ELSEIF(cs == zero)THEN
198 CALL ancmsg(msgid=594,
199 . msgtype=msgerror,
200 . anmode=aninfo_blind_1,
201 . i1=mat_id,
202 . c1=titr)
203 END IF
204 sph=cs
205 IF(pmin == zero) pmin =-ep20
206 IF(cn == zero.OR.cn == one) cn = onep0001
207 IF(epsm == zero) epsm = ep20
208 IF(sigm == zero) sigm = ep20
209 IF(cc == zero) eps0 = one
210 IF(cm == zero) cm = one
211 IF(tmelt == zero)tmelt = ep20
212 IF(tmax == zero) tmax = ep20
213 IF(t0<=zero) t0 = three100
214 g=young/(two*(one + anu))
215 IF(.NOT.eos_embedded)bulk=young/(three*(one - two*anu))
216C
217 pm(20)=young
218 pm(21)=anu
219 pm(22)=g
220 pm(32)=bulk
221 pm(37)=pmin
222 pm(38)=ca
223 pm(39)=cb
224 pm(40)=cn
225 pm(41)=epsm
226 pm(42)=sigm
227 pm(43)=cc
228 pm(44)=eps0
229 pm(45)=cm
230 pm(46)=tmelt
231 pm(47)=tmax
232 pm(48)=cs
233 pm(69)=sph
234 pm(79)=t0
235 pm(80)=tmelt
236CC-----------
237C Formulation for solid elements time step computation.
238 ipm(252)= 2
239 pm(105) = (one -two*anu)/(one - anu) ! TWO*G/(BULK + FOUR_OVER_3*G)
240
241 !sizes for element buffer
242 mtag%G_PLA = 1
243 mtag%G_TEMP = 1
244 mtag%G_EPSD = 1
245 !
246 mtag%L_PLA = 1
247 mtag%L_TEMP = 1
248 mtag%L_EPSD = 1
249
250 ! Material compatibility with /EOS option
251 CALL init_mat_keyword(mat_param,"EOS")
252
253 ! EOS/Thermo keyword for pressure treatment in elements
254 CALL init_mat_keyword(mat_param,"HYDRO_EOS")
255
256 ! Properties compatibility
257 CALL init_mat_keyword(mat_param,"SOLID_ISOTROPIC")
258 CALL init_mat_keyword(mat_param,"SPH")
259!
260 ! activate heat source calculation in material for /heat/mat
261
262 mat_param%HEAT_FLAG = 1
263
264C--------------------------------
265 WRITE(iout,2001) titr,mat_id,4
266 WRITE(iout,1000)
267
268 IF(is_encrypted)THEN
269 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
270 ELSE
271 WRITE(iout,2002)rho0,rhor
272 WRITE(iout,1300)young,anu,g,bulk
273 WRITE(iout,1400)ca,cb,cn,epsm,sigm
274 WRITE(iout,1500)pmin
275 WRITE(iout,1600)cc,eps0,cm,tmelt,tmax,cs,t0
276 ENDIF
277
278 !--------------------------------------------------!
279 ! OLD FORMAT 100 (OBSOLETE) !
280 !--------------------------------------------------!
281 IF(eos_embedded)THEN !
282 WRITE(iout,2000) !
283 IF(is_encrypted)THEN !
284 WRITE(iout,'(5X,A,//)')'confidential data' !
285 ELSE !
286 WRITE(IOUT,2500)C0,C1,C2,C3,C4,C5,E0,PM(1),PSH !
287 ENDIF !
288 ENDIF !
289 !--------------------------------------------------!
290C
291 IF(EPS0 == ZERO) THEN
292 CALL ANCMSG(MSGID=298,MSGTYPE=MSGERROR,ANMODE=ANINFO,I1=4,I2=MAT_ID,C1=TITR)
293 ENDIF
294 RETURN
295 1000 FORMAT(
296 & 5X,' johnson cook law ',/,
297 & 5X,' ---------------- ',//)
298 1300 FORMAT(
299 & 5X,'young',1H','S MODULUS . . . . . . . . . . . .=',1pg20.13/,
300 & 5x,'POISSON',1h','s ratio . . . . . . . . . . . .=',1PG20.13/,
301 & 5X,'shear modulus . . . . . . . . . . . . .=',1PG20.13/,
302 & 5X,'bulk modulus . . . . . . . . . . . . .=',1PG20.13//)
303 1400 FORMAT(
304 & 5X,'yield coefficient ca. . . . . . . . . .=',1PG20.13/,
305 & 5X,'yield coefficient cb. . . . . . . . . .=',1PG20.13/,
306 & 5X,'yield coefficient cn. . . . . . . . . .=',1PG20.13/,
307 & 5X,'eps-max . . . . . . . . . . . . . . . .=',1PG20.13/,
308 & 5X,'sig-max . . . . . . . . . . . . . . . .=',1PG20.13//)
309 1500 FORMAT(
310 & 5X,'pressure cutoff . . . . . . . . . . . .=',1PG20.13/)
311 1600 FORMAT(
312 & 5X,'strain rate coefficient cc. . . . . . .=',1PG20.13/,
313 & 5X,'reference strain rate . . . . . . . . .=',1PG20.13/,
314 & 5X,'temperature exponent. . . . . . . . . .=',1PG20.13/,
315 & 5X,'melting temperature degree k. . . . . .=',1PG20.13/,
316 & 5X,'theta-max . . . . . . . . . . . . . . .=',1PG20.13/,
317 & 5X,'specific heat . . . . . . . . . . . . .=',1PG20.13/,
318 & 5X,'room temperature . . . . . . . . . . . =',1PG20.13//)
319 2000 FORMAT(
320 & 5X,' polynomial eos ',/,
321 & 5X,' -------------- ',/,
322 & 5X,' input 100 is obsolete ',/,
323 & 5X,' it can be erased by /eos card ',/)
324 2001 FORMAT(/
325 & 5X,A,/,
326 & 5X,' material number . . . . . . . . . . . .=',I10/,
327 & 5X,' material law. . . . . . . . . . . . . .=',I10/)
328 2002 FORMAT(
329 & 5X,' initial density . . . . . . . . . . . .=',1PG20.13/,
330 & 5X,' reference density . . . . . . . . . . .=',1PG20.13/)
331 2500 FORMAT(
332 & 5X,'c0. . . . . . . . . . . . . . . . . . . .=',1PG20.13/,
333 & 5X,'c1. . . . . . . . . . . . . . . . . . . .=',1PG20.13/,
334 & 5X,'c2. . . . . . . . . . . . . . . . . . . .=',1PG20.13/,
335 & 5X,'c3. . . . . . . . . . . . . . . . . . . .=',1PG20.13/,
336 & 5X,'c4. . . . . . . . . . . . . . . . . . . .=',1PG20.13/,
337 & 5X,'c5. . . . . . . . . . . . . . . . . . . .=',1PG20.13/,
338 & 5X,'initial internal energy per unit volume .=',1PG20.13/,
339 & 5X,'reference density . . . . . . . . . . . .=',1PG20.13/,
340 & 5X,'pressure shift. . . . . . . . . . . . . .=',1PG20.13//)
341 RETURN
#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 init_mat_keyword(matparam, keyword)
#define max(a, b)
Definition macros.h:21
integer, parameter nchartitle
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