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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_mat104 (uparam, maxuparam, nuparam, nuvar, nfunc, maxfunc, ifunc, parmat, unitab, mat_id, pm, titr, mtag, lsubmodel, matparam)

Function/Subroutine Documentation

◆ hm_read_mat104()

subroutine hm_read_mat104 ( intent(inout) uparam,
integer, intent(in) maxuparam,
integer, intent(inout) nuparam,
integer, intent(inout) nuvar,
integer, intent(inout) nfunc,
integer, intent(in) maxfunc,
integer, dimension(maxfunc), intent(inout) ifunc,
intent(inout) parmat,
type (unit_type_), intent(in) unitab,
integer, intent(in) mat_id,
intent(inout) pm,
character(len=nchartitle), intent(in) titr,
type(mlaw_tag_), intent(inout) mtag,
type(submodel_data), dimension(*), intent(in) lsubmodel,
type(matparam_struct_), intent(inout) matparam )

Definition at line 38 of file hm_read_mat104.F.

41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE unitab_mod
45 USE message_mod
46 USE elbuftag_mod
47 USE submodel_mod
48 USE matparam_def_mod
49 USE names_and_titles_mod , ONLY : nchartitle
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "units_c.inc"
58#include "param_c.inc"
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 my_real, DIMENSION(MAXUPARAM) ,INTENT(INOUT) :: uparam
63 INTEGER, INTENT(IN) :: MAT_ID,MAXUPARAM,MAXFUNC
64 INTEGER, INTENT(INOUT) :: NUPARAM,NUVAR,IFUNC(MAXFUNC),NFUNC
65 TYPE (UNIT_TYPE_),INTENT(IN) :: UNITAB
66 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
67 my_real, DIMENSION(100),INTENT(INOUT) :: parmat
68 TYPE(SUBMODEL_DATA), DIMENSION(*),INTENT(IN) :: LSUBMODEL
69 TYPE(MLAW_TAG_), INTENT(INOUT) :: MTAG
70 TYPE(MATPARAM_STRUCT_) ,INTENT(INOUT) :: MATPARAM
71 my_real, DIMENSION(NPROPM) ,INTENT(INOUT) :: pm
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER FLAGNICE,ILAW
76 my_real
77 . young,nu,nnu,nnu1,bulk,lam,g,g2,a1,a2,c1,fcut,asrate,cdr,
78 . qvoce,bvoce,jcc,epsp0,mtemp,tref,eta,cp,dpis,dpad,
79 . yld0,hp,kdr,tini,rho0
80C
81 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
82C=======================================================================
83 is_encrypted = .false.
84 is_available = .false.
85 ilaw = 104
86c------------------------------------------
87 CALL hm_option_is_encrypted(is_encrypted)
88c------------------------------------------
89card1 - Density
90 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
91card2 - Elastic parameters - Flags
92 CALL hm_get_floatv('MAT_E' ,young ,is_available, lsubmodel, unitab)
93 CALL hm_get_floatv('MAT_NU' ,nu ,is_available, lsubmodel, unitab)
94 CALL hm_get_intv ('MAT104_Ires' ,flagnice ,is_available, lsubmodel)
95card3 - Hardening mdefied Voce
96 CALL hm_get_floatv('SIGMA_r' ,yld0 ,is_available, lsubmodel, unitab)
97 CALL hm_get_floatv('MAT104_H' ,hp ,is_available, lsubmodel, unitab)
98 CALL hm_get_floatv('MAT_PR' ,qvoce ,is_available, lsubmodel, unitab)
99 CALL hm_get_floatv('MAT104_Bv' ,bvoce ,is_available, lsubmodel, unitab)
100 CALL hm_get_floatv('MAT104_Cdr' ,cdr ,is_available, lsubmodel, unitab)
101card4 - JC strain rate
102 CALL hm_get_floatv('MAT104_Cjc' ,jcc ,is_available, lsubmodel, unitab)
103 CALL hm_get_floatv('MAT104_Eps0' ,epsp0 ,is_available, lsubmodel, unitab)
104 CALL hm_get_floatv('MAT104_Fcut' ,fcut ,is_available, lsubmodel, unitab)
105card5 - thermal softening
106 CALL hm_get_floatv('MAT104_Tss' ,mtemp ,is_available, lsubmodel, unitab)
107 CALL hm_get_floatv('MAT104_Tref' ,tref ,is_available, lsubmodel, unitab)
108 CALL hm_get_floatv('T_Initial' ,tini ,is_available, lsubmodel, unitab)
109card6 - self-heating
110 CALL hm_get_floatv('MAT_ETA' ,eta ,is_available, lsubmodel, unitab)
111 CALL hm_get_floatv('MAT_SPHEAT' ,cp ,is_available, lsubmodel, unitab)
112 CALL hm_get_floatv('MAT104_EpsIso',dpis ,is_available, lsubmodel, unitab)
113 CALL hm_get_floatv('MAT104_EpsAd' ,dpad ,is_available, lsubmodel, unitab)
114c---------------------------------------------------
115 ! Default values
116 IF (yld0 == zero) yld0 = infinity
117 ! Cutting frequency
118 IF (fcut == zero) THEN
119 fcut = 10000.0d0*unitab%FAC_T_WORK
120 ENDIF
121 asrate = two*pi*fcut
122 ! If the inviscid plastic strain-rate is zero, no Johnson-Cook model
123 IF(epsp0 == zero) THEN
124 epsp0 = one
125 jcc = zero
126 ! Info message
127 CALL ancmsg(msgid=1654,msgtype=msginfo,
128 . anmode=aninfo_blind_1,i1=mat_id,c1=titr)
129 ENDIF
130 ! Self - heating
131 IF (dpis == zero) dpis = infinity
132 IF (dpad == zero) dpad = two*infinity
133 IF (dpis > dpad) THEN
134 ! Error message
135 CALL ancmsg(msgid=1655,msgtype=msgerror,
136 . anmode=aninfo_blind_1,i1=mat_id,c1=titr)
137 ENDIF
138 ! Nice return mapping by default
139 IF (flagnice == 0) flagnice = 1
140 IF (flagnice > 2) THEN
141 CALL ancmsg(msgid=1731,msgtype=msgwarning,
142 . anmode=aninfo_blind_1,i1=mat_id,c1=titr,
143 . i2=flagnice)
144 ENDIF
145c FLAGNICE = 1 => Nice method (default)
146c FLAGNICE = 2 => Newton method
147c--------------------------
148 ! Elastic parameters
149 g2 = young / (one + nu)
150 g = half * g2
151 lam = g2 * nu /(one - two*nu)
152 bulk = third * young / (one - nu*two)
153 nnu = nu / (one - nu)
154 nnu1 = one - nnu
155 a1 = young / (one - nu*nu)
156 a2 = a1 * nu
157 c1 = young / three/(one - two*nu)
158c
159 ! Checking value of Drucker coeff to ensure the yield surface convexity
160 IF (cdr > 2.25d0) THEN
161 cdr = 2.25d0
162 ! Warning message
163 CALL ancmsg(msgid=1651,msgtype=msgwarning,
164 . anmode=aninfo_blind_1,i1=mat_id,c1=titr)
165 ELSEIF (cdr < -twenty7/eight) THEN
166 cdr = -twenty7/eight
167 ! Warning message
168 CALL ancmsg(msgid=1652,msgtype=msgwarning,
169 . anmode=aninfo_blind_1,i1=mat_id,c1=titr)
170 ENDIF
171c
172 ! Value of the constant of Drucker criterion
173 kdr = (one/twenty7) - cdr*(four/twenty7/twenty7)
174 kdr = kdr**(one/six)
175 kdr = one/kdr
176c--------------------------
177 ! Storing parameters
178 uparam(1) = young ! Young modulus
179 uparam(2) = bulk ! Bulk modulus
180 uparam(3) = g ! Shear modulus
181 uparam(4) = g2 ! 2*Shear modulus
182 uparam(5) = lam ! Lambda (Hook)
183 uparam(6) = nu ! Poisson ratio
184 uparam(7) = nnu
185 uparam(8) = nnu1
186 uparam(9) = a1
187 uparam(10) = a2
188 uparam(11) = flagnice ! Choice of the return mapping algorithm
189 uparam(12) = cdr ! Drucker coefficient
190 uparam(13) = kdr ! Drucker K coefficient
191 uparam(14) = tini ! Initial temperature
192 uparam(15) = hp ! Linear hardening parameter
193 uparam(16) = yld0 ! Initial yield stress
194 uparam(17) = qvoce ! Voce parameter
195 uparam(18) = bvoce ! Voce parameter
196 uparam(19) = one ! ALPHA ! Swift / Voce interpolation coef
197 uparam(20) = jcc ! Johnson-Cook parameter
198 uparam(21) = epsp0 ! Johnson-Cook inviscid limit strain-rate
199 uparam(22) = mtemp ! Thermal softening
200 uparam(23) = tref ! Reference temperature
201 uparam(24) = eta ! Taylor-Quinney coefficient
202 uparam(25) = cp ! Thermal mass capacity
203 uparam(26) = dpis ! Isothermal plastic strain-rate
204 uparam(27) = dpad ! Adiabatic plastic strain-rate
205 uparam(28) = asrate ! Plastic strain-rate filtering period
206 uparam(29) = zero ! Free
207c
208c--- reserved for Gurson damage parameters
209c
210 uparam(30) = zero ! Gurson switch flag: default = 0 => no damage model
211 ! = 1 => local damage model
212 ! = 2 => non local micromorph damage model
213 ! = 3 => non local Peerling damage model
214 uparam(31) = zero ! reserved for Gurson
215 uparam(32) = zero ! reserved for Gurson
216 uparam(33) = zero ! reserved for Gurson
217 uparam(34) = zero ! reserved for Gurson
218 uparam(35) = zero ! reserved for Gurson
219 uparam(36) = zero ! reserved for Gurson
220 uparam(37) = zero ! reserved for Gurson
221 uparam(38) = zero ! reserved for Gurson
222 uparam(39) = zero ! reserved for Gurson
223 uparam(40) = zero ! reserved for Gurson
224c---------------------------
225 nfunc = 0
226 nuparam = 40
227 IF (flagnice == 1) THEN
228 nuvar = 1
229 ELSE
230 nuvar = 0
231 ENDIF
232 mtag%G_PLA = 1
233 mtag%L_PLA = 1
234 mtag%G_TEMP = 1
235 mtag%L_TEMP = 1
236 mtag%G_EPSD = 1
237 mtag%L_EPSD = 1
238 mtag%G_SEQ = 1
239 mtag%L_SEQ = 1
240c---------------------------
241 ! activate heat source calculation in material
242 matparam%HEAT_FLAG = 1
243!
244 CALL init_mat_keyword(matparam ,"ELASTO_PLASTIC")
245 CALL init_mat_keyword(matparam ,"INCREMENTAL" )
246 CALL init_mat_keyword(matparam ,"LARGE_STRAIN" )
247 CALL init_mat_keyword(matparam ,"HOOK")
248 ! Properties compatibility
249 CALL init_mat_keyword(matparam,"SOLID_ISOTROPIC")
250 CALL init_mat_keyword(matparam,"SHELL_ISOTROPIC")
251c---------------------------
252 parmat(1) = c1
253 parmat(2) = young
254 parmat(3) = nu
255 parmat(4) = zero ! ISRATE
256 parmat(5) = zero ! FCUT
257c Formulation for solid elements time step computation.
258 parmat(16) = 2
259 parmat(17) = (one - two*nu)/(one - nu)
260c
261 ! PM table
262 pm(1) = rho0
263 pm(89) = rho0
264c-----------------------------------------------------------------------
265 WRITE(iout,900) trim(titr),mat_id,ilaw
266 WRITE(iout,1000)
267 IF (is_encrypted) THEN
268 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
269 ELSE
270 WRITE(iout,1050) rho0
271 WRITE(iout,1100) young,nu ,cdr ,qvoce,bvoce,
272 . yld0, hp ,jcc ,epsp0,fcut,
273 . mtemp,tref ,tini,eta ,cp, dpis,dpad,
274 . flagnice
275 ENDIF
276c-----------
277 RETURN
278c-----------------------------------------------------------------------
279 900 FORMAT(/
280 & 5x,a,/,
281 & 5x,'MATERIAL NUMBER. . . . . . . . . . . . =',i10/,
282 & 5x,'MATERIAL LAW . . . . . . . . . . . . . =',i10/)
283 1000 FORMAT
284 &(5x,'MATERIAL MODEL : DRUCKER - VOCE - JOHNSON-COOK ',/,
285 & 5x,'-------------------------------------------------',/)
286 1050 FORMAT(
287 & 5x,'INITIAL DENSITY . . . . . . . . . . . . . . .=',1pg20.13/)
288 1100 FORMAT(
289 & 5x,'YOUNG MODULUS . . . . . . . . . . . . . . . .=',1pg20.13/
290 & 5x,'POISSON RATIO . . . . . . . . . . . . . . . .=',1pg20.13/
291 & 5x,'DRUCKER COEFFICIENT C . . . . . . . . . . . .=',1pg20.13/
292 & 5x,'YIELD VOCE PARAMETER Q. . . . . . . . . . . .=',1pg20.13/
293 & 5x,'YIELD VOCE PARAMETER B . . . . . . . . . . .=',1pg20.13/
294!
295 & 5x,'INITIAL YIELD STRESS YLD0 . . . . . . . . . .=',1pg20.13/
296 & 5x,'LINEAR HARDENING PARAMETER. . . . . . . . . .=',1pg20.13/
297 & 5x,'J-C STRAIN RATE COEFFICIENT C . . . . . . . .=',1pg20.13/
298 & 5x,'J-C REFERENCE STRAIN RATE . . . . . . . . . .=',1pg20.13/
299 & 5x,'PLASTIC STRAIN RATE CUTOFF FREQUENCY. . . . .=',1pg20.13/
300!
301 & 5x,'THERMAL SOFTENING SLOPE . . . . . . . . . . .=',1pg20.13/
302 & 5x,'REFERENCE TEMPERATURE . . . . . . . . . . . .=',1pg20.13/
303 & 5x,'INITIAL TEMPERATURE . . . . . . . . . . . . .=',1pg20.13/
304 & 5x,'TAYLOR-QUINNEY COEF . . . . . . . . . . . . .=',1pg20.13/
305 & 5x,'SPECIFIC HEAT . . . . . . . . . . . . . . . .=',1pg20.13/
306!
307 & 5x,'ISOTHERMAL PLASTIC STRAIN RATE. . . . . . . .=',1pg20.13/
308 & 5x,'ADIABATIC PLASTIC STRAIN RATE . . . . . . . .=',1pg20.13/
309!
310 & 5x,'RETURN MAPPING ALGORITHM FLAG . . . . . . . .=',i3/
311 & 5x,' IRES=1 NICE EXPLICIT (DEFAULT)'/
312 & 5x,' IRES=2 NEWTON-ITERATION IMPLICIT (CUTTING PLANE)'/)
313c-----------
314 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
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
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