OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat88.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_mat88 ../starter/source/materials/mat/mat088/hm_read_mat88.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!|| message_mod ../starter/share/message_module/message_mod.F
40!|| submodel_mod ../starter/share/modules1/submodel_mod.F
41!||====================================================================
42 SUBROUTINE hm_read_mat88(UPARAM ,MAXUPARAM,NUPARAM ,ISRATE , IMATVIS ,
43 . NUVAR ,IFUNC ,MAXFUNC ,NFUNC , PARMAT ,
44 . UNITAB ,MAT_ID ,TITR ,MTAG , LSUBMODEL,
45 . PM ,IPM ,MATPARAM )
46C-----------------------------------------------
47C D e s c r i p t i o n
48C-----------------------------------------------
49C READ MAT LAW70 WITH HM READER ( TO BE COMPLETED )
50C
51C DUMMY ARGUMENTS DESCRIPTION:
52C ===================
53C
54C NAME DESCRIPTION
55C
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 names_and_titles_mod , ONLY : nchartitle
71C-----------------------------------------------
72C I m p l i c i t T y p e s
73C-----------------------------------------------
74#include "implicit_f.inc"
75C-----------------------------------------------
76C C o m m o n B l o c k s
77C-----------------------------------------------
78#include "units_c.inc"
79#include "param_c.inc"
80C-----------------------------------------------
81C D u m m y A r g u m e n t s
82C-----------------------------------------------
83 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
84 my_real, INTENT(INOUT) :: PM(NPROPM),PARMAT(100),UPARAM(MAXUPARAM)
85 INTEGER, INTENT(INOUT) :: IPM(NPROPMI),ISRATE,IFUNC(MAXFUNC),NFUNC,MAXFUNC,MAXUPARAM,NUPARAM, NUVAR,IMATVIS
86 TYPE(mlaw_tag_),INTENT(INOUT) :: MTAG
87 INTEGER,INTENT(IN) :: MAT_ID
88 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
89 TYPE(submodel_data),INTENT(IN) :: LSUBMODEL(*)
90 TYPE(matparam_struct_) ,INTENT(INOUT) :: MATPARAM
91C-----------------------------------------------
92C L o c a l V a r i a b l e s
93C-----------------------------------------------
94 my_real
95 . k,nu,g,rate(maxfunc+1),visc, viscv,expo,hys,
96 . rho0,rhor,bulk,emax,fcut,a1,a2,aa,yfac(maxfunc+1),yfac_unl,
97 . shape,gs,e,zep495,yfac_unl_unit,yfac_unit
98 integer
99 . j,i, ii,iunload,iflag,ietang,istif,i2017_2,nl,ifunc0(maxfunc),
100 . ifunc_unload,itens,iunl_for,icase,iadd,ilaw
101
102 LOGICAL IS_AVAILABLE,IS_ENCRYPTED
103C-----------------------------------------------
104C S o u r c e L i n e s
105C-----------------------------------------------
106 is_encrypted = .false.
107 is_available = .false.
108 istif = 0
109 ipm(3) = 1 !
110 imatvis = 1 !
111 zep495 = zep4 + nine*em02 + five*em03
112 iadd = 0
113 ilaw = 88
114
115 CALL hm_option_is_encrypted(is_encrypted)
116 !line-1
117 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
118 CALL hm_get_floatv('Refer_Rho' ,rhor ,is_available, lsubmodel, unitab)
119 !line-2
120 CALL hm_get_floatv('LAW88_Nu' , nu ,is_available, lsubmodel, unitab)
121 CALL hm_get_floatv('LAW88_K' , bulk ,is_available, lsubmodel, unitab)
122 CALL hm_get_floatv('LAW88_Fcut' , fcut ,is_available, lsubmodel, unitab)
123 CALL hm_get_intv('LAW88_Fsmooth', israte ,is_available, lsubmodel)
124 CALL hm_get_intv('LAW88_NL' ,nl ,is_available, lsubmodel)
125 !line-3
126 CALL hm_get_intv('LAW88_fct_IDunL' ,ifunc_unload ,is_available, lsubmodel)
127 CALL hm_get_floatv('LAW88_FscaleunL' ,yfac_unl ,is_available, lsubmodel, unitab)
128 CALL hm_get_floatv('LAW88_Hys' ,hys ,is_available, lsubmodel, unitab)
129 CALL hm_get_floatv('LAW88_Shape' ,shape ,is_available, lsubmodel, unitab)
130 CALL hm_get_intv('LAW88_Tension' ,itens ,is_available, lsubmodel)
131
132 IF(rhor==zero)rhor=rho0
133 pm(1) =rhor
134 pm(89)=rho0
135
136 IF(nl == 0) THEN
137 CALL ancmsg(msgid=866,
138 . msgtype=msgerror,
139 . anmode=aninfo_blind,
140 . i1=mat_id,
141 . c1=titr)
142 ENDIF
143 !--loading function
144 DO i=1,nl
145 CALL hm_get_int_array_index('LAW88_arr1' ,ifunc(i) ,i,is_available, lsubmodel)
146 CALL hm_get_float_array_index('law88_arr2' ,YFAC(I) ,I,IS_AVAILABLE, LSUBMODEL, UNITAB)
147 CALL HM_GET_FLOAT_ARRAY_INDEX('law88_arr3' ,RATE(I) ,I,IS_AVAILABLE, LSUBMODEL, UNITAB)
148C unit
149 CALL HM_GET_FLOAT_ARRAY_INDEX_DIM('law88_arr2' ,YFAC_UNIT ,I,IS_AVAILABLE, LSUBMODEL, UNITAB)
150 IF(YFAC(I) == ZERO) YFAC(I) = YFAC_UNIT
151 ENDDO
152C
153 CALL HM_GET_FLOATV_DIM('law88_fscaleunl' ,YFAC_UNL_UNIT ,IS_AVAILABLE, LSUBMODEL, UNITAB)
154
155.AND. IF(RATE(1) /= ZERO NL > 1) THEN
156 DO I= NL,1, -1
157 IFUNC(I+1) = IFUNC(I)
158 YFAC(I+1) = YFAC(I)
159 RATE(I+1) = RATE(I)
160 ENDDO
161 IFUNC(1) = IFUNC(2)
162 YFAC(1) = YFAC(2)
163 RATE(1) = ZERO
164 NL = NL + 1
165 DO I=2,NL
166 IF(RATE(I) < RATE(I-1) ) THEN
167 CALL ANCMSG(MSGID=478,
168 . MSGTYPE=MSGERROR,
169 . ANMODE=ANINFO_BLIND_1,
170 . I1=MAT_ID,
171 . C1=TITR)
172 EXIT
173 ENDIF
174 ENDDO
175 ENDIF
176 NFUNC = NL
177C
178 IUNL_FOR = 0
179 ICASE = 0
180 IF(YFAC_UNL == ZERO) YFAC_UNL = YFAC_UNL_UNIT
181 IF(NL == 1) THEN ! no strain rate effect
182 IF(IFUNC_UNLOAD > 0 )THEN
183 NFUNC = NFUNC + 1
184 IFUNC(NFUNC) = IFUNC_UNLOAD
185 YFAC(NFUNC) = YFAC_UNL
186 RATE(NFUNC) = ZERO
187 IUNL_FOR = 1 ! using unloading curve
188 ELSEIF(HYS /= ZERO) THEN
189 IUNL_FOR = 2 ! based on the energy
190 HYS = ABS(HYS)
191 ELSE
192 IUNL_FOR = 0 ! no unloading curve,
193 ENDIF
194 ELSE ! strain rate effect
195 IF(IFUNC_UNLOAD > 0) THEN
196 NFUNC = NFUNC + 1
197 IFUNC(NFUNC) = IFUNC_UNLOAD
198 YFAC(NFUNC) = YFAC_UNL
199 RATE(NFUNC) = ZERO
200 IUNL_FOR = 1 ! using unloading curve
201 ELSEIF(HYS /= ZERO )THEN
202 IUNL_FOR = 3 ! based on the energy
203 HYS = ABS(HYS)
204 ELSE ! using quasistatic curve for unloading
205 NFUNC = NFUNC + 1
206 IFUNC(NFUNC) = IFUNC(1)
207 YFAC(NFUNC) = YFAC(1)
208 RATE(NFUNC) = ZERO
209 IUNL_FOR = 1 ! using unloading curve
210 ENDIF
211 ENDIF
212C
213 IF(SHAPE == ZERO) SHAPE = ONE
214 IF(HYS == ZERO) HYS = ONE
215 IF(NU == ZERO) NU = ZEP495
216 GS = THREE_HALF*BULK*(ONE - TWO*NU)/(ONE + NU)
217 E = TWO*GS*(ONE + NU)
218 IF (GS<=0) THEN
219 CALL ANCMSG(MSGID=828,
220 . MSGTYPE=MSGERROR,
221 . ANMODE=ANSTOP,
222 . I1=MAT_ID,
223 . C1=TITR)
224 END IF
225.AND. IF (FCUT == ZERO NL > 1 ) THEN
226 FCUT = EP03*UNITAB%FAC_T_WORK
227 ISRATE = 1
228 ENDIF
229C
230 UPARAM(1) = BULK
231 UPARAM(2) = NU
232 UPARAM(3) = GS
233 UPARAM(4) = NL
234 UPARAM(5) = IUNL_FOR
235 UPARAM(6) = HYS
236 UPARAM(7) = SHAPE
237 UPARAM(8) = ITENS
238 UPARAM(9) = ICASE
239 NUPARAM = 9
240C
241 DO I=1,NFUNC
242 UPARAM( NUPARAM + 2*I - 1) = RATE(I)
243 UPARAM( NUPARAM + 2*I ) = YFAC(I)
244 ENDDO
245 NUPARAM = NUPARAM + 2*NFUNC
246 UPARAM(NUPARAM + 1 : NUPARAM + 5) = ZERO
247 NUPARAM = NUPARAM + 5 ! used inside law88_upd.F but not used in engine
248C
249 NUVAR = 32
250C
251 PARMAT(1) = TWO*GS
252 PARMAT(2) = E
253 PARMAT(3) = NU
254 PARMAT(4) = ISRATE
255 PARMAT(5) = FCUT
256C Formulation for solid elements time step computation.
257 PARMAT(16) = 2
258 PARMAT(17) = TWO*GS/(BULK + FOUR_OVER_3*GS)
259
260 ! MTAG variable activation
261 MTAG%L_EPSD = 1
262 MTAG%G_EPSD = 1
263c-----------------
264 CALL INIT_MAT_KEYWORD(MATPARAM,"INCOMPRESSIBLE")
265 CALL INIT_MAT_KEYWORD(MATPARAM,"TOTAL")
266 CALL INIT_MAT_KEYWORD(MATPARAM,"HOOK")
267 ! Properties compatibility
268 CALL INIT_MAT_KEYWORD(MATPARAM,"SOLID_ISOTROPIC")
269 CALL INIT_MAT_KEYWORD(MATPARAM,"SHELL_ISOTROPIC")
270c-----------------
271 WRITE(IOUT,1010) TRIM(TITR),MAT_ID,88
272 WRITE(IOUT,1000)
273 IF(IS_ENCRYPTED)THEN
274 WRITE(IOUT,'(5x,a,//)')'confidential data'
275 ELSE
276 WRITE(iout,1020)rho0
277 WRITE(iout,1100)nu,bulk,itens,nl-iadd
278 WRITE(iout,1200)(ifunc(i),yfac(i),rate(i),i=1+iadd,nl)
279 WRITE(iout,1250) israte,fcut
280 IF(iunl_for == 1) THEN
281 ii = nl
282 WRITE(iout,1300)ifunc(nfunc),yfac_unl
283 ELSEIF(iunl_for == 2 .or. iunl_for == 3) THEN
284 write(iout,1400) hys, shape
285 ENDIF
286 WRITE(iout,1500) itens
287 ENDIF
288C-----------------
289 RETURN
290C-----------------
291 1000 FORMAT
292 & (5x,'TABULATED OGDEN MATERIAL LAW-(LAW88)',/,
293 & 5x,'------------------------------------',//)
294 1010 FORMAT(/
295 & 5x,a,/,
296 & 5x,'MATERIAL NUMBER. . . . . . . . . . . . . .=',i10/,
297 & 5x,'MATERIAL LAW . . . . . . . . . . . . . . .=',i10/)
298 1020 FORMAT(
299 & 5x,'INITIAL DENSITY. . . . . . . . . . . . . .=',1pg20.13/)
300 1100 FORMAT
301 &(5x,'POISSON RATIO. . . . . . . . . . . . . . =',1pg20.13/
302 &,5x,'BULK MODULUS. . . . . . . . . . . . . . . =',1pg20.13/
303 &,5x,'STRAIN RATE EFFECT FLAG . .. . . . . . . =',i10/
304 &,5x,'NUMBER OF LOADING FUNCTION . . .. . . . .=',i10//)
305 1200 FORMAT(
306 & 5x,'LOADING STRESS-STRAIN FUNCTION NUMBER. . .=',i10/
307 & 5x,'STRESS SCALE FACTOR. . . . . . . . . . . .=',1pg20.13/
308 & 5x,'STRAIN RATE . . . . . . . . . . . . . . . =',1pg20.13)
309 1250 FORMAT(
310 & 5x,'STRAIN RATE FILTERING FLAG. . . . . . . . =',i10/
311 & 5x,'STRAIN RATE FILTERING CUTOFF FREQUENCY. . =',1pg20.13/)
312 1300 FORMAT(
313 & 5x,'UNLOADING STRESS-STRAIN FUNCTION NUMBER. .=',i10/
314 & 5x,'STRESS SCALE FACTOR. . . . . . . . . . . .=',1pg20.13/)
315 1400 FORMAT
316 &(5x,'HYSTERETIC UNLOADING FACTOR. . . . . . . =',1pg20.13/
317 &,5x,'SHAPE UNLOADING FACTOR. . . . . . . . . . =',1pg20.13//)
318 1500 FORMAT
319 &(5x,'ITENSION : PARAMETER FOR UNLOADING . . . .=',i10/)
320C-----------------
321 RETURN
322
323
324 END SUBROUTINE hm_read_mat88
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_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
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:523
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:284
hm_read_mat88
subroutine hm_read_mat88(uparam, maxuparam, nuparam, israte, imatvis, nuvar, ifunc, maxfunc, nfunc, parmat, unitab, mat_id, titr, mtag, lsubmodel, pm, ipm, matparam)
Definition hm_read_mat88.F:46
elbuftag_mod
Definition elbuftag_mod.F:227
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
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:889
nl
character *2 function nl()
Definition message.F:2354
elbuftag_mod::mlaw_tag_
Definition elbuftag_mod.F:232
submodel_mod::submodel_data
Definition submodel_mod.F:723