OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat60.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_mat60 ../starter/source/materials/mat/mat060/hm_read_mat60.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_mat60(UPARAM ,MAXUPARAM,NUPARAM ,ISRATE , IMATVIS ,
40 . NUVAR ,IFUNC ,MAXFUNC ,NFUNC , PARMAT ,
41 . UNITAB ,MAT_ID ,TITR ,MTAG , LSUBMODEL,
42 . PM ,IPM ,MATPARAM )
43C-----------------------------------------------
44C D e s c r i p t i o n
45C-----------------------------------------------
46C READ MAT LAW60 WITH HM READER
47C
48C DUMMY ARGUMENTS DESCRIPTION:
49C ===================
50C
51C NAME DESCRIPTION
52C
53C PM MATERIAL ARRAY(REAL)
54C UNITAB UNITS ARRAY
55C ID MATERIAL ID(INTEGER)
56C TITR MATERIAL TITLE
57C LSUBMODEL SUBMODEL STRUCTURE
58C
59C-----------------------------------------------
60C M o d u l e s
61C-----------------------------------------------
62 USE unitab_mod
63 USE elbuftag_mod
64 USE message_mod
65 USE submodel_mod
66 USE matparam_def_mod
68C-----------------------------------------------
69C I m p l i c i t T y p e s
70C-----------------------------------------------
71#include "implicit_f.inc"
72C-----------------------------------------------
73C C o m m o n B l o c k s
74C-----------------------------------------------
75#include "units_c.inc"
76#include "param_c.inc"
77C-----------------------------------------------
78C D u m m y A r g u m e n t s
79C-----------------------------------------------
80 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
81 my_real, INTENT(INOUT) :: PM(NPROPM),PARMAT(100),UPARAM(MAXUPARAM)
82 INTEGER, INTENT(INOUT) :: IPM(NPROPMI),ISRATE,IFUNC(MAXFUNC),NFUNC,MAXFUNC,MAXUPARAM,NUPARAM, NUVAR,IMATVIS
83 TYPE(mlaw_tag_),INTENT(INOUT) :: MTAG
84 INTEGER,INTENT(IN) :: MAT_ID
85 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
86 TYPE(submodel_data),INTENT(IN) :: LSUBMODEL(NSUBMOD)
87 TYPE(matparam_struct_) ,INTENT(INOUT) :: MATPARAM
88C-----------------------------------------------
89C L o c a l V a r i a b l e s
90C-----------------------------------------------
91 my_real
92 . e,nu,g,c1,epsmax,epsr1,epsr2,fisokin,rate(11),yfac(11),
93 . pscale,fac_l,fac_t,fac_m,fac_c,escale,einf,ce,asrate
94 INTEGER NRATE,J,I,IU,IFUNCE,ISRATE_LOC,MFUNC,OPTE,IPFUN
95 my_real :: RHO0, RHOR, PSCALE_UNIT
96 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
97C-----------------------------------------------
98C S o u r c e L i n e s
99C-----------------------------------------------
100 is_encrypted = .false.
101 is_available = .false.
102 israte = 1
103 imatvis = 0
104 mtag%G_EPSD = 1
105 mtag%L_EPSD = 1
106 mtag%G_PLA = 1
107 mtag%L_PLA = 1
108
109 !---READING
110 CALL hm_option_is_encrypted(is_encrypted)
111 !line+1
112 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
113 CALL hm_get_floatv('Refer_Rho' ,rhor ,is_available, lsubmodel, unitab)
114 !line-2
115 CALL hm_get_floatv('MAT_E' ,e ,is_available, lsubmodel, unitab)
116 CALL hm_get_floatv('MAT_NU' ,nu ,is_available, lsubmodel, unitab)
117 CALL hm_get_floatv('MAT_EPS' ,epsmax ,is_available, lsubmodel, unitab)
118 CALL hm_get_floatv('MAT_EPST1' ,epsr1 ,is_available, lsubmodel, unitab)
119 CALL hm_get_floatv('MAT_EPST2' ,epsr2 ,is_available, lsubmodel, unitab)
120 !line-3
121 CALL hm_get_intv('NFUNC' ,nrate ,is_available, lsubmodel)
122 CALL hm_get_intv('Fsmooth' ,israte_loc ,is_available, lsubmodel)
123 CALL hm_get_floatv('MAT_HARD' ,fisokin ,is_available, lsubmodel, unitab)
124 CALL hm_get_floatv('Fcut' ,asrate ,is_available, lsubmodel, unitab)
125 !line-4
126 CALL hm_get_intv('Xr_fun' ,ipfun ,is_available, lsubmodel)
127 CALL hm_get_intv('fct_ID_k' ,ifunce ,is_available, lsubmodel)
128 CALL hm_get_floatv('MAT_FScale' ,pscale ,is_available, lsubmodel, unitab)
129 CALL hm_get_floatv('E_R' ,einf ,is_available, lsubmodel, unitab)
130 CALL hm_get_floatv('MAT_C1' ,ce ,is_available, lsubmodel, unitab)
131 !remaining lines
132 CALL hm_get_intv('FUN_A1' ,ifunc(1) ,is_available, lsubmodel)
133 CALL hm_get_intv('FUN_B1' ,ifunc(2) ,is_available, lsubmodel)
134 CALL hm_get_intv('FUN_A2' ,ifunc(3) ,is_available, lsubmodel)
135 CALL hm_get_intv('FUN_B2' ,ifunc(4) ,is_available, lsubmodel)
136 CALL hm_get_intv('FUN_A3' ,ifunc(5) ,is_available, lsubmodel)
137 CALL hm_get_intv('FUN_B3' ,ifunc(6) ,is_available, lsubmodel)
138 CALL hm_get_intv('FUN_A4' ,ifunc(7) ,is_available, lsubmodel)
139 CALL hm_get_intv('FUN_B4' ,ifunc(8) ,is_available, lsubmodel)
140 CALL hm_get_intv('FUN_A5' ,ifunc(9) ,is_available, lsubmodel)
141 CALL hm_get_intv('FUN_B5' ,ifunc(10) ,is_available, lsubmodel)
142
143 CALL hm_get_floatv('MAT_ALPHA1' ,yfac(1) ,is_available, lsubmodel, unitab)
144 CALL hm_get_floatv('MAT_ALPHA2' ,yfac(2) ,is_available, lsubmodel, unitab)
145 CALL hm_get_floatv('MAT_ALPHA3' ,yfac(3) ,is_available, lsubmodel, unitab)
146 CALL hm_get_floatv('MAT_ALPHA4' ,yfac(4) ,is_available, lsubmodel, unitab)
147 CALL hm_get_floatv('MAT_ALPHA5' ,yfac(5) ,is_available, lsubmodel, unitab)
148 CALL hm_get_floatv('MAT_ALPHA6' ,yfac(6) ,is_available, lsubmodel, unitab)
149 CALL hm_get_floatv('MAT_ALPHA7' ,yfac(7) ,is_available, lsubmodel, unitab)
150 CALL hm_get_floatv('MAT_ALPHA8' ,yfac(8) ,is_available, lsubmodel, unitab)
151 CALL hm_get_floatv('MAT_ALPHA9' ,yfac(9) ,is_available, lsubmodel, unitab)
152 CALL hm_get_floatv('MAT_ALPHA0' ,yfac(10) ,is_available, lsubmodel, unitab)
153
154 CALL hm_get_floatv('MAT_EPSR1' ,rate(1) ,is_available, lsubmodel, unitab)
155 CALL hm_get_floatv('MAT_EPSR2' ,rate(2) ,is_available, lsubmodel, unitab)
156 CALL hm_get_floatv('MAT_EPSR3' ,rate(3) ,is_available, lsubmodel, unitab)
157 CALL hm_get_floatv('MAT_EPSR4' ,rate(4) ,is_available, lsubmodel, unitab)
158 CALL hm_get_floatv('MAT_EPSR5' ,rate(5) ,is_available, lsubmodel, unitab)
159 CALL hm_get_floatv('MAT_EPSR6' ,rate(6) ,is_available, lsubmodel, unitab)
160 CALL hm_get_floatv('MAT_EPSR7' ,rate(7) ,is_available, lsubmodel, unitab)
161 CALL hm_get_floatv('MAT_EPSR8' ,rate(8) ,is_available, lsubmodel, unitab)
162 CALL hm_get_floatv('MAT_EPSR9' ,rate(9) ,is_available, lsubmodel, unitab)
163 CALL hm_get_floatv('MAT_EPSR10' ,rate(10) ,is_available, lsubmodel, unitab)
164 !units
165 CALL hm_get_floatv_dim('MAT_FScale' ,pscale_unit ,is_available, lsubmodel, unitab)
166
167C=======================================================================
168
169
170 !---CHECK PARAMETERS
171 IF((epsr1 /= zero).AND.(epsr2 /= zero))THEN
172 IF(epsr1 >= epsr2)THEN
173 CALL ancmsg(msgid=480,
174 . msgtype=msgerror,
175 . anmode=aninfo_blind_1,
176 . i1=mat_id,
177 . c1=titr)
178 ENDIF
179 ENDIF
180
181 IF(nrate > 10)THEN
182 CALL ancmsg(msgid=215,
183 . msgtype=msgerror,
184 . anmode=aninfo,
185 . i1=60,
186 . i2=mat_id,
187 . c1=titr)
188 ELSEIF(nrate < 4)THEN
189 CALL ancmsg(msgid=529,
190 . msgtype=msgerror,
191 . anmode=aninfo,
192 . i1=mat_id,
193 . c1=titr,
194 . i2=nrate)
195 ENDIF
196
197 IF (ipfun == 0) THEN
198 pscale = zero
199 ELSEIF (pscale == zero) THEN
200 pscale = one*pscale_unit
201 ELSE
202 pscale = one/pscale
203 ENDIF
204
205 IF(nrate == 5)THEN !CFG file is forcing NRATE=5 whenever there is less than 5 functions
206 DO i=5,2,-1
207 IF(ifunc(i) == 0)THEN
208 nrate=nrate-1
209 ELSE
210 EXIT
211 ENDIF
212 ENDDO
213 ENDIF
214
215 DO i=1,nrate-1
216 IF(rate(i) >= rate(i+1))THEN
217 CALL ancmsg(msgid=478,
218 . msgtype=msgerror,
219 . anmode=aninfo_blind_1,
220 . i1=mat_id,
221 . c1=titr)
222 EXIT
223 ENDIF
224 ENDDO
225
226 DO i=1,nrate
227 IF(yfac(i) == zero) yfac(i)=one*pscale_unit
228 ENDDO
229
230 DO i=1,nrate
231 IF(ifunc(i) == 0)THEN
232 CALL ancmsg(msgid=126,
233 . msgtype=msgerror,
234 . anmode=aninfo_blind_1,
235 . i1=mat_id,
236 . c1=titr,
237 . i2=ifunc(i))
238 ENDIF
239 ENDDO
240
241 IF(nrate > 1 .AND. israte_loc == 0) THEN
242 CALL ancmsg(msgid=1220,
243 . msgtype=msgwarning,
244 . anmode=aninfo_blind_1,
245 . i1=mat_id,
246 . c1=titr)
247 ENDIF
248
249 IF(nrate == 1)THEN
250 mfunc=2
251 ifunc(2)=ifunc(1)
252 rate(1) =zero
253 rate(2) =one
254 yfac(2) =yfac(1)
255 ELSEIF(rate(1) == zero)THEN
256 mfunc=nrate
257 ELSE
258 mfunc=nrate+1
259 DO j=nrate,1,-1
260 ifunc(j+1)=ifunc(j)
261 rate(j+1) =rate(j)
262 yfac(j+1) =yfac(j)
263 ENDDO
264 rate(1)=zero
265 ENDIF
266C
267 !---DEFAULTS VALUES
268 IF(rhor == zero)rhor=rho0
269 pm(1) =rhor
270 pm(89)=rho0
271
272 !---STORAGE
273 uparam(1)=mfunc
274 uparam(2)=e
275 uparam(3)=e/(one-nu*nu)
276 uparam(4)=nu*uparam(3)
277 g = half*e/(1.+nu)
278 uparam(5)=g
279 uparam(6)=nu
280
281 DO j=1,mfunc
282 uparam(6+j)=rate(j)
283 ENDDO
284
285 DO j=1,mfunc
286 uparam(6+mfunc+j)=yfac(j)
287 ENDDO
288
289 IF(epsr1 == zero)epsr1=infinity
290 IF(epsr2 == zero)epsr2=two*infinity
291 uparam(6+2*mfunc+1)=epsmax
292 uparam(6+2*mfunc+2)=epsr1
293 uparam(6+2*mfunc+3)=epsr2
294 uparam(6+2*mfunc+4)=two*g
295 uparam(6+2*mfunc+5)=three*g
296 c1=e/three/(one-two*nu)
297 uparam(6+2*mfunc+6)=c1
298 uparam(6+2*mfunc+7)=c1 + four*g/three ! ssp
299 uparam(6+2*mfunc+8)=fisokin
300 nfunc = mfunc + 1
301 ifunc(nfunc) = ipfun
302 iu = 15 + 2*mfunc
303 IF (ipfun == 0) THEN
304 uparam(iu) = 0
305 ELSE
306 uparam(iu) = nfunc
307 ENDIF
308 iu = iu+1
309 uparam(iu) = pscale
310C
311c --------------
312 opte = 0
313 IF (ifunce > 0 )opte = 1
314 nfunc = nfunc + 1
315 ifunc(nfunc)= ifunce
316 uparam(iu+1) = nfunc
317 uparam(iu+2) = opte
318 uparam(iu+3) = einf
319 uparam(iu+4) = ce
320 iu=iu+4
321c
322 nuparam = iu
323c------------------
324
325 parmat(1) = c1
326 parmat(2) = e
327 parmat(3) = nu
328 parmat(4) = israte_loc
329 IF(asrate == zero)asrate=infinity
330 parmat(5) = asrate
331c------------------------------------
332C Formulation for solid elements time step computation.
333 parmat(16) = 2
334 parmat(17) = two*g/(c1+four_over_3*g) ! == (1-2*nu)/(1-nu)
335C
336 nuvar = 5 + mfunc
337c
338 ! Properties compatibility
339 CALL init_mat_keyword(matparam,"SHELL_ISOTROPIC")
340 CALL init_mat_keyword(matparam,"SOLID_ISOTROPIC")
341C
342 !---LISTING OUTPUT---!
343 WRITE(iout,1001) trim(titr),mat_id,60
344 WRITE(iout,1000)
345 IF(is_encrypted)THEN
346 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
347 ELSE
348 WRITE(iout,1002) rho0
349 WRITE(iout,1100) e,nu,epsmax,epsr1,epsr2,fisokin,israte_loc,asrate
350 WRITE(iout,1200)(ifunc(j),yfac(j),rate(j),j=1,mfunc)
351 WRITE(iout,1300) ipfun,pscale, ifunce,einf,ce
352 WRITE(iout,*)' '
353 ENDIF
354
355
356 RETURN
357 1000 FORMAT(
358 & 5x,40h tabulated elastic plastic law ,/,
359 & 5x,40h ----------------------------- ,//)
360 1001 FORMAT(
361 & 5x,a,/,
362 & 5x,'MATERIAL NUMBER . . . . . . . . . . . . =',i10/,
363 & 5x,'MATERIAL LAW. . . . . . . . . . . . . . =',i10/)
364 1002 FORMAT(
365 & 5x,'INITIAL DENSITY . . . . . . . . . . . . =',1pg20.13/)
366 1100 FORMAT(
367 & 5x,'YOUNG''S MODULUS. . . . . . . . . . . .=',1pg20.13/
368 & 5x,'POISSON''S RATIO. . . . . . . . . . . .=',1pg20.13/
369 & 5x,'MAXIMUM PLASTIC STRAIN . . . . . . . ..=',1pg20.13/
370 & 5x,'TENSION FAILURE STRAIN 1 . . . . . . ..=',1pg20.13/
371 & 5x,'TENSION FAILURE STRAIN 2 . . . . . . ..=',1pg20.13/
372 & 5x,'ISO-KINEMATIC HARDENNING FACTOR. . . ..=',1pg20.13/
373 & 5x,'SMOOTH STRAIN RATE OPTION. . . . . . ..=',i10/
374 & 5x,'STRAIN RATE CUTTING FREQUENCY . . . . .=',1pg20.13/)
375 1200 FORMAT(
376 & 5x,'YIELD STRESS FUNCTION NUMBER. . . . . .=',i10/
377 & 5x,'YIELD SCALE FACTOR. . . . . . . . . . .=',1pg20.13/
378 & 5x,'STRAIN RATE . . . . . . . . . . . . . .=',1pg20.13)
379 1300 FORMAT(
380 & 5x,'PRESSURE DEPENDENT YIELD FUNCTION . . .=',i10/
381 & 5x,'PRESSURE SCALE FACTOR. . . . . . . . . =',1pg20.13/
382 & 5x,'YOUNG MODULUS SCALE FACTOR FUNCTION . . .=',i10/
383 & 5x,'YOUNG MODULUS EINF . . . . . . . . . . . =',1pg20.13/
384 & 5x,'PARAMETER CE . . . . . . . . . . . . . . =',1pg20.13)
385 END
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_mat60(uparam, maxuparam, nuparam, israte, imatvis, nuvar, ifunc, maxfunc, nfunc, parmat, unitab, mat_id, titr, mtag, lsubmodel, pm, ipm, matparam)
subroutine init_mat_keyword(matparam, keyword)
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
subroutine tabulated(iflag, nel, pm, off, eint, mu, espe, dvol, df, vnew, mat, psh, pnew, dpdm, dpde, npf, tf)
Definition tabulated.F:32