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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_mat76 (uparam, maxuparam, nuparam, nuvar, ifunc, maxfunc, nfunc, parmat, unitab, id, mtag, titr, lsubmodel, pm, israte, matparam, maxtabl, numtabl, itable, nvartmp)

Function/Subroutine Documentation

◆ hm_read_mat76()

subroutine hm_read_mat76 ( intent(inout) uparam,
integer, intent(in) maxuparam,
integer, intent(inout) nuparam,
integer, intent(inout) nuvar,
integer, dimension(maxfunc), intent(inout) ifunc,
integer, intent(in) maxfunc,
integer, intent(inout) nfunc,
intent(inout) parmat,
type (unit_type_), intent(in) unitab,
integer, intent(in) id,
type (mlaw_tag_), intent(inout) mtag,
character(len=nchartitle), intent(in) titr,
type (submodel_data), dimension(*), intent(in) lsubmodel,
intent(inout) pm,
integer, intent(inout) israte,
type (matparam_struct_), intent(inout) matparam,
integer, intent(in) maxtabl,
integer, intent(inout) numtabl,
integer, dimension(maxtabl), intent(inout) itable,
integer, intent(inout) nvartmp )

Definition at line 41 of file hm_read_mat76.F.

45C-----------------------------------------------
46C D e s c r i p t i o n
47C-----------------------------------------------
48C
49C DUMMY ARGUMENTS DESCRIPTION:
50C ===================
51C
52C NAME DESCRIPTION
53C
54C IPM MATERIAL ARRAY(INTEGER)
55C PM MATERIAL ARRAY(REAL)
56C UNITAB UNITS ARRAY
57C ID MATERIAL ID(INTEGER)
58C TITR MATERIAL TITLE
59C LSUBMODEL SUBMODEL STRUCTURE
60C
61C-----------------------------------------------
62C M o d u l e s
63C-----------------------------------------------
64 USE unitab_mod
65 USE elbuftag_mod
66 USE message_mod
67 USE submodel_mod
68 USE matparam_def_mod
70 USE table_mod
72C-----------------------------------------------
73C I m p l i c i t T y p e s
74C-----------------------------------------------
75#include "implicit_f.inc"
76C-----------------------------------------------
77C C o m m o n B l o c k s
78C-----------------------------------------------
79#include "units_c.inc"
80#include "param_c.inc"
81#include "com04_c.inc"
82C-----------------------------------------------
83C D u m m y A r g u m e n t s
84C-----------------------------------------------
85 INTEGER, INTENT(IN) :: ID,MAXFUNC,MAXTABL,MAXUPARAM
86 INTEGER, INTENT(INOUT) :: NFUNC
87 INTEGER, INTENT(INOUT) :: NUMTABL
88 INTEGER, INTENT(INOUT) :: NUPARAM
89 INTEGER, INTENT(INOUT) :: NUVAR
90 INTEGER, INTENT(INOUT) :: NVARTMP
91 INTEGER, INTENT(INOUT) :: ISRATE
92 my_real, DIMENSION(NPROPM) ,INTENT(INOUT) :: pm
93 my_real, DIMENSION(100) ,INTENT(INOUT) :: parmat
94 my_real, DIMENSION(MAXUPARAM) ,INTENT(INOUT) :: uparam
95 INTEGER, DIMENSION(MAXFUNC) ,INTENT(INOUT) :: IFUNC
96 INTEGER, DIMENSION(MAXTABL) ,INTENT(INOUT) :: ITABLE
97 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
98 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
99 TYPE (SUBMODEL_DATA),INTENT(IN) :: LSUBMODEL(*)
100 TYPE (MLAW_TAG_) ,INTENT(INOUT) :: MTAG
101 TYPE (MATPARAM_STRUCT_) ,INTENT(INOUT) :: MATPARAM
102 TYPE (TTABLE) TABLE(NTABLE)
103C-----------------------------------------------
104C L o c a l V a r i a b l e s
105C-----------------------------------------------
106 INTEGER :: IFORM,ICONV,IQUAD,ICAS,ISRAT,ILAW
107 my_real :: e,nu,g,rho0,rhor,fcut,nup,c1,a1,a2,epsr,epsf,
108 . xfac,xfac_unit
109 my_real :: tfac(3),yfac(2),fac_unit(5)
110 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED,FOUND
111C-----------------------------------------------
112C S o u r c e L i n e s
113C-----------------------------------------------
114 is_encrypted = .false.
115 is_available = .false.
116C--------------------------------------------------
117C EXTRACT DATA (IS OPTION CRYPTED)
118C--------------------------------------------------
119 CALL hm_option_is_encrypted(is_encrypted)
120C-----------------------------------------------
121 ilaw = 76
122Card1
123 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available,lsubmodel, unitab)
124 CALL hm_get_floatv('Refer_Rho',rhor ,is_available,lsubmodel, unitab)
125Card2
126 CALL hm_get_floatv('MAT_E' ,e ,is_available,lsubmodel, unitab)
127 CALL hm_get_floatv('MAT_NU' ,nu ,is_available,lsubmodel, unitab)
128Card3
129 CALL hm_get_intv ('FUN_D1' ,itable(1) ,is_available,lsubmodel)
130 CALL hm_get_intv ('FUN_D2' ,itable(2) ,is_available,lsubmodel)
131 CALL hm_get_intv ('FUN_D3' ,itable(3) ,is_available,lsubmodel)
132Card4
133 CALL hm_get_floatv('FScale11' ,tfac(1) ,is_available, lsubmodel, unitab)
134 CALL hm_get_floatv('FScale22' ,tfac(2) ,is_available, lsubmodel, unitab)
135 CALL hm_get_floatv('FScale33' ,tfac(3) ,is_available, lsubmodel, unitab)
136 CALL hm_get_floatv('FACX' ,xfac ,is_available, lsubmodel, unitab)
137Card5
138 CALL hm_get_floatv('MAT_NUt' ,nup ,is_available, lsubmodel, unitab)
139 CALL hm_get_intv ('FUN_B5' ,ifunc(1) ,is_available,lsubmodel)
140 CALL hm_get_floatv('MAT_PScale' ,yfac(1) ,is_available, lsubmodel, unitab)
141 CALL hm_get_intv ('ISRATE' ,israt ,is_available,lsubmodel)
142 CALL hm_get_floatv('MAT_asrate' ,fcut ,is_available, lsubmodel, unitab)
143Card6
144 CALL hm_get_floatv('MAT_Epsilon_F' ,epsf ,is_available, lsubmodel, unitab)
145 CALL hm_get_floatv('Epsilon_0' ,epsr ,is_available, lsubmodel, unitab)
146Card7
147 CALL hm_get_intv ('FUN_A1' ,ifunc(2) ,is_available,lsubmodel)
148 CALL hm_get_floatv('SCALE' ,yfac(2) ,is_available, lsubmodel, unitab)
149Card8
150 CALL hm_get_intv ('IFORM' ,iform ,is_available,lsubmodel)
151 CALL hm_get_intv ('MAT_Iflag' ,iquad ,is_available,lsubmodel)
152 CALL hm_get_intv ('Gflag' ,iconv ,is_available,lsubmodel)
153!-- unit
154 CALL hm_get_floatv_dim('FScale11' ,fac_unit(1) ,is_available, lsubmodel, unitab)
155 CALL hm_get_floatv_dim('FScale22' ,fac_unit(2) ,is_available, lsubmodel, unitab)
156 CALL hm_get_floatv_dim('FScale33' ,fac_unit(3) ,is_available, lsubmodel, unitab)
157 CALL hm_get_floatv_dim('FACX' ,xfac_unit ,is_available, lsubmodel, unitab)
158 CALL hm_get_floatv_dim('MAT_PScale' ,fac_unit(4) ,is_available, lsubmodel, unitab)
159 CALL hm_get_floatv_dim('SCALE' ,fac_unit(5) ,is_available, lsubmodel, unitab)
160C------------
161c input check
162C------------
163c
164 IF (fcut == zero) THEN
165 fcut = 500.0d0*unitab%FAC_T_WORK
166 END IF
167 israt = 0
168 israte = 0
169c
170 IF (itable(1) > 0 .AND. itable(2) > 0 .AND. itable(3) > 0) THEN
171 iconv = 1
172 ELSE
173 iconv = 0
174 ENDIF
175c
176 IF (itable(1) == 0) THEN
177 CALL ancmsg(msgid=126, msgtype=msgerror, anmode=aninfo,
178 . i1=id,
179 . c1=titr,
180 . i2=itable(1))
181 ENDIF
182C
183 IF (epsf == zero) epsf = infinity
184 IF (epsr == zero) epsr = two*epsf
185 IF (iform == 1 .AND. iquad == 0) iquad = 1
186C
187c-----------------------------------------
188c icas ifunt | ifunc | ifuncs
189c -1 1 | 1 | 1
190c 0 1 | 0 | 0
191c 1 1 | 1 | 0
192c 2 1 | 0 | 1
193c-----------------------------------------
194 icas = min(itable(2),1) + min(itable(3),1)
195 IF (icas == 2) icas = -1
196 IF (itable(2) > 0 .AND. icas == 1) icas = 1
197 IF (itable(3) > 0 .AND. icas == 1) icas = 2
198 nup = max(zero, min(nup, half))
199 IF(icas==0 .AND. nup == zero .AND. ifunc(1)==0)nup = half
200c
201 IF (xfac == zero) xfac = xfac_unit
202 IF (tfac(1) == zero) tfac(1) = fac_unit(1)
203 IF (tfac(2) == zero) tfac(2) = fac_unit(2)
204 IF (tfac(3) == zero) tfac(3) = fac_unit(3)
205 IF (yfac(1) == zero) yfac(1) = fac_unit(4)
206 IF (yfac(2) == zero) yfac(2) = fac_unit(5)
207C
208 g = half*e/( one + nu)
209 a1 = e*(one-nu) /((one + nu)*(one - two*nu))
210 a2 = a1*nu/(one - nu)
211 c1 = e/three/(one - two*nu)
212c-----------------------------------------------
213 uparam(1) = e
214 uparam(2) = e/(one - nu*nu)
215 uparam(3) = nu*uparam(2)
216 uparam(4) = g
217 uparam(5) = nu
218 uparam(6) = a1
219 uparam(7) = a2
220 uparam(8) = c1
221 uparam(9) = nup
222 uparam(10) = epsf
223 uparam(11) = epsr
224
225 uparam(13) = iform
226 uparam(14) = iquad
227 uparam(15) = iconv
228 uparam(16) = fcut*pi*two ! ASRATE
229 uparam(17) = icas
230 uparam(18) = one / xfac
231 uparam(19) = zero ! EPDT_MIN
232 uparam(20) = zero ! EPDT_MAX
233 uparam(21) = zero ! EPDC_MIN
234 uparam(22) = zero ! EPDC_MAX
235 uparam(23) = zero ! EPDS_MIN
236 uparam(24) = zero ! EPDS_MAX
237 uparam(25) = tfac(1)
238 uparam(26) = tfac(2)
239 uparam(27) = tfac(3)
240 uparam(28) = yfac(1)
241 uparam(29) = yfac(2)
242c
243 nuparam = 29
244 nuvar = 7
245 nvartmp = 8
246 nfunc = 2
247 numtabl = 3
248c
249c --------------------------
250 parmat(1) = c1
251 parmat(2) = e
252 parmat(3) = nu
253 parmat(4) = israte
254 parmat(5) = zero ! FCUT
255 parmat(16) = 2 ! Formulation for solid elements time step computation.
256 parmat(17) = (one - two*nu)/(one - nu) ! == TWO*G/(C1+FOUR_OVER_3*G)
257c
258 IF (rhor == zero) rhor=rho0
259 pm(1) = rhor
260 pm(89)= rho0
261 !!-----------------------
262 mtag%G_EPSD = 1
263 mtag%L_EPSD = 1
264 mtag%G_PLA = 1
265 mtag%L_PLA = 1
266 mtag%G_DMG = 1
267 mtag%L_DMG = 1
268c
269 matparam%NTABLE = 3
270 IF (icas == 0) THEN
271 CALL init_mat_keyword(matparam,"ELASTO_PLASTIC")
272 ELSE
273 CALL init_mat_keyword(matparam ,"COMPRESSIBLE")
274 ENDIF
275 CALL init_mat_keyword(matparam ,"INCREMENTAL" )
276 CALL init_mat_keyword(matparam ,"LARGE_STRAIN")
277 CALL init_mat_keyword(matparam ,"HOOK")
278C
279 ! Properties compatibility
280 CALL init_mat_keyword(matparam,"SOLID_ISOTROPIC")
281 CALL init_mat_keyword(matparam,"SHELL_ISOTROPIC")
282C-----------------------
283C
284 WRITE(iout,1010) trim(titr),id,76
285 WRITE(iout,1000)
286 IF (is_encrypted) THEN
287 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
288 ELSE
289 WRITE(iout,1020) rho0
290 WRITE(iout,1100) e,nu
291 WRITE(iout,1200) itable(1),tfac(1)
292 WRITE(iout,1210) itable(2),tfac(2)
293 WRITE(iout,1220) itable(3),tfac(3),xfac
294 WRITE(iout,1300) nup,ifunc(1),yfac(1),israte,fcut
295 WRITE(iout,1400) epsf,epsr,ifunc(2),yfac(2)
296 WRITE(iout,1500) iform,iquad,iconv
297 ENDIF
298c-----------
299 RETURN
300c-----------------------------------------------------------------------
301 1000 FORMAT(
302 & 5x,' SEMI ANALYTICAL PLASTIC LAW 76 ',/,
303 & 5x,' ------------------------------ ' ,//)
304 1010 FORMAT(/
305 & 5x,a,/,
306 & 5x,'MATERIAL NUMBER. . . . . . . . . . . . . . . =',i10/,
307 & 5x,'MATERIAL LAW . . . . . . . . . . . . . . . . =',i10/)
308 1020 FORMAT(
309 & 5x,'INITIAL DENSITY. . . . . . . . . . . . . . . =',1pg20.13/)
310 1100 FORMAT(
311 & 5x,'YOUNG''S MODULUS. . . . . . . . . . . . . . .=',1pg20.13/
312 & 5x,'POISSON''S RATIO. . . . . . . . . . . . . . .=',1pg20.13/)
313
314 1200 FORMAT(
315 & 5x,'TENSION YIELD STRESS FUNCTION NUMBER. . . . .=',i10/
316 & 5x,'YIELD SCALE FACTOR. . . . . . . . . . . . . .=',1pg20.13)
317 1210 FORMAT(
318 & 5x,'compression yield stress FUNCTION number. . .=',I10/
319 & 5X,'yield scale factor. . . . . . . . . . . . . .=',1PG20.13)
320
321 1220 FORMAT(
322 & 5X,'shear yield stress function number. . . . . .=',I10/
323 & 5X,'yield scale factor. . . . . . . . . . . . . .=',1PG20.13/
324 & 5X,'strain rate scale factor . . . . . . . . . .=',1PG20.13)
325
326 1300 FORMAT(
327 & 5X,'plastic poisson ratio . . . . . . . . . . =',1PG20.13/
328 & 5X,'plastic poisson ratio function number . . . =',I10/
329 & 5X,'yield scale factor. . . . . . . . . . . . . =',1PG20.13/
330 & 5X,'smooth strain rate option. . . . . . . . . . =',I10/
331 & 5X,'strain rate cutting frequency . . . . . . . .=',1PG20.13/)
332 1400 FORMAT(
333 & 5X,'failure plastic strain . . . . . . . . . . .=',1PG20.13/
334 & 5X,'rupture plastic strain. . . . . . . . . . . .=',1PG20.13/
335 & 5X,'damage function number . . . . . . . . . . =',I10/,
336 & 5X,'damage scale factor. . . . . . . . . . . . . =',1PG20.13 )
337 1500 FORMAT(
338 & 5X,'formulation flag . . . . . . . . . . . . . =', I10,/
339 & 5X,' = 0 no associated formulation ' ,/
340 & 5X,' = 1 vonmises associated formulation ' ,/
341 & 5X,' yield surface flag . . . . . . . . . . . . .=', I10,/
342 & 5X, ' = 0 yield surface is linear in the vonmises ',/
343 & 5X, ' = 1 yield surface is quadratic in the vonmises',/
344 & 5X, 'convexity condition . . . . . . . . . . . =',I10/)
345c-----------------------------------------------------------------------
#define my_real
Definition cppsort.cpp:32
end diagonal values have been computed in the(sparse) matrix id.SOL
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_floatv_dim(name, dim_fac, 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 min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21
initmumps id
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