OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat88.F File Reference
#include "implicit_f.inc"
#include "units_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_mat88 (uparam, maxuparam, nuparam, israte, imatvis, nuvar, ifunc, maxfunc, nfunc, parmat, unitab, mat_id, titr, mtag, lsubmodel, pm, ipm, matparam)

Function/Subroutine Documentation

◆ hm_read_mat88()

subroutine hm_read_mat88 ( dimension(maxuparam), intent(inout) uparam,
integer, intent(inout) maxuparam,
integer, intent(inout) nuparam,
integer, intent(inout) israte,
integer, intent(inout) imatvis,
integer, intent(inout) nuvar,
integer, dimension(maxfunc), intent(inout) ifunc,
integer, intent(inout) maxfunc,
integer, intent(inout) nfunc,
dimension(100), intent(inout) parmat,
type (unit_type_), intent(in) unitab,
integer, intent(in) mat_id,
character(len=nchartitle), intent(in) titr,
type(mlaw_tag_), intent(inout) mtag,
type(submodel_data), dimension(*), intent(in) lsubmodel,
dimension(npropm), intent(inout) pm,
integer, dimension(npropmi), intent(inout) ipm,
type(matparam_struct_), intent(inout) matparam )

Definition at line 42 of file hm_read_mat88.F.

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.or. ELSEIF(IUNL_FOR == 2 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
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
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
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
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
nl
character *2 function nl()
Definition message.F:2354
tabulated
subroutine tabulated(iflag, nel, pm, off, eint, mu, espe, dvol, df, vnew, mat, psh, pnew, dpdm, dpde, npf, tf)
Definition tabulated.F:32