OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat79.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_mat79 (uparam, maxuparam, nuparam, nuvar, nfunc, maxfunc, ifunc, parmat, mat_id, pm, israte, mtag, titr, unitab, lsubmodel, matparam)

Function/Subroutine Documentation

◆ hm_read_mat79()

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

Definition at line 38 of file hm_read_mat79.F.

43C-----------------------------------------------
44C D e s c r i p t i o n
45C-----------------------------------------------
46C READ MAT LAW79 WITH HM READER
47C-----------------------------------------------
48C M o d u l e s
49C-----------------------------------------------
50 USE unitab_mod
51 USE message_mod
52 USE submodel_mod
53 USE matparam_def_mod
54 USE elbuftag_mod
55 USE names_and_titles_mod , ONLY : nchartitle
56C-----------------------------------------------
57C I m p l i c i t T y p e s
58C-----------------------------------------------
59#include "implicit_f.inc"
60C-----------------------------------------------
61C C o m m o n B l o c k s
62C-----------------------------------------------
63#include "units_c.inc"
64#include "param_c.inc"
65C-----------------------------------------------
66C D u m m y A r g u m e n t s
67C-----------------------------------------------
68 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
69 my_real, INTENT(INOUT) :: parmat(100), uparam(maxuparam), pm(npropm)
70 INTEGER, INTENT(INOUT) :: IFUNC(MAXFUNC), NFUNC, MAXFUNC, MAXUPARAM,
71 . NUPARAM, NUVAR, ISRATE
72 INTEGER, INTENT(IN) :: MAT_ID
73 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
74 TYPE(SUBMODEL_DATA),INTENT(IN) :: LSUBMODEL(*)
75 TYPE(MLAW_TAG_), INTENT(INOUT) :: MTAG
76 TYPE(MATPARAM_STRUCT_) ,INTENT(INOUT) :: MATPARAM
77C-----------------------------------------------
78C L o c a l V a r i a b l e s
79C-----------------------------------------------
80 INTEGER MATS,IFLAG1,IFLAG2,ITEMAX,IDEL
81 my_real
82 . shear, aa, bb, mm, nn, cc, eps0, sigfmax, tmax, hel, phel,
83 . d1, d2, k1, k2, k3, beta, young, nu, rho0, rhor, asrate,
84 . epsmax
85 LOGICAL :: IS_ENCRYPTED, IS_AVAILABLE
86C-----------------------------------------------
87C S o u r c e
88C-----------------------------------------------
89
90 is_encrypted = .false.
91 is_available = .false.
92
93 CALL hm_option_is_encrypted(is_encrypted)
94C----------------------------------------------------------------
95C #RhoO rho_ref
96 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
97 CALL hm_get_floatv('refer_rho' ,RHOR ,IS_AVAILABLE, LSUBMODEL, UNITAB)
98C----------------------------------------------------------------
99C #G
100 CALL HM_GET_FLOATV('tau_shear', SHEAR, IS_AVAILABLE, LSUBMODEL, UNITAB)
101C----------------------------------------------------------------
102C #a b m n
103 CALL HM_GET_FLOATV('mat_a', AA, IS_AVAILABLE, LSUBMODEL, UNITAB)
104 CALL HM_GET_FLOATV('mat_b', bb, is_available, lsubmodel, unitab)
105 CALL hm_get_floatv('MAT_M', mm, is_available, lsubmodel, unitab)
106 CALL hm_get_floatv('MAT_N', nn, is_available, lsubmodel, unitab)
107C----------------------------------------------------------------
108C #c epsp_0 sigma_f_max
109 CALL hm_get_floatv('MAT_C', cc, is_available, lsubmodel, unitab)
110 CALL hm_get_floatv('MAT_Epsilon_F', eps0, is_available, lsubmodel, unitab)
111 CALL hm_get_floatv('MAT_SIG1max_t', sigfmax, is_available, lsubmodel, unitab)
112 CALL hm_get_floatv('MAT_FCUT', asrate, is_available, lsubmodel, unitab)
113C----------------------------------------------------------------
114C #T HEL PHEL
115 CALL hm_get_floatv('MAT_T0', tmax, is_available, lsubmodel, unitab)
116 CALL hm_get_floatv('MAT_E', hel, is_available, lsubmodel, unitab)
117 CALL hm_get_floatv('MAT_EPS', phel, is_available, lsubmodel, unitab)
118C----------------------------------------------------------------
119C #D1 D2 IDEL EPSMAX
120 CALL hm_get_floatv('D1' , d1, is_available, lsubmodel, unitab)
121 CALL hm_get_floatv('D2' , d2, is_available, lsubmodel, unitab)
122 CALL hm_get_intv ('IDEL',idel, is_available, lsubmodel)
123 CALL hm_get_floatv('EPSMAX',epsmax, is_available, lsubmodel, unitab)
124C----------------------------------------------------------------
125C #K1 K2 K3 BETA
126 CALL hm_get_floatv('K1', k1, is_available, lsubmodel, unitab)
127 CALL hm_get_floatv('K2', k2, is_available, lsubmodel, unitab)
128 CALL hm_get_floatv('K3', k3, is_available, lsubmodel, unitab)
129 CALL hm_get_floatv('MAT_Beta', beta, is_available, lsubmodel, unitab)
130
131 nuvar = 2
132 pm(1) = rhor
133 pm(89) = rho0
134
135C Memory allocation flags
136 mtag%G_EPSD = 1
137 mtag%L_EPSD = 1
138 mtag%G_PLA = 1
139 mtag%L_PLA = 1
140 mtag%G_DMG = 1
141 mtag%L_DMG = 1
142C
143 !----------------------------------------------------------
144 ! Activation of strain-rate filtering
145 IF (asrate /= zero) THEN
146 israte = 1
147 ELSE
148 israte = 0
149 ENDIF
150 ! Check flag for element deletion
151 idel = min(idel,3)
152 idel = max(0,idel)
153 ! Critical plastic strain
154 IF (epsmax == zero) epsmax = infinity
155 !----------------------------------------------------------
156C----------
157C DEFAULT
158C----------
159 IF(cc==zero) eps0 = one
160 IF(sigfmax==zero) sigfmax=infinity
161C--------
162C ERRORS
163C--------
164 IF(phel > hel) THEN
165 CALL ancmsg(msgid=907,
166 . msgtype=msgerror,
167 . anmode=aninfo,
168 . i1=mat_id,
169 . c1=titr)
170 ENDIF
171 IF(shear <= zero)THEN
172 CALL ancmsg(msgid=908,
173 . msgtype=msgerror,
174 . anmode=aninfo,
175 . i1=mat_id,
176 . c1=titr)
177 ENDIF
178 IF(k1 <= zero)THEN
179 CALL ancmsg(msgid=909,
180 . msgtype=msgerror,
181 . anmode=aninfo,
182 . i1=mat_id,
183 . c1=titr)
184 ENDIF
185 IF(eps0 <= zero)THEN
186 CALL ancmsg(msgid=910,
187 . msgtype=msgerror,
188 . anmode=aninfo,
189 . i1=mat_id,
190 . c1=titr)
191 ENDIF
192 IF(beta < zero .OR. beta > one)THEN
193 CALL ancmsg(msgid=911,
194 . msgtype=msgerror,
195 . anmode=aninfo,
196 . i1=mat_id,
197 . c1=titr)
198 ENDIF
199C
200
201C
202 uparam(1) = shear
203 uparam(2) = two*shear
204 uparam(3) = aa
205 uparam(4) = bb
206 uparam(5) = mm
207 uparam(6) = nn
208 uparam(7) = cc
209 uparam(8) = eps0
210 uparam(9) = sigfmax
211 uparam(10)= tmax/phel
212 uparam(11)= phel
213 uparam(12)= three_half*(hel-phel)
214 uparam(13)= d1
215 uparam(14)= d2
216 uparam(15)= k1
217 uparam(16)= k2
218 uparam(17)= k3
219 uparam(18)= beta
220 uparam(19)= idel
221 uparam(20)= epsmax
222 nuparam= 20
223C
224 nu=(three*k1-two*shear)/(six*k1+two*shear)
225 young=nine*k1*shear/(three*k1+shear)
226 parmat(1) = k1
227 parmat(2) = young
228 parmat(3) = nu
229 parmat(4) = israte
230 parmat(5) = asrate
231C
232 ! Properties compatibility
233 CALL init_mat_keyword(matparam,"SOLID_ISOTROPIC")
234 CALL init_mat_keyword(matparam,"SPH")
235C
236 WRITE(iout, 900) trim(titr),mat_id,79
237 WRITE(iout,1000)
238 IF(is_encrypted)THEN
239 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
240 ELSE
241 WRITE(iout,1050) rho0
242 WRITE(iout,1100) shear, aa, bb, mm, nn, cc, eps0, sigfmax
243 WRITE(iout,1200) tmax, hel, phel, d1, d2, idel, epsmax
244 WRITE(iout,1300) k1, k2, k3, beta
245 WRITE(iout,1400) young, nu
246 IF (israte > 0) WRITE(iout,1500) asrate
247 ENDIF
248C
249 RETURN
250C
251 900 FORMAT(/
252 & 5x,a,/,
253 & 5x,'MATERIAL NUMBER. . . . . . . . . . . . . . .=',i10/,
254 & 5x,'MATERIAL LAW . . . . . . . . . . . . . . . .=',i10/)
255 1000 FORMAT(
256 & 5x,' JOHNSON HOLMQUIST MATERIAL',/,
257 & 5x,' --------------------------',//)
258 1050 FORMAT(
259 & 5x,'INITIAL DENSITY . . . . . . . . . . . . . .=',1pg20.13/)
260 1100 FORMAT(
261 & 5x,'SHEAR MODULUS . . . . . . . . . . . . . . .=',1pg20.13/,
262 & 5x,'INTACT STRENGTH CONSTANT (A). . . . . . . .=',1pg20.13/,
263 & 5x,'fractured strength constant(b) . . . . . .=',1PG20.13/,
264 & 5X,'fractured strength exponent(m) . . . . . .=',1PG20.13/,
265 & 5X,'intact strength exponent(n). . . . . . . .=',1PG20.13/,
266 & 5X,'strain rate coefficient(c) . . . . . . . .=',1PG20.13/,
267 & 5X,'reference strain rate . . . . . . . . . . .=',1PG20.13/,
268 & 5X,'maximum normalized fractured strength . . .=',1PG20.13//)
269 1200 FORMAT(
270 & 5X,'maximum pressure tensile strength . . . . .=',1PG20.13/,
271 & 5X,'hugoniot elastic limit(hel). . . . . . . .=',1PG20.13/,
272 & 5X,'pressure at hugoniot elastic limit. . . . .=',1PG20.13/,
273 & 5X,'damage constant(d1). . . . . . . . . . . .=',1PG20.13/,
274 & 5X,'damage exponent(d2). . . . . . . . . . . .=',1PG20.13/,
275 & 5X,'element deletion flag(idel). . . . . . . .=',I10/,
276 & 5X,' idel = 0: no element deletion ',/,
277 & 5X,' idel = 1: element deletion in tension only ',/,
278 & 5X,' idel = 2: element deletion IF plastic strain > epsmax',/,
279 & 5X,' idel = 3: element deletion IF damage = 1.0 ',/,
280 & 5X,'critical plastic strain(epsmax). . . . . .=',1PG20.13/)
281 1300 FORMAT(
282 & 5X,'bulk modulus(k1) . . . . . . . . . . . . .=',1PG20.13/
283 & 5X,'pressure coefficient(k2) . . . . . . . . .=',1PG20.13/
284 & 5X,'pressure coefficient(k3) . . . . . . . . .=',1PG20.13/
285 & 5X,'bulking pressure coefficient (beta) . . . .=',1PG20.13)
286 1400 FORMAT(
287 & 5X,'young',1H','S MODULUS . . . . . . . . . . . . . .=',1pg20.13/,
288 & 5x,'POISSON',1h','s ratio . . . . . . . . . . . . . .=',1PG20.13/)
289 1500 FORMAT(
290 & 5X,'strain rate filtering frequency . . . . . .=',1PG20.13/)
291C
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
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
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