OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat33.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_mat33 ../starter/source/materials/mat/mat033/hm_read_mat33.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_mat33(UPARAM ,MAXUPARAM,NUPARAM ,ISRATE , IMATVIS ,
40 . NUVAR ,IFUNC ,MAXFUNC ,NFUNC , PARMAT ,
41 . UNITAB ,MAT_ID ,TITR ,MTAG , LSUBMODEL,
42 . PM ,MATPARAM )
43C-----------------------------------------------
44C D e s c r i p t i o n
45C-----------------------------------------------
46C READ MAT LAW33 WITH HM READER ( TO BE COMPLETED )
47C
48C DUMMY ARGUMENTS DESCRIPTION:
49C ===================
50C
51C NAME DESCRIPTION
52C
53C IPM MATERIAL ARRAY(INTEGER)
54C PM MATERIAL ARRAY(REAL)
55C UNITAB UNITS ARRAY
56C MAT_ID MATERIAL ID(INTEGER)
57C TITR MATERIAL TITLE
58C LSUBMODEL SUBMODEL STRUCTURE
59C
60C-----------------------------------------------
61C M o d u l e s
62C-----------------------------------------------
63 USE unitab_mod
64 USE elbuftag_mod
65 USE message_mod
66 USE submodel_mod
67 USE matparam_def_mod
69C-----------------------------------------------
70C I m p l i c i t T y p e s
71C-----------------------------------------------
72#include "implicit_f.inc"
73C-----------------------------------------------
74C C o m m o n B l o c k s
75C-----------------------------------------------
76#include "units_c.inc"
77#include "param_c.inc"
78C-----------------------------------------------
79C D u m m y A r g u m e n t s
80C-----------------------------------------------
81 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
82 my_real, DIMENSION(NPROPM) ,INTENT(INOUT) :: PM
83 my_real, DIMENSION(100) ,INTENT(INOUT) :: PARMAT
84 my_real, DIMENSION(MAXUPARAM) ,INTENT(INOUT) :: uparam
85 INTEGER, DIMENSION(MAXFUNC) ,INTENT(INOUT) :: IFUNC
86 INTEGER, INTENT(INOUT) :: ISRATE,IMATVIS,NFUNC,MAXFUNC,MAXUPARAM,NUPARAM,NUVAR
87 TYPE(mlaw_tag_),INTENT(INOUT) :: MTAG
88 INTEGER,INTENT(IN) :: MAT_ID
89 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
90 TYPE(submodel_data),INTENT(IN) :: LSUBMODEL(*)
91 TYPE(matparam_struct_) ,INTENT(INOUT) :: MATPARAM
92C-----------------------------------------------
93C L o c a l V a r i a b l e s
94C-----------------------------------------------
95 INTEGER KEN, IFN1, IFN2, ICASE
96
97 my_real
98 . e,a,b,c,p0,phi,gama0,fac,sigt_coff
99
100 my_real c1,c2,et,vmu,vmu0
101
102 my_real fac_unit,rho0,rhor,fac1
103
104 LOGICAL :: IS_ENCRYPTED,IS_AVAILABLE
105C-----------------------------------------------
106C S o u r c e L i n e s
107C-----------------------------------------------
108 nfunc=0
109 is_encrypted = .false.
110 is_available = .false.
111 israte=0
112 imatvis=1
113
114 CALL hm_option_is_encrypted(is_encrypted)
115
116 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
117 CALL hm_get_floatv('Refer_Rho' ,rhor ,is_available, lsubmodel, unitab)
118
119 CALL hm_get_floatv('MAT_E' ,e ,is_available, lsubmodel, unitab)
120 CALL hm_get_intv ('Itype' ,ken ,is_available, lsubmodel)
121 CALL hm_get_intv ('FUN_A1' ,ifn1 ,is_available, lsubmodel)
122 CALL hm_get_floatv('IFscale' ,fac ,is_available, lsubmodel, unitab)
123 CALL hm_get_floatv_dim('IFscale' ,fac_unit ,is_available, lsubmodel, unitab)
124 !hidden param/flag
125 !CALL HM_GET_INTV ('IFORM' ,IFN2 ,IS_AVAILABLE, LSUBMODEL)
126 !CALL HM_GET_FLOATV('MAT_RHO' ,FAC1 ,IS_AVAILABLE, LSUBMODEL, UNITAB)
127 ifn2=0
128 fac1=zero
129
130 CALL hm_get_floatv('MAT_P0' ,p0 ,is_available, lsubmodel, unitab)
131 CALL hm_get_floatv('MAT_PHI' ,phi ,is_available, lsubmodel, unitab)
132 CALL hm_get_floatv('MAT_GAMA0' ,gama0 ,is_available, lsubmodel, unitab)
133
134 IF (fac == zero) fac = one * fac_unit
135 !hiddent no longer supported
136 !FAC1 = ONE / FAC_UNIT
137 parmat(1)=e
138
139 IF(rhor==zero)rhor=rho0
140 pm(01)=rhor
141 pm(89)=rho0
142 icase = abs(ken)+1
143 SELECT CASE (icase)
144C-------------
145 CASE(1,3)
146C-------------
147c KEN = 0 or KEN = 2
148C-------------
149C-------------
150 nuparam=11
151 CALL hm_get_floatv('MAT_A0' ,a ,is_available, lsubmodel, unitab)
152 CALL hm_get_floatv('MAT_A1' ,b ,is_available, lsubmodel, unitab)
153 CALL hm_get_floatv('MAT_A2' ,c ,is_available, lsubmodel, unitab)
154 CALL hm_get_floatv('MAT_SIGT_CUTOFF' ,sigt_coff ,is_available, lsubmodel, unitab)
155!!
156 IF(sigt_coff == zero) sigt_coff = ep20
157 uparam(1)=ken
158 uparam(2)=e
159 uparam(3)=a
160 uparam(4)=b
161 uparam(5)=c
162 uparam(6)=p0
163 uparam(7)=phi
164 uparam(8)=gama0
165 uparam(9)=fac
166 uparam(10)=fac1
167 uparam(11)=sigt_coff
168
169 ifunc(1)=ifn1
170 ifunc(2)=ifn2
171 nfunc=2
172!
173 WRITE(iout,1001) trim(titr),mat_id,33
174 WRITE(iout,1000)
175
176 IF(is_encrypted)THEN
177 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
178 ELSE
179 WRITE(iout,1002) rho0
180 WRITE(iout,1200) e,ken,ifn1,fac,ifn2,fac1,
181 & a,b,c,sigt_coff,p0,phi,gama0
182 ENDIF
183C-------------
184 CASE(2)
185C-------------
186c KEN=1
187C-------------
188 nuparam=15
189 CALL hm_get_floatv('MAT_A0' ,a ,is_available, lsubmodel, unitab)
190 CALL hm_get_floatv('MAT_A1' ,b ,is_available, lsubmodel, unitab)
191 CALL hm_get_floatv('MAT_A2' ,c ,is_available, lsubmodel, unitab)
192
193 CALL hm_get_floatv('MAT_E1' ,c1 ,is_available, lsubmodel, unitab)
194 CALL hm_get_floatv('MAT_E2' ,c2 ,is_available, lsubmodel, unitab)
195 CALL hm_get_floatv('MAT_ETAN' ,et ,is_available, lsubmodel, unitab)
196 CALL hm_get_floatv('MAT_ETA1' ,vmu ,is_available, lsubmodel, unitab)
197 CALL hm_get_floatv('MAT_ETA2' ,vmu0 ,is_available, lsubmodel, unitab)
198
199 IF (vmu<=0..OR.vmu0<=0.) THEN
200 CALL ancmsg(msgid=310,
201 . msgtype=msgerror,
202 . anmode=aninfo,
203 . i1=mat_id,
204 . c1=titr)
205 ENDIF
206 uparam(1)=ken
207 uparam(2)=e
208 uparam(3)=a
209 uparam(4)=b
210 uparam(5)=c
211 uparam(6)=p0
212 uparam(7)=phi
213 uparam(8)=gama0
214 uparam(9)=c1
215 uparam(10)=c2
216 uparam(11)=et
217 uparam(12)=vmu
218 uparam(13)=vmu0
219 uparam(14)=fac
220 uparam(15)=fac1
221
222 ifunc(1)=ifn1
223 ifunc(2)=ifn2
224 nfunc=2
225C-------------
226C
227C Formulation for solid elements time step computation.
228 parmat(16) = 2
229 parmat(17) = one
230c-----------------
231 CALL init_mat_keyword(matparam,"COMPRESSIBLE")
232c-----------------
233 WRITE(iout,1001) trim(titr),mat_id,33
234 WRITE(iout,1000)
235 IF(is_encrypted)THEN
236 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
237 ELSE
238 WRITE(iout,1100) e,ken,ifn1,fac,ifn2,fac1,
239 & c1,c2,et,vmu,vmu0,
240 & a,b,c,p0,phi,gama0
241 ENDIF
242 END SELECT
243c
244 ! Properties compatibility
245 CALL init_mat_keyword(matparam,"SOLID_ISOTROPIC")
246 CALL init_mat_keyword(matparam,"SPH")
247c
248 RETURN
249C 12345678901234567890123456789012345678901
250 1000 FORMAT
251 & (5x,43h low density closed cell polyurethane foam,/,
252 & 5x,43h -----------------------------------------,//)
253 1001 FORMAT(/
254 & 5x,a,/,
255 & 5x, 'MATERIAL NUMBER . . . . . . . . . . . .=',i10/,
256 & 5x, 'MATERIAL LAW. . . . . . . . . . . . . .=',i10/)
257 1002 FORMAT(
258 & 5x, 'INITIAL DENSITY . . . . . . . . . . . .=',1pg20.13/)
259 1100 FORMAT
260 & (5x, 'YOUNG''S MODULUS . . . . . . . . . . . .=',1pg20.13/
261 & ,5x, 'FLAG. . . . . . . . . . . . . . . . . .=',i10/
262 & ,5x, 'FUNCTION NUMBER FOR THE YIELD CURVE . .=',i10//
263 & ,5x, 'YIELD CURVE SCALE FACTOR. . . . . . . .=',1pg20.13/
264 & ,5x, 'STRAIN RATE EFFECT CURVE. . . . . . . =',i10/
265 & ,5x, 'STRAIN RATE EFFECT SCALE FACTOR . . . .=',1pg20.13/
266 & ,5x, 'USER CONSTANT FOR YOUNG MODULUS C1. . .=',1pg20.13/
267 & ,5x, 'USER CONSTANT FOR YOUNG MODULUS C2. . .=',1pg20.13/
268 & ,5x, 'TANGENT MODULUS . . . . . . . . . . . .=',1pg20.13/
269 & ,5x, 'VISCOUS COEFFICIENT (PURE COMPRESSION).=',1pg20.13/
270 & ,5x, 'VISCOUS COEFFICIENT (PURE SHEAR). . . .=',1pg20.13//
271 & ,5x, 'USER CONSTANT FOR YIELD STRESS A. . . .=',1pg20.13/
272 & ,5x, 'USER CONSTANT FOR YIELD STRESS B. . . .=',1pg20.13/
273 & ,5x, 'USER CONSTANT FOR YIELD STRESS C. . . .=',1pg20.13//
274 & ,5x, 'INITIAL FOAM PRESSURE . . . . . . . . .=',1pg20.13/
275 & ,5x, 'RATIO OF FOAM TO POLYMER DENSITY. . . .=',1pg20.13/
276 & ,5x, 'INITIAL VOLUMETRIC STRAIN. . . .. . . .=',1pg20.13/)
277 1200 FORMAT
278 & (5x, 'YOUNG''S MODULUS . . . . . . . . . . . .=',1pg20.13/
279 & ,5x, 'FLAG. . . . . . . . . . . . . . . . . .=',i10/
280 & ,5x, 'FUNCTION NUMBER FOR THE YIELD CURVE . .=',i10//
281 & ,5x, 'YIELD CURVE SCALE FACTOR. . . . . . . .=',1pg20.13/
282 & ,5x, 'STRAIN RATE EFFECT CURVE. . . . . . . =',i10/
283 & ,5x, 'strain rate effect scale factor . . . .=',1PG20.13/
284 & ,5X, 'user constant for yield stress a. . . .=',1PG20.13/
285 & ,5X, 'user constant for yield stress b. . . .=',1PG20.13/
286 & ,5X, 'user constant for yield stress c. . . .=',1PG20.13/
287 & ,5X, 'tension cut off stress . . . . .. . . .=',1PG20.13//
288 & ,5X, 'initial foam pressure . . . . . . . . .=',1PG20.13/
289 & ,5X, 'ratio of foam to polymer density. . . .=',1PG20.13/
290 & ,5X, 'initial volumetric strain. . . .. . . .=',1PG20.13/)
291 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_mat33(uparam, maxuparam, nuparam, israte, imatvis, nuvar, ifunc, maxfunc, nfunc, parmat, unitab, mat_id, titr, mtag, lsubmodel, pm, matparam)
subroutine init_mat_keyword(matparam, keyword)
for(i8=*sizetab-1;i8 >=0;i8--)
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:895
program starter
Definition starter.F:39