OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat76.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_mat76 ../starter/source/materials/mat/mat076/hm_read_mat76.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!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
37!|| message_mod ../starter/share/message_module/message_mod.F
38!|| submodel_mod ../starter/share/modules1/submodel_mod.F
39!|| table_mod ../starter/share/modules1/table_mod.F
40!||====================================================================
41 SUBROUTINE hm_read_mat76(UPARAM ,MAXUPARAM,NUPARAM ,NUVAR ,IFUNC ,
42 . MAXFUNC ,NFUNC ,PARMAT ,UNITAB ,ID ,
43 . MTAG ,TITR ,LSUBMODEL,PM ,ISRATE ,
44 . MATPARAM ,MAXTABL ,NUMTABL ,ITABLE ,NVARTMP )
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-----------------------------------------------------------------------
346 END
#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 hm_read_mat76(uparam, maxuparam, nuparam, nuvar, ifunc, maxfunc, nfunc, parmat, unitab, id, mtag, titr, lsubmodel, pm, israte, matparam, maxtabl, numtabl, itable, nvartmp)
subroutine init_mat_keyword(matparam, keyword)
#define min(a, b)
Definition macros.h:20
#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:889
program starter
Definition starter.F:39