OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat121.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_mat121 ../starter/source/materials/mat/mat121/hm_read_mat121.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_floatv_dim ../starter/source/devtools/hm_reader/hm_get_floatv_dim.F
31!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
32!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
33!|| init_mat_keyword ../starter/source/materials/mat/init_mat_keyword.f
34!||--- uses -----------------------------------------------------
35!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
36!|| message_mod ../starter/share/message_module/message_mod.F
37!|| submodel_mod ../starter/share/modules1/submodel_mod.F
38!||====================================================================
39 SUBROUTINE hm_read_mat121(
40 . UPARAM ,MAXUPARAM,NUPARAM ,NUVAR ,MAXFUNC ,
41 . NFUNC ,IFUNC ,MTAG ,PARMAT ,UNITAB ,
42 . PM ,LSUBMODEL,ISRATE ,MAT_ID ,TITR ,
43 . MATPARAM )
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE unitab_mod
48 USE message_mod
49 USE submodel_mod
50 USE elbuftag_mod
51 USE matparam_def_mod
52 USE names_and_titles_mod , ONLY : nchartitle
53C-----------------------------------------------
54C I m p l i c i t T y p e sXM
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "units_c.inc"
61#include "param_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 TYPE (UNIT_TYPE_),INTENT(IN) :: UNITAB
66 INTEGER, INTENT(IN) :: MAT_ID,MAXUPARAM,MAXFUNC
67 my_real, DIMENSION(NPROPM) ,INTENT(INOUT) :: PM
68 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
69 INTEGER, INTENT(INOUT) :: ISRATE,IFUNC(MAXFUNC)
70 INTEGER, INTENT(INOUT) :: NUPARAM,NUVAR,NFUNC
71 my_real, DIMENSION(MAXUPARAM) ,INTENT(INOUT) :: uparam
72 my_real, DIMENSION(100),INTENT(INOUT) :: parmat
73 TYPE(submodel_data), DIMENSION(*),INTENT(IN) :: LSUBMODEL
74 TYPE(mlaw_tag_), INTENT(INOUT) :: MTAG
75 TYPE(matparam_struct_) ,INTENT(INOUT) :: MATPARAM
76C-----------------------------------------------
77C L o c a l V a r i a b l e s
78C-----------------------------------------------
79 INTEGER I,J,K,ILAW,Ires,Ivisc,Ifail,Fct_SIG0,
80 . Fct_YOUN,Fct_TANG,Fct_FAIL
81C REAL
82 my_real
83 . rho0,young,nu,a,g,g2,lam,bulk,nnu,nnu1,fcut,dtmin,
84 . xscale_sig0,yscale_sig0,xscale_youn,yscale_youn,
85 . xscale_tang,xscale_fail,yscale_fail,
86 . xscale_unit,yscale_unit,a11,a12,tang
87C
88 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
89C=======================================================================
90 IS_ENCRYPTED = .false.
91 is_available = .false.
92 ilaw = 121
93c------------------------------------------
94 CALL hm_option_is_encrypted(is_encrypted)
95c------------------------------------------
96c
97card1 - Density
98 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available,lsubmodel,unitab)
99card2 - Elasticity, flags, strain-rate filtering
100 CALL hm_get_floatv('MAT_E' ,young ,is_available,lsubmodel,unitab)
101 CALL hm_get_floatv('MAT_NU' ,nu ,is_available,lsubmodel,unitab)
102 CALL hm_get_intv ('MAT_Ires' ,ires ,is_available,lsubmodel)
103 CALL hm_get_intv ('MAT_Ivisc' ,ivisc ,is_available,lsubmodel)
104 CALL hm_get_floatv('Fcut' ,fcut ,is_available,lsubmodel,unitab)
105 CALL hm_get_floatv('TDEL' ,dtmin ,is_available,lsubmodel,unitab)
106card3 - Function for Initial yield stress versus strain-rate
107 CALL hm_get_intv ('Fct_SIG0' ,fct_sig0 ,is_available,lsubmodel)
108 CALL hm_get_floatv('Xscale_SIG0',xscale_sig0,is_available,lsubmodel,unitab)
109 IF ((fct_sig0 /= 0).AND.(xscale_sig0 == zero)) THEN
110 CALL hm_get_floatv_dim('Xscale_SIG0',xscale_unit,is_available,lsubmodel,unitab)
111 xscale_sig0 = one * xscale_unit
112 ENDIF
113 CALL hm_get_floatv('Yscale_SIG0',yscale_sig0,is_available,lsubmodel,unitab)
114 IF ((fct_sig0 /= 0).AND.(yscale_sig0 == zero)) THEN
115 CALL hm_get_floatv_dim('Yscale_SIG0',yscale_unit,is_available,lsubmodel,unitab)
116 yscale_sig0 = one * yscale_unit
117 ENDIF
118card4 - Function for Young modulus versus strain-rate
119 CALL hm_get_intv ('Fct_YOUN' ,fct_youn ,is_available,lsubmodel)
120 CALL hm_get_floatv('Xscale_YOUN',xscale_youn,is_available,lsubmodel,unitab)
121 IF ((fct_youn /= 0).AND.(xscale_youn == zero)) THEN
122 CALL hm_get_floatv_dim('Xscale_YOUN',xscale_unit,is_available,lsubmodel,unitab)
123 xscale_youn = one * xscale_unit
124 ENDIF
125 CALL hm_get_floatv('Yscale_YOUN',yscale_youn,is_available,lsubmodel,unitab)
126 IF ((fct_youn /= 0).AND.(yscale_youn == zero)) THEN
127 CALL hm_get_floatv_dim('Yscale_YOUN',yscale_unit,is_available,lsubmodel,unitab)
128 yscale_youn = one * yscale_unit
129 ENDIF
130card5 - Function for Initial yield stress versus strain-rate
131 CALL hm_get_intv ('Fct_TANG' ,fct_tang ,is_available,lsubmodel)
132 CALL hm_get_floatv('Xscale_TANG',xscale_tang,is_available,lsubmodel,unitab)
133 IF ((fct_tang /= 0).AND.(xscale_tang == zero)) THEN
134 CALL hm_get_floatv_dim('Xscale_TANG',xscale_unit,is_available,lsubmodel,unitab)
135 xscale_tang = one * xscale_unit
136 ENDIF
137 CALL hm_get_floatv('MAT_TANG' ,tang ,is_available,lsubmodel,unitab)
138 IF ((fct_tang /= 0).AND.(tang == zero)) THEN
139 CALL hm_get_floatv_dim('MAT_TANG',yscale_unit,is_available,lsubmodel,unitab)
140 tang = one * yscale_unit
141 ENDIF
142card6 - Function for Initial yield stress versus strain-rate
143 CALL hm_get_intv ('Fct_FAIL' ,fct_fail ,is_available,lsubmodel)
144 CALL hm_get_intv ('MAT_Ifail' ,ifail ,is_available,lsubmodel)
145 CALL hm_get_floatv('Xscale_FAIL',xscale_fail,is_available,lsubmodel,unitab)
146 IF ((fct_fail /= 0).AND.(xscale_fail == zero)) THEN
147 CALL hm_get_floatv_dim('Xscale_FAIL',xscale_unit,is_available,lsubmodel,unitab)
148 xscale_fail = one * xscale_unit
149 ENDIF
150 CALL hm_get_floatv('Yscale_FAIL',yscale_fail,is_available,lsubmodel,unitab)
151 IF ((fct_fail /= 0).AND.(yscale_fail == zero)) THEN
152 CALL hm_get_floatv_dim('Yscale_FAIL',yscale_unit,is_available,lsubmodel,unitab)
153 yscale_fail = one * yscale_unit
154 ENDIF
155c
156c-----------------------------
157c Default values and check
158c-----------------------------
159 ! Elasticity parameter
160 g2 = young / (one + nu)
161 g = half * g2
162 lam = g2 * nu /(one - two*nu)
163 bulk = third * young / (one - nu*two)
164 nnu = nu / (one - nu)
165 nnu1 = one - nnu
166 a11 = young / (one - nu*nu)
167 a12 = a11 * nu
168 ! Return mapping algorithm
169 IF ((ires == 0).OR.(ires > 2)) ires = 2
170 ! Strain rate dependency formulation flag
171 ivisc = min(max(ivisc,0),1)
172 ! Failure criterion flag
173 ifail = min(max(ifail,0),3)
174 ! Check initial yield stress function is defined
175 IF ((fct_sig0 == 0).AND.(yscale_sig0 == zero)) THEN
176 CALL ancmsg(msgid=2060,
177 . msgtype=msgerror,
178 . anmode=aninfo_blind_2,
179 . i1=mat_id,
180 . c1=titr)
181 ENDIF
182 ! Check young
183 IF ((ivisc == 1).AND.(fct_youn > 0)) THEN
184 CALL ancmsg(msgid=2061,
185 . msgtype=msgwarning,
186 . anmode=aninfo_blind_2,
187 . i1=mat_id,
188 . c1=titr,
189 . i2=fct_youn)
190 ivisc = 0
191 ENDIF
192 ! Poisson's ratio
193 IF (nu < zero .OR. nu >= half) THEN
194 CALL ancmsg(msgid=49,
195 . msgtype=msgerror,
196 . anmode=aninfo_blind_2,
197 . r1=nu,
198 . i1=mat_id,
199 . c1=titr)
200 ENDIF
201 ! Strain-rate filtering frequency
202 IF (fcut == zero) THEN
203 fcut = 10000.0d0*unitab%FAC_T_WORK
204 ENDIF
205 ! Timestep failure criterion
206 IF (dtmin == zero) dtmin = -infinity
207c
208c--------------------------
209c Filling buffer tables
210c--------------------------
211 ! Number of material parameters
212 nuparam = 23
213 ! Number of functions
214 nfunc = 4
215 ! Number of user variables
216 IF (ires == 1) THEN
217 IF (ivisc == 0) THEN
218 nuvar = 1
219 ELSE
220 nuvar = 3
221 ENDIF
222 ELSE
223 nuvar = 0
224 ENDIF
225c
226 ! Material parameters
227 uparam(1) = young ! Young modulus
228 uparam(2) = bulk ! Bulk modulus
229 uparam(3) = g ! Shear modulus
230 uparam(4) = g2 ! 2*Shear modulus
231 uparam(5) = lam ! Lambda (Hook)
232 uparam(6) = nu ! Poisson ratio
233 uparam(7) = nnu
234 uparam(8) = nnu1
235 uparam(9) = a11
236 uparam(10) = a12
237 uparam(11) = ires
238 uparam(12) = ivisc
239 uparam(13) = ifail
240 uparam(14) = fcut
241 uparam(15) = dtmin
242 uparam(16) = xscale_sig0
243 uparam(17) = yscale_sig0
244 uparam(18) = xscale_youn
245 uparam(19) = yscale_youn
246 uparam(20) = xscale_tang
247 uparam(21) = tang
248 uparam(22) = xscale_fail
249 uparam(23) = yscale_fail
250c
251 ! Function IDs
252 ifunc(1) = fct_sig0
253 ifunc(2) = fct_youn
254 ifunc(3) = fct_tang
255 ifunc(4) = fct_fail
256c
257 ! PARMAT table
258 parmat(1) = bulk
259 parmat(2) = young
260 parmat(3) = nu
261 parmat(4) = zero
262 parmat(5) = zero
263 israte = 0
264c
265 ! PM table
266 pm(1) = rho0
267 pm(89) = rho0
268 pm(27) = sqrt((bulk + four_over_3*g)/rho0) ! sound speed estimation
269 pm(100)= bulk
270c
271 ! MTAG variable activation
272 mtag%G_PLA = 1
273 mtag%L_PLA = 1
274 mtag%L_EPSD = 1
275 mtag%G_EPSD = 1
276c
277 CALL init_mat_keyword(matparam ,"ELASTO_PLASTIC")
278 CALL init_mat_keyword(matparam ,"INCREMENTAL" )
279 CALL init_mat_keyword(matparam ,"LARGE_STRAIN")
280 CALL init_mat_keyword(matparam ,"HOOK")
281c
282 ! Properties compatibility
283 CALL init_mat_keyword(matparam,"SOLID_ISOTROPIC")
284 CALL init_mat_keyword(matparam,"SHELL_ISOTROPIC")
285 CALL init_mat_keyword(matparam,"SPH")
286c
287c--------------------------
288c Parameters printout
289c--------------------------
290 WRITE(iout,1000) trim(titr),mat_id,ilaw
291 WRITE(iout,1100)
292 IF (is_encrypted) THEN
293 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
294 ELSE
295 WRITE(iout,1200) rho0
296 WRITE(iout,1300) young,nu
297 WRITE(iout,1350) ires
298 WRITE(iout,1360) ivisc
299 WRITE(iout,1370) ifail
300 IF (ivisc == 0) THEN
301 WRITE(iout,1380) fcut
302 ENDIF
303 IF (fct_sig0 > 0) THEN
304 WRITE(iout,1400) fct_sig0,xscale_sig0,yscale_sig0
305 ELSE
306 WRITE(iout,1450) yscale_sig0
307 ENDIF
308 IF (fct_youn > 0) THEN
309 WRITE(iout,1500) fct_youn,xscale_youn,yscale_youn
310 ENDIF
311 IF (fct_tang > 0) THEN
312 WRITE(iout,1600) fct_tang,xscale_tang,tang
313 ELSE
314 WRITE(iout,1650) tang
315 ENDIF
316 IF (fct_fail > 0) THEN
317 WRITE(iout,1700) fct_fail,xscale_fail,yscale_fail
318 ENDIF
319 IF (dtmin > zero) THEN
320 WRITE(iout,1800) dtmin
321 ENDIF
322 ENDIF
323c-----------------------------------------------------------------------
324 1000 FORMAT(/
325 & 5x,a,/,
326 & 5x,'MATERIAL NUMBER. . . . . . . . . . . . =',i10/,
327 & 5x,'MATERIAL LAW . . . . . . . . . . . . . =',i10/)
328 1100 FORMAT
329 &(5x,'MATERIAL MODEL : RATE DEPENDENT PLASTICITY',/,
330 & 5x,'------------------------------------------',/)
331 1200 FORMAT(
332 & 5x,'INITIAL DENSITY . . . . . . . . . . . .=',1pg20.13/)
333 1300 FORMAT(
334 & 5x,'YOUNG MODULUS . . . . . . . . . . . . .=',1pg20.13/
335 & 5x,'POISSON RATIO . . . . . . . . . . . . .=',1pg20.13/)
336 1350 FORMAT(
337 & 5x,'RETURN MAPPING ALGORITHM FLAG . . . . .=',i3/
338 & 5x,' IRES=1 NICE EXPLICIT'/
339 & 5x,' IRES=2 NEWTON-ITERATION IMPLICIT (CUTTING PLANE)'/)
340 1360 FORMAT(
341 & 5x,'VISCOSITY FORMULATION FLAG. . . . . . .=',i3/
342 & 5x,' IVISC=0 SCALED YIELD STRESS FORMULATION'/
343 & 5x,' IVISC=1 FULL VISCOPLASTIC FORMULATION'/)
344 1370 FORMAT(
345 & 5x,'FAILURE CRITERION FLAG . . . . . . . .=',i3/
346 & 5x,' IFAIL=0 MAXIMUM VON MISES STRESS'/
347 & 5x,' IFAIL=1 MAXIMUM PLASTIC STRAIN'/
348 & 5x,' IFAIL=2 MAX. PRINC STRESS + ABSOLUTE VALUE OF MIN. PRINC. STRESS'/
349 & 5x,' IFAIL=3 MAXIMUM PRINCIPAL STRESS'/)
350 1380 FORMAT(
351 & 5x,'STRAIN-RATE FILTERING CUTOFF FREQUENCY.=',1pg20.13/)
352 1400 FORMAT(
353 & 5x,'INITIAL YIELD STRESS FUNCTION ID. . . .=',i10/
354 & 5x,'STRAIN-RATE SCALE FACTOR. . . . . . . .=',1pg20.13/
355 & 5x,'YIELD STRESS SCALE FACTOR . . . . . . .=',1pg20.13/)
356 1450 FORMAT(
357 & 5x,'CONSTANT INITIAL YIELD STRESS . . . . .=',1pg20.13/)
358 1500 FORMAT(
359 & 5x,'YOUNG MODULUS FUNCTION ID . . . . . . .=',i10/
360 & 5x,'STRAIN-RATE SCALE FACTOR. . . . . . . .=',1pg20.13/
361 & 5x,'YOUNG MODULUS SCALE FACTOR . . . . . .=',1pg20.13/)
362 1600 FORMAT(
363 & 5x,'TANGENT MODULUS FUNCTION ID . . . . . .=',i10/
364 & 5x,'STRAIN-RATE SCALE FACTOR. . . . . . . .=',1pg20.13/
365 & 5x,'TANGENT MODULUS SCALE FACTOR . . . . .=',1pg20.13/)
366 1650 FORMAT(
367 & 5x,'CONSTANT TANGENT MODULUS . . . . . . .=',1pg20.13/)
368 1700 FORMAT(
369 & 5x,'FAILURE CRITERION STRESS FUNCTION ID .=',i10/
370 & 5x,'STRAIN-RATE SCALE FACTOR. . . . . . . .=',1pg20.13/
371 & 5x,'ORDINATE SCALE FACTOR . . . . . . . . .=',1pg20.13/)
372 1800 FORMAT(
373 & 5x,'MINIMUM TIMESTEP FOR ELEMENT DELETION .=',1pg20.13/)
374c-----------------------------------------------------------------------
375 END
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_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
hm_read_mat121
subroutine hm_read_mat121(uparam, maxuparam, nuparam, nuvar, maxfunc, nfunc, ifunc, mtag, parmat, unitab, pm, lsubmodel, israte, mat_id, titr, matparam)
Definition hm_read_mat121.F:44
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
starter
program starter
Definition starter.F:39
elbuftag_mod::mlaw_tag_
Definition elbuftag_mod.F:232
submodel_mod::submodel_data
Definition submodel_mod.F:723