OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat04.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_mat04 ../starter/source/materials/mat/mat004/hm_read_mat04.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_mat ../starter/source/materials/mat/hm_read_mat.F90
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
30!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
31!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
32!|| init_mat_keyword ../starter/source/materials/mat/init_mat_keyword.F
33!||--- uses -----------------------------------------------------
34!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
35!|| message_mod ../starter/share/message_module/message_mod.F
36!|| submodel_mod ../starter/share/modules1/submodel_mod.F
37!||====================================================================
38 SUBROUTINE hm_read_mat04(
39 . LSUBMODEL ,MTAG ,UNITAB ,IPM ,PM ,
40 . MAT_ID ,TITR ,ISRATE ,MAT_PARAM)
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 COUNT, IEOS
89 . young, anu, ca, cb, cn, epsm, sigm, bulk,
90 . pmin, cc, eps0, cm, tmelt, tmax, cs, t0, sph,
91 . g,
92 .
93 .
94 . c0,c1,c2,c3,c4,c5,e0,psh,rho0,rhor
95C-----------------------------------------------
96C S o u r c e L i n e s
97C-----------------------------------------------
98 count = 0
99 is_eos=.false.
100 ieos = 0
101 eos_embedded=.false.
102 bulk=zero
103 israte = 0
104 is_encrypted = .false.
105 is_available = .false.
106!---
107 CALL hm_option_is_encrypted(is_encrypted)
108
109 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
110 CALL hm_get_floatv('Refer_Rho' ,rhor ,is_available, lsubmodel, unitab)
111
112 CALL hm_get_floatv('MAT_E' ,young ,is_available, lsubmodel, unitab)
113 CALL hm_get_floatv('MAT_NU' ,anu ,is_available, lsubmodel, unitab)
114
115 CALL hm_get_floatv('MAT_SIGY' ,ca ,is_available, lsubmodel, unitab)
116 CALL hm_get_floatv('MAT_BETA' ,cb ,is_available, lsubmodel, unitab)
117 CALL hm_get_floatv('MAT_HARD' ,cn ,is_available, lsubmodel, unitab)
118 CALL hm_get_floatv('MAT_EPS' ,epsm ,is_available, lsubmodel, unitab)
119 CALL hm_get_floatv('MAT_SIG' ,sigm ,is_available, lsubmodel, unitab)
120
121 CALL hm_get_floatv('MAT_PC' ,pmin ,is_available, lsubmodel, unitab)
122
123 CALL hm_get_floatv('MAT_SRC' ,cc ,is_available, lsubmodel, unitab)
124 CALL hm_get_floatv('MAT_SRP' ,eps0 ,is_available, lsubmodel, unitab)
125 CALL hm_get_floatv('MAT_M' ,cm ,is_available, lsubmodel, unitab)
126 CALL hm_get_floatv('MAT_TMELT' ,tmelt ,is_available, lsubmodel, unitab)
127 CALL hm_get_floatv('MAT_TMAX' ,tmax ,is_available, lsubmodel, unitab)
128
129 CALL hm_get_floatv('MAT_SPHEAT' ,cs ,is_available, lsubmodel, unitab)
130 CALL hm_get_floatv('MAT_T0' ,t0 ,is_available, lsubmodel, unitab)
131
132 CALL hm_get_intv ('Line_count' ,count ,is_available, lsubmodel)
133
134 IF(invers_init>=2018)THEN
135 eos_embedded=.false.
136 ELSEIF(invers_init>=110)THEN
137 IF(count==3)eos_embedded=.true.
138 ELSE
139 eos_embedded=.true.
140 ENDIF
141
142 !----------------------------------------------------
143 !CHECK IF OLD CARD FORMAT 100 IS USED (OBSOLETE)
144 ! MAKES IT COMPATIBLE + WARNING
145 !----------------------------------------------------
146 IF(eos_embedded)THEN ! will use POLYNOMIAL EOS
147 IF(invers_init>=140) THEN
148 CALL ancmsg(msgid=1072,
149 . msgtype=msgerror,
150 . anmode=aninfo,
151 . i1 = mat_id,
152 . c1 = titr)
153 RETURN
154 ENDIF
155 CALL hm_get_floatv('MAT_C0' ,c0 ,is_available, lsubmodel, unitab)
156 CALL hm_get_floatv('MAT_C1' ,c1 ,is_available, lsubmodel, unitab)
157 CALL hm_get_floatv('MAT_C2' ,c2 ,is_available, lsubmodel, unitab)
158 CALL hm_get_floatv('MAT_C3' ,c3 ,is_available, lsubmodel, unitab)
159 CALL hm_get_floatv('MAT_C4' ,c4 ,is_available, lsubmodel, unitab)
160 CALL hm_get_floatv('MAT_C5' ,c5 ,is_available, lsubmodel, unitab)
161 CALL hm_get_floatv('MAT_E0' ,e0 ,is_available, lsubmodel, unitab)
162 CALL hm_get_floatv('MAT_PSH' ,psh ,is_available, lsubmodel, unitab)
163 ! allocate EoS data structure
164 mat_param%IEOS = 1
165 mat_param%EOS%NUPARAM = 7
166 mat_param%EOS%NIPARAM = 0
167 mat_param%EOS%NFUNC = 0
168 mat_param%EOS%NTABLE = 0
169 CALL mat_param%EOS%CONSTRUCT() !allocations
170 mat_param%EOS%UPARAM(1) = c0-psh
171 mat_param%EOS%UPARAM(2) = c1
172 mat_param%EOS%UPARAM(3) = c2
173 mat_param%EOS%UPARAM(4) = c3
174 mat_param%EOS%UPARAM(5) = c4
175 mat_param%EOS%UPARAM(6) = c5
176 mat_param%EOS%UPARAM(7) = zero
177 mat_param%EOS%PSH = psh
178 mat_param%EOS%E0 = e0
179 bulk = c1
180 pm(23)= e0
181 pm(31)= c0-psh
182 pm(32)=c1 !legacy value
183 !!PM(32)= C1+C4*ABS(E0) !bulk modulus
184 pm(88)= psh
185 ieos = 1 ! Polynomial EOS
186 ELSE
187 ieos = 18 ! Linear EOS is used by default
188 ENDIF
189!
190 CALL init_mat_keyword(mat_param,"ELASTO_PLASTIC")
191 CALL init_mat_keyword(mat_param,"INCREMENTAL")
192 CALL init_mat_keyword(mat_param,"LARGE_STRAIN")
193 mat_param%IEOS = ieos
194 ipm(4) = ieos ! keep this temporarily for output and fluid sections
195
196 IF (pmin==zero) pmin=-ep20
197 IF (rhor==zero) rhor=rho0
198 pm(1) = rhor
199 pm(89)= rho0
200
201
202 IF(cs == zero.AND.tmelt == zero)THEN
203 CALL ancmsg(msgid=593,
204 . msgtype=msgwarning,
205 . anmode=aninfo_blind_1,
206 . i1=mat_id,
207 . c1=titr)
208 cs=ep20
209 ELSEIF(cs == zero)THEN
210 CALL ancmsg(msgid=594,
211 . msgtype=msgerror,
212 . anmode=aninfo_blind_1,
213 . i1=mat_id,
214 . c1=titr)
215 END IF
216 sph=cs
217 IF(pmin == zero) pmin =-ep20
218 IF(cn == zero.OR.cn == one) cn = onep0001
219 IF(epsm == zero) epsm = ep20
220 IF(sigm == zero) sigm = ep20
221 IF(cc == zero) eps0 = one
222 IF(cm == zero) cm = one
223 IF(tmelt == zero)tmelt = ep20
224 IF(tmax == zero) tmax = ep20
225 IF(t0<=zero) t0 = three100
226 g=young/(two*(one + anu))
227 IF(.NOT.eos_embedded)bulk=young/(three*(one - two*anu))
228C
229 pm(20)=young
230 pm(21)=anu
231 pm(22)=g
232 pm(32)=bulk
233 pm(37)=pmin
234 pm(38)=ca
235 pm(39)=cb
236 pm(40)=cn
237 pm(41)=epsm
238 pm(42)=sigm
239 pm(43)=cc
240 pm(44)=eps0
241 pm(45)=cm
242 pm(46)=tmelt
243 pm(47)=tmax
244 pm(48)=cs
245 pm(69)=sph
246 pm(79)=t0
247 pm(80)=tmelt
248CC-----------
249C Formulation for solid elements time step computation.
250 ipm(252)= 2
251 pm(105) = (one -two*anu)/(one - anu) ! TWO*G/(BULK + FOUR_OVER_3*G)
252
253 !sizes for element buffer
254 mtag%G_PLA = 1
255 mtag%G_TEMP = 1
256 mtag%G_EPSD = 1
257 !
258 mtag%L_PLA = 1
259 mtag%L_TEMP = 1
260 mtag%L_EPSD = 1
261
262 ! Material compatibility with /EOS option
263 CALL init_mat_keyword(mat_param,"EOS")
264
265 ! EOS/Thermo keyword for pressure treatment in elements
266 CALL init_mat_keyword(mat_param,"HYDRO_EOS")
267
268 ! Properties compatibility
269 CALL init_mat_keyword(mat_param,"SOLID_ISOTROPIC")
270 CALL init_mat_keyword(mat_param,"SPH")
271!
272 ! activate heat source calculation in material for /heat/mat
273
274 mat_param%HEAT_FLAG = 1
275
276C--------------------------------
277 WRITE(iout,2001) titr,mat_id,4
278 WRITE(iout,1000)
279
280 IF(is_encrypted)THEN
281 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
282 ELSE
283 WRITE(iout,2002)rho0,rhor
284 WRITE(iout,1300)young,anu,g,bulk
285 WRITE(iout,1400)ca,cb,cn,epsm,sigm
286 WRITE(iout,1500)pmin
287 WRITE(iout,1600)cc,eps0,cm,tmelt,tmax,cs,t0
288 ENDIF
289
290 !--------------------------------------------------!
291 ! OLD FORMAT 100 (OBSOLETE) !
292 !--------------------------------------------------!
293 IF(eos_embedded)THEN !
294 WRITE(iout,2000) !
295 IF(is_encrypted)THEN !
296 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA' !
297 ELSE !
298 WRITE(iout,2500)c0,c1,c2,c3,c4,c5,e0,pm(1),psh !
299 ENDIF !
300 ENDIF !
301 !--------------------------------------------------!
302C
303 IF(eps0 == zero) THEN
304 CALL ancmsg(msgid=298,msgtype=msgerror,anmode=aninfo,i1=4,i2=mat_id,c1=titr)
305 ENDIF
306 RETURN
307 1000 FORMAT(
308 & 5x,' JOHNSON COOK LAW ',/,
309 & 5x,' ---------------- ',//)
310 1300 FORMAT(
311 & 5x,'YOUNG',1h','s modulus . . . . . . . . . . . .=',1PG20.13/,
312 & 5X,'poisson',1h','s ratio . . . . . . . . . . . .=',1PG20.13/,
313 & 5X,'shear modulus . . . . . . . . . . . . .=',1PG20.13/,
314 & 5X,'bulk modulus . . . . . . . . . . . . .=',1PG20.13//)
315 1400 FORMAT(
316 & 5X,'yield coefficient ca. . . . . . . . . .=',1PG20.13/,
317 & 5X,'yield coefficient cb. . . . . . . . . .=',1PG20.13/,
318 & 5X,'yield coefficient cn. . . . . . . . . .=',1PG20.13/,
319 & 5X,'eps-max . . . . . . . . . . . . . . . .=',1PG20.13/,
320 & 5X,'sig-max . . . . . . . . . . . . . . . .=',1PG20.13//)
321 1500 FORMAT(
322 & 5X,'pressure cutoff . . . . . . . . . . . .=',1PG20.13/)
323 1600 FORMAT(
324 & 5X,'strain rate coefficient cc. . . . . . .=',1PG20.13/,
325 & 5X,'reference strain rate . . . . . . . . .=',1PG20.13/,
326 & 5X,'temperature exponent. . . . . . . . . .=',1PG20.13/,
327 & 5X,'melting temperature degree k. . . . . .=',1PG20.13/,
328 & 5X,'theta-max . . . . . . . . . . . . . . .=',1PG20.13/,
329 & 5X,'specific heat . . . . . . . . . . . . .=',1PG20.13/,
330 & 5X,'room temperature . . . . . . . . . . . =',1PG20.13//)
331 2000 FORMAT(
332 & 5X,' polynomial eos ',/,
333 & 5X,' -------------- ',/,
334 & 5X,' input 100 is obsolete ',/,
335 & 5X,' it can be erased by /eos card ',/)
336 2001 FORMAT(/
337 & 5X,A,/,
338 & 5X,' material number . . . . . . . . . . . .=',I10/,
339 & 5X,' material law. . . . . . . . . . . . . .=',I10/)
340 2002 FORMAT(
341 & 5X,' initial density . . . . . . . . . . . .=',1PG20.13/,
342 & 5X,' reference density . . . . . . . . . . .=',1PG20.13/)
343 2500 FORMAT(
344 & 5X,'c0. . . . . . . . . . . . . . . . . . . .=',1PG20.13/,
345 & 5X,'c1. . . . . . . . . . . . . . . . . . . .=',1PG20.13/,
346 & 5X,'c2. . . . . . . . . . . . . . . . . . . .=',1PG20.13/,
347 & 5X,'c3. . . . . . . . . . . . . . . . . . . .=',1PG20.13/,
348 & 5X,'c4. . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
349 & 5x,'C5. . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
350 & 5x,'INITIAL INTERNAL ENERGY PER UNIT VOLUME .=',1pg20.13/,
351 & 5x,'REFERENCE DENSITY . . . . . . . . . . . .=',1pg20.13/,
352 & 5x,'PRESSURE SHIFT. . . . . . . . . . . . . .=',1pg20.13//)
353 RETURN
354 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_mat04(lsubmodel, mtag, unitab, ipm, pm, mat_id, titr, israte, mat_param)
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:895