OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat66.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_mat66 ../starter/source/materials/mat/mat066/hm_read_mat66.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_float_array_index ../starter/source/devtools/hm_reader/hm_get_float_array_index.F
30!|| hm_get_float_array_index_dim ../starter/source/devtools/hm_reader/hm_get_float_array_index_dim.F
31!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
32!|| hm_get_floatv_dim ../starter/source/devtools/hm_reader/hm_get_floatv_dim.F
33!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
34!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
35!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
36!|| init_mat_keyword ../starter/source/materials/mat/init_mat_keyword.F
37!||--- uses -----------------------------------------------------
38!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
39!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
40!|| message_mod ../starter/share/message_module/message_mod.F
41!|| submodel_mod ../starter/share/modules1/submodel_mod.F
42!||====================================================================
43 SUBROUTINE hm_read_mat66(UPARAM ,MAXUPARAM,NUPARAM ,NUVAR ,IFUNC ,
44 . MAXFUNC ,MFUNC , PARMAT ,UNITAB ,ID ,
45 . MTAG ,TITR , LSUBMODEL,PM ,MATPARAM )
46C-----------------------------------------------
47C D e s c r i p t i o n
48C-----------------------------------------------
49C
50C DUMMY ARGUMENTS DESCRIPTION:
51C ===================
52C
53C NAME DESCRIPTION
54C
55C IPM MATERIAL ARRAY(INTEGER)
56C PM MATERIAL ARRAY(REAL)
57C UNITAB UNITS ARRAY
58C ID MATERIAL ID(INTEGER)
59C TITR MATERIAL TITLE
60C LSUBMODEL SUBMODEL STRUCTURE
61C
62C-----------------------------------------------
63C M o d u l e s
64C-----------------------------------------------
65 USE unitab_mod
66 USE elbuftag_mod
67 USE message_mod
68 USE submodel_mod
69 USE matparam_def_mod
70 USE hm_option_read_mod
71 USE names_and_titles_mod , ONLY : nchartitle
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"
81C-----------------------------------------------
82C D u m m y A r g u m e n t s
83C-----------------------------------------------
84 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
85 my_real, DIMENSION(NPROPM) ,INTENT(INOUT) :: PM
86 my_real, DIMENSION(100) ,INTENT(INOUT) :: parmat
87 my_real, DIMENSION(MAXUPARAM) ,INTENT(INOUT) :: uparam
88 INTEGER, DIMENSION(MAXFUNC) ,INTENT(INOUT) :: IFUNC
89 INTEGER, INTENT(INOUT) :: MFUNC,NUPARAM,NUVAR
90 TYPE(mlaw_tag_),INTENT(INOUT) :: MTAG
91 INTEGER,INTENT(IN) :: ID,MAXFUNC,MAXUPARAM
92 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
93 TYPE(submodel_data),INTENT(IN) :: LSUBMODEL(*)
94 TYPE(matparam_struct_) ,INTENT(INOUT) :: MATPARAM
95C-----------------------------------------------
96C L o c a l V a r i a b l e s
97C-----------------------------------------------
98 INTEGER :: NBMAT, MAT_ID ! Number of declared materials
99 INTEGER :: I,J,IU,NC,NT,VP,ILAW,ISRATE,IRATE
100 my_real :: e,ec,nu,g,cp,epsp0,sigy,rho0,rhor,
101 . fisokin,yfac_unit,fcut,pc,pt,c1,rpct
102 my_real :: rate(maxfunc+1),yfac(maxfunc+1)
103 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
104C-----------------------------------------------
105C S o u r c e L i n e s
106C-----------------------------------------------
107 rate(1) = 0
108 is_encrypted = .false.
109 is_available = .false.
110 ilaw = 66
111C initialization
112 nc = 0
113 nt = 0
114 epsp0 = ep20
115 cp = one
116 vp = 0
117 sigy = zero
118C--------------------------------------------------
119C EXTRACT DATA (IS OPTION CRYPTED)
120C--------------------------------------------------
121 CALL hm_option_is_encrypted(is_encrypted)
122C-----------------------------------------------
123Card1
124 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
125 CALL hm_get_floatv('Refer_Rho' ,rhor ,is_available, lsubmodel, unitab)
126C-----------------------------------------------
127Card2
128 CALL hm_get_floatv('MAT_E' ,e ,is_available, lsubmodel, unitab)
129 CALL hm_get_floatv('MAT_NU' ,nu ,is_available, lsubmodel, unitab)
130 CALL hm_get_floatv('MAT_HARD' ,fisokin ,is_available, lsubmodel, unitab)
131 CALL hm_get_floatv('MAT_asrate' ,fcut ,is_available, lsubmodel, unitab)
132 CALL hm_get_intv ('Fsmooth' ,israte ,is_available,lsubmodel)
133 CALL hm_get_intv ('ISRATE' ,irate ,is_available,lsubmodel)
134C-----------------------------------------------
135Card3
136 CALL hm_get_floatv('MAT_PC' ,pc ,is_available, lsubmodel, unitab)
137 CALL hm_get_floatv('MAT_PT' ,pt ,is_available, lsubmodel, unitab)
138 CALL hm_get_floatv('MAT_EC' ,ec ,is_available, lsubmodel, unitab)
139 CALL hm_get_floatv('MAT_RPCT' ,rpct ,is_available, lsubmodel, unitab)
140C-----------------------------------------------
141C!!
142 IF(irate == 0) irate = 1
143Card3
144 IF(irate < = 3) THEN
145 CALL hm_get_intv ('FUN_A1' ,ifunc(1) ,is_available,lsubmodel)
146 CALL hm_get_intv ('FUN_A2' ,ifunc(2) ,is_available,lsubmodel)
147 CALL hm_get_floatv('FScale11' ,yfac(1) ,is_available, lsubmodel, unitab)
148 CALL hm_get_floatv('FScale22' ,yfac(2) ,is_available, lsubmodel, unitab)
149 mfunc = 2
150C unit
151 CALL hm_get_floatv_dim('FScale11' ,yfac_unit ,is_available, lsubmodel, unitab)
152 rate(1) = zero
153 IF(yfac(1) == zero) yfac(1)= yfac_unit
154 CALL hm_get_floatv_dim('FScale22' ,yfac_unit ,is_available, lsubmodel, unitab)
155 IF(yfac(2) == zero) yfac(2)= yfac_unit
156 rate(2) = zero
157 ENDIF
158C
159 IF(irate < = 2) THEN
160 CALL hm_get_floatv('Epsilon_0' ,epsp0 ,is_available, lsubmodel, unitab)
161 CALL hm_get_floatv('MAT_C0' ,cp ,is_available, lsubmodel, unitab)
162 CALL hm_get_floatv('SIGMA_r' ,sigy ,is_available, lsubmodel, unitab)
163 CALL hm_get_intv ('VP' ,vp ,is_available,lsubmodel)
164C
165 IF(epsp0 == zero .AND. cp == zero)epsp0 = ep20
166 IF(epsp0 == zero) epsp0 = one !!!
167
168C
169 ELSEIF(irate == 3) THEN
170 CALL hm_get_intv ('FUN_B1' ,ifunc(3) ,is_available,lsubmodel)
171 CALL hm_get_intv ('FUN_B2' ,ifunc(4) ,is_available,lsubmodel)
172 CALL hm_get_floatv('FScale33' ,yfac(3) ,is_available, lsubmodel, unitab)
173 CALL hm_get_floatv('FScale12' ,yfac(4) ,is_available, lsubmodel, unitab)
174 mfunc = 4
175 DO i=1,mfunc
176 rate(i) = zero
177 ENDDO
178C unit
179 CALL hm_get_floatv_dim('FScale33' ,yfac_unit ,is_available, lsubmodel, unitab)
180 IF(yfac(3) == zero) yfac(3)= yfac_unit
181 CALL hm_get_floatv_dim('FScale12' ,yfac_unit ,is_available, lsubmodel, unitab)
182 IF(yfac(4) == zero) yfac(4)= yfac_unit
183
184 ELSEIF(irate == 4) THEN
185 CALL hm_get_intv ('NFUNC' ,nc ,is_available,lsubmodel)
186 CALL hm_get_intv ('TFUNC' ,nt ,is_available,lsubmodel)
187 DO i= 1,nc
188 CALL hm_get_int_array_index('ABG_IPt' ,ifunc(i) ,i,is_available, lsubmodel)
189 CALL hm_get_float_array_index('Fp1' ,yfac(i) ,i,is_available, lsubmodel, unitab)
190 CALL hm_get_float_array_index('K_A1' ,rate(i) ,i,is_available, lsubmodel, unitab)
191C
192 CALL hm_get_float_array_index_dim('Fp1' ,yfac_unit ,i,is_available, lsubmodel, unitab)
193 IF(yfac(i) == zero) yfac(i) = yfac_unit
194 ENDDO
195C
196 IF (nc == 1) THEN
197 nc = nc +1
198 ifunc(2) = ifunc(1)
199 rate(1) = zero
200 rate(2) = one
201 yfac(2) = yfac(1)
202 ELSEIF(rate(1) /= zero)THEN
203 nc = nc + 1
204 DO j=nc,1,-1
205 ifunc(j+1)=ifunc(j)
206 rate(j+1) =rate(j)
207 yfac(j+1) =yfac(j)
208 ENDDO
209 rate(1)=zero
210 ENDIF
211
212 DO i= 1,nt
213 CALL hm_get_int_array_index('ABG_IPdel',ifunc(nc + i) ,i,is_available, lsubmodel)
214 CALL hm_get_float_array_index('Fp2' ,yfac(nc + i) ,i,is_available, lsubmodel, unitab)
215 CALL hm_get_float_array_index('K_B1' ,rate(nc + i) ,i,is_available, lsubmodel, unitab)
216C unity
217 CALL hm_get_float_array_index_dim('Fp2' ,yfac_unit ,i,is_available, lsubmodel, unitab)
218 IF(yfac(nc + i) == zero) yfac(nc + i) = yfac_unit
219 ENDDO
220 IF (nt == 1) THEN
221 nt = nt +1
222 ifunc(nc + 2) = ifunc(nc + 1)
223 rate(nc + 2) = one
224 rate(nc + 1) = zero
225 yfac(nc + 2) = yfac(nc + 1)
226 ELSEIF(rate(nc + 1) /= zero)THEN
227 nt = nt + 1
228 DO j=nt,1,-1
229 ifunc(nc + j + 1) = ifunc(nc + j)
230 rate(nc + j + 1) = rate(nc + j)
231 yfac(nc + j + 1) = yfac(nc + j)
232 ENDDO
233 rate(nc + 1)=zero
234 ENDIF
235 mfunc = nc + nt
236c
237 DO i=1,nc-1
238 IF(rate(i) > rate(i+1))THEN
239 CALL ancmsg(msgid=478,
240 . msgtype=msgerror,
241 . anmode=aninfo_blind_1,
242 . i1=id,
243 . c1=titr)
244 GOTO 100
245 ENDIF
246 ENDDO
247 100 CONTINUE
248
249 DO i=1,nt-1
250 IF(rate(nc+i) >= rate(nc+i+1))THEN
251 CALL ancmsg(msgid=478,
252 . msgtype=msgerror,
253 . anmode=aninfo_blind_1,
254 . i1=id,
255 . c1=titr)
256 GOTO 200
257 ENDIF
258 ENDDO
259 200 CONTINUE
260c-----
261 ENDIF ! IRATE
262c
263c-----------------------------------------------------------------------
264c
265 rhor=rho0
266 IF(rhor==zero)rhor=rho0
267 pm(1) =rhor
268 pm(89)=rho0
269C
270 DO i=1,mfunc
271 IF(ifunc(i) == 0)THEN
272 CALL ancmsg(msgid=126,
273 . msgtype=msgerror,
274 . anmode=aninfo,
275 . i1=id,
276 . c1=titr,
277 . i2=ifunc(i))
278 ENDIF
279 ENDDO
280C
281 IF(nu == half)nu=zep499
282 IF(cp == zero .AND. irate == 1) cp = one
283 IF(irate == 1 ) cp = one/cp
284 g = half*e/( one + nu)
285C
286c-----------------------------------------------------------------------
287 uparam(1) = irate
288 uparam(2) = e
289 uparam(3) = e/(one - nu*nu)
290 uparam(4) = nu*uparam(3)
291 uparam(5) = g
292 uparam(6) = nu
293 uparam(7) = pc
294 uparam(8) = pt
295 uparam(9) = epsp0
296 uparam(10) = cp
297 uparam(11) = nc
298 uparam(12) = nt
299 uparam(13) = fisokin
300 DO i= 1,mfunc
301 uparam(13+i) = yfac(i)
302 uparam(13+i+mfunc) = rate(i)
303 ENDDO
304C
305 uparam(14 + 2*mfunc) = sigy
306 uparam(15 + 2*mfunc) = vp
307 uparam(16 + 2*mfunc) = ec
308 uparam(17 + 2*mfunc) = rpct
309 nuparam = 17 + 2*mfunc
310c
311 c1=e/three/(one - two*nu)
312C
313 parmat(1) = c1
314 parmat(2) = e
315 parmat(3) = nu
316 parmat(4) = israte
317 parmat(5) = fcut
318C
319 nuvar = 7 + mfunc
320C-----------------------
321 mtag%G_EPSD = 1
322 mtag%L_EPSD = 1
323 mtag%G_PLA = 1
324 mtag%L_PLA = 1
325C-----------------------
326 ! Properties compatibility
327 CALL init_mat_keyword(matparam,"SHELL_ISOTROPIC")
328 CALL init_mat_keyword(matparam,"SOLID_ISOTROPIC")
329 CALL init_mat_keyword(matparam,"SPH")
330C ----------------
331C
332 WRITE(iout,1001) trim(titr),id,ilaw
333 WRITE(iout,1000)
334 IF(is_encrypted)THEN
335 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
336 ELSE
337 WRITE(iout,1002) rho0
338 WRITE(iout,1100) e,ec,nu,pc,pt,rpct,fisokin,israte,fcut
339 WRITE(iout,1200) irate
340 IF(irate <= 2) THEN
341 WRITE(iout,1300) ifunc(1),yfac(1)
342 write(iout,1400) ifunc(2),yfac(2)
343 write(iout,1500) epsp0
344 IF (irate == 1) THEN
345 WRITE(iout,1510) cp
346 ELSE
347 WRITE(iout,1520) cp
348 ENDIF
349 write(iout,1530) vp,sigy
350 ELSEIF(irate == 3) THEN
351 WRITE(iout,1300) ifunc(1),yfac(1)
352 write(iout,1400) ifunc(2),yfac(2)
353 write(iout,1600) ifunc(3),yfac(3)
354 WRITE(iout,1700) ifunc(4),yfac(4)
355 ELSE
356 DO i=1,nc
357 WRITE(iout,2000) ifunc(i),yfac(i),rate(i)
358 ENDDO
359 DO i=1,nt
360 WRITE(iout,3000) ifunc(i+nc),yfac(i+nc),rate(i+nc)
361 ENDDO
362 ENDIF
363 ENDIF
364C
365c-----------------------------------------------------------------
366 1000 FORMAT(
367 & 5x,' TABULATED TENSION-COMPRESSION PLASTIC LAW ',/,
368 & 5x,' ----------------------------- ' ,//)
369 1001 FORMAT(/
370 & 5x,a,/,
371 & 5x,'MATERIAL NUMBER. . . . . . . . . . . . =',i10/,
372 & 5x,'MATERIAL LAW . . . . . . . . . . . . . =',i10/)
373 1002 FORMAT(
374 & 5x,'INITIAL DENSITY. . . . . . . . . . . . =',1pg20.13/)
375 1100 FORMAT(
376 & 5x,'YOUNG''S MODULUS. . . . . . . . . . . . .=',1pg20.13/
377 & 5x,'YOUNG''S MODULUS IN COMPRESSION . . . . .=',1pg20.13/
378 & 5x,'POISSON''S RATIO. . . . . . . . . . . . .=',1pg20.13/
379 & 5x,'COMPRESSION MEAN STRESS. . . . . . . . .=',1pg20.13/
380 & 5x,'TRACTION MEAN STRESS . . . . . . . . . .=',1pg20.13/
381 & 5x,'FRACTION OF MEAN STRESSES . . . . . . . .=',1pg20.13/
382 & 5x,'ISO-KINEMATIC HARDENNING FACTOR . . . . .=',1pg20.13/
383 & 5x,'SMOOTH STRAIN RATE OPTION . . . . . . . .=',i10/
384 & 5x,'STRAIN RATE CUTTING FREQUENCY . . . . . .=',1pg20.13/)
385 1200 FORMAT(
386 & 5x,'STRAIN RATE FORMULATION OPTION . . . . .=', i10/)
387 1300 FORMAT(
388 & 5x,'COMPRESSION YIELD STRESS FUNCTION NUMBER.=',i10/
389 & 5x,'YIELD SCALE FACTOR. . . . . . . . . . . .=',1pg20.13)
390 1400 FORMAT(
391 & 5x,'TRACTION YIELD STRESS FUNCTION NUMBER . .=',i10/
392 & 5x,'YIELD SCALE FACTOR. . . . . . . . . . . .=',1pg20.13)
393 1500 FORMAT(
394 & 5x,'REFERENCE STRAIN RATE . . . . . . . . . .=',1pg20.13)
395 1510 FORMAT(
396 & 5x,'STRAIN RATE PARAMETER 1/C . . . . . . . .=',1pg20.13)
397 1520 FORMAT(
398 & 5x,'STRAIN RATE PARAMETER C . . . . . . . . .=',1pg20.13)
399 1530 FORMAT(
400 & 5x,'OPTIONAL STRAIN RATE EFFECT : . . . . . .=',i10/,
401 & 5x,' 0 : STRAIN RATE EFFECT IS ACTIVATED ',/,
402 & 5x,' 1 : VISCPLASTIC OPTION IS ACTIVATED ',/,
403 & 5x,'OPTIONAL INITIAL YIELD STRESS . . . . . .=',1pg20.13/)
404 1600 FORMAT(
405 & 5x,
406 . 'COMPRESSION STRAIN RATE SCALING EFFECT FUNCTION NUMBER .=',i10/
407 & 5x,'SCALE FACTOR. . . . . . . . . . . . . . .=',1pg20.13)
408
409 1700 FORMAT(
410 & 5x,
411 . 'TRACTION STRAIN RATE SCALING EFFECT FUNCTION NUMBER . . .=',i10/
412 & 5x,'SCALE FACTOR. . . . . . . . . . . . . . .=',1pg20.13)
413 2000 FORMAT(
414 & 5x,'COMPRESSION YIELD STRESS FUNCTION NUMBER.=',i10/
415 & 5x,' YIELD SCALE FACTOR. . . . . .=',1pg20.13/
416 & 5x,'STRAIN RATE. . . . . . . . . .=',1pg20.13)
417 3000 FORMAT(
418 & 5x,'TRACTION YIELD STRESS FUNCTION NUMBER . .=',i10/
419 & 5x,'YIELD SCALE FACTOR. . . . . . . . . . . .=',1pg20.13/
420 & 5x,'STRAIN RATE . . . . . . . . . . . . . . .=',1pg20.13)
421c-----------------------------------------------------------------
422 RETURN
423 END
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_float_array_index
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array_index.F:105
hm_get_float_array_index_dim
subroutine hm_get_float_array_index_dim(name, dim_fac, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array_index_dim.F:47
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:418
hm_get_floatv_dim
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
Definition hm_get_floatv_dim.F:161
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:288
hm_read_mat66
subroutine hm_read_mat66(uparam, maxuparam, nuparam, nuvar, ifunc, maxfunc, mfunc, parmat, unitab, id, mtag, titr, lsubmodel, pm, matparam)
Definition hm_read_mat66.F:46
init_mat_keyword
subroutine init_mat_keyword(matparam, keyword)
Definition init_mat_keyword.F:153
elbuftag_mod
Definition elbuftag_mod.F:230
hm_option_read_mod
Definition hm_option_read_mod.F:412
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
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:895
elbuftag_mod::mlaw_tag_
Definition elbuftag_mod.F:235
submodel_mod::submodel_data
Definition submodel_mod.F:728