OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat77.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_mat77 (uparam, maxuparam, nuparam, nuvar, nfunc, maxfunc, ifunc, parmat, mat_id, pm, israte, imatvis, titr, unitab, lsubmodel, matparam, jale)

Function/Subroutine Documentation

◆ hm_read_mat77()

subroutine hm_read_mat77 ( intent(inout) uparam,
integer, intent(in) maxuparam,
integer, intent(inout) nuparam,
integer, intent(inout) nuvar,
integer, intent(inout) nfunc,
integer, intent(in) maxfunc,
integer, dimension(maxfunc), intent(inout) ifunc,
intent(inout) parmat,
integer, intent(in) mat_id,
intent(inout) pm,
integer, intent(inout) israte,
integer, intent(inout) imatvis,
character(len=nchartitle), intent(in) titr,
type (unit_type_), intent(in) unitab,
type(submodel_data), dimension(*), intent(in) lsubmodel,
type(matparam_struct_), intent(inout) matparam,
integer, intent(inout) jale )

Definition at line 41 of file hm_read_mat77.F.

46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE unitab_mod
50 USE elbuftag_mod
51 USE message_mod
52 USE matparam_def_mod
53 USE submodel_mod
54 USE names_and_titles_mod , ONLY : nchartitle
55C-----------------------------------------------
56C ROUTINE DESCRIPTION :
57C ===================
58C READ MAT LAW77 WITH HM READER
59C this law is Ale law for air and foam is in lagrangian and is not activated thru ale option.
60C-----------------------------------------------
61C DUMMY ARGUMENTS DESCRIPTION:
62C ===================
63C UNITAB UNITS ARRAY
64C MAT_ID MATERIAL ID(INTEGER)
65C TITR MATERIAL TITLE
66C LSUBMODEL SUBMODEL STRUCTURE
67C-----------------------------------------------
68C I m p l i c i t T y p e s
69C-----------------------------------------------
70#include "implicit_f.inc"
71C-----------------------------------------------
72C C o m m o n B l o c k s
73C-----------------------------------------------
74#include "units_c.inc"
75#include "param_c.inc"
76C-----------------------------------------------
77C D u m m y A r g u m e n t s
78C-----------------------------------------------
79 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
80 INTEGER, INTENT(IN) :: MAT_ID,MAXUPARAM,MAXFUNC
81 my_real, DIMENSION(NPROPM) ,INTENT(INOUT) :: pm
82 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
83 INTEGER, INTENT(INOUT) :: NUPARAM,NUVAR,NFUNC,ISRATE,IMATVIS,JALE
84 INTEGER, DIMENSION(MAXFUNC) ,INTENT(INOUT) :: IFUNC
85 my_real, DIMENSION(MAXUPARAM) ,INTENT(INOUT) :: uparam
86 my_real, DIMENSION(100),INTENT(INOUT) :: parmat
87 TYPE(MATPARAM_STRUCT_) ,INTENT(INOUT) :: MATPARAM
88 TYPE(SUBMODEL_DATA), DIMENSION(*),INTENT(IN) :: LSUBMODEL
89C-----------------------------------------------
90C L o c a l V a r i a b l e s
91C-----------------------------------------------
92 INTEGER :: I,J,ILAW,NRATEN,NRATEP,LFUNC,IUNLOAD,IFUNCR,IFUNCK,
93 . IFLAG,NPAR_FOAM,ICLOS,INCGAS
94 my_real :: e,nu,g,rhoa,rho0,rhor,visc,viscv,expo,hys,frac,
95 . fcut, a1,a2,e0,emax,epsmax,p0,aa,bb,kk,taux,bulk,eint0,
96 . gamma,pext,fp_ini,rhoext,eint_ext,fscal_unit
97 INTEGER ,DIMENSION(15) :: FLOAD,FUNLOAD
98 my_real ,DIMENSION(30) :: rate,yfac,rload,sload,runload,sunload
99 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
100C=======================================================================
101 is_encrypted = .false.
102 is_available = .false.
103c
104 ilaw = 77
105 imatvis = 2
106 jale = 3
107c------------------------------------------
108 CALL hm_option_is_encrypted(is_encrypted)
109c------------------------------------------
110c
111c foam input cards
112c
113 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
114 CALL hm_get_floatv('Refer_Rho' ,rhor ,is_available, lsubmodel, unitab)
115c
116 CALL hm_get_floatv('MAT_E' ,e0 ,is_available, lsubmodel, unitab)
117 CALL hm_get_floatv('MAT_NU' ,nu ,is_available, lsubmodel, unitab)
118 CALL hm_get_floatv('E_Max' ,emax ,is_available, lsubmodel, unitab)
119 CALL hm_get_floatv('MAT_EPS' ,epsmax ,is_available, lsubmodel, unitab)
120 CALL hm_get_floatv('MAT_FP0' ,fp_ini ,is_available, lsubmodel, unitab)
121c
122 CALL hm_get_floatv('MAT_asrate' ,fcut ,is_available, lsubmodel, unitab)
123 CALL hm_get_intv ('ISRATE' ,israte ,is_available,lsubmodel)
124 CALL hm_get_intv ('NRATEP' ,nratep ,is_available,lsubmodel)
125 CALL hm_get_intv ('NRATEN' ,nraten ,is_available,lsubmodel)
126 CALL hm_get_intv ('MAT_Iflag' ,iunload ,is_available,lsubmodel)
127 CALL hm_get_floatv('MAT_SHAPE' ,expo ,is_available, lsubmodel, unitab)
128 CALL hm_get_floatv('MAT_HYST' ,hys ,is_available, lsubmodel, unitab)
129c
130 IF (nratep > 0) THEN
131 DO i=1,nratep
132 CALL hm_get_int_array_index ('FUN_LOAD' ,fload(i),i,is_available,lsubmodel)
133 CALL hm_get_float_array_index('STRAINRATE_LOAD',rload(i),i,is_available,lsubmodel,unitab)
134 CALL hm_get_float_array_index('SCALE_LOAD' ,sload(i),i,is_available,lsubmodel,unitab)
135 ENDDO
136 ENDIF
137c
138 IF (nraten > 0) THEN
139 DO i=1,nraten
140 CALL hm_get_int_array_index ('FUN_UNLOAD' ,funload(i),i,is_available,lsubmodel)
141 CALL hm_get_float_array_index('STRAINRATE_UNLOAD',runload(i),i,is_available,lsubmodel,unitab)
142 CALL hm_get_float_array_index('SCALE_UNLOAD' ,sunload(i),i,is_available,lsubmodel,unitab)
143 ENDDO
144 ENDIF
145c
146c air input cards
147c
148 CALL hm_get_floatv('Lqud_Rho_g' ,rhoa ,is_available, lsubmodel, unitab)
149 CALL hm_get_floatv('MAT_P0' ,p0 ,is_available, lsubmodel, unitab)
150 CALL hm_get_floatv('GAMMA' ,gamma ,is_available, lsubmodel, unitab)
151 CALL hm_get_floatv('MAT_POROS' ,frac ,is_available, lsubmodel, unitab)
152c
153 CALL hm_get_floatv('Rho_Gas' ,rhoext ,is_available, lsubmodel, unitab)
154 CALL hm_get_floatv('PEXT' ,pext ,is_available, lsubmodel, unitab)
155 CALL hm_get_intv ('ISFLAG' ,iclos ,is_available,lsubmodel)
156 CALL hm_get_intv ('Gflag' ,incgas ,is_available,lsubmodel)
157c
158 CALL hm_get_floatv('MAT_ALPHA' ,aa ,is_available, lsubmodel, unitab)
159 CALL hm_get_floatv('MAT_Beta' ,bb ,is_available, lsubmodel, unitab)
160 CALL hm_get_floatv('tau_shear' ,taux ,is_available, lsubmodel, unitab)
161 CALL hm_get_floatv('MAT_K' ,kk ,is_available, lsubmodel, unitab)
162c
163 CALL hm_get_intv ('FUN_A1' ,ifunck ,is_available,lsubmodel)
164 CALL hm_get_intv ('FUN_B1' ,ifuncr ,is_available,lsubmodel)
165c
166 CALL hm_get_floatv_dim('SCALE_LOAD',fscal_unit,is_available,lsubmodel,unitab)
167c-----------------------------------------------------------------------
168c Check consistency of tabulated input data
169c-----------------------------------------------------------------------
170 IF (nratep == 0) THEN
171 CALL ancmsg(msgid=866,
172 . msgtype=msgerror,
173 . anmode=aninfo_blind,
174 . i1=mat_id,
175 . c1=titr)
176 ENDIF
177 IF (nraten == 0 .AND. (iunload == 0 .OR. iunload == 1) ) THEN
178 CALL ancmsg(msgid=867,
179 . msgtype=msgerror,
180 . anmode=aninfo_blind,
181 . i1=mat_id,
182 . c1=titr)
183 ENDIF
184
185c
186 DO i = 1, nratep
187 IF (sload(i) == zero) sload(i) = one*fscal_unit
188 ifunc(i) = fload(i)
189 rate(i) = rload(i)
190 yfac(i) = sload(i)
191 ENDDO
192 nfunc = nratep + nraten
193 DO i = 1, nraten
194 j = nratep + i
195 IF (sunload(i) == zero) sunload(i) = one*fscal_unit
196 ifunc(j) = funload(i)
197 rate(j) = runload(i)
198 yfac(j) = sunload(i)
199 ENDDO
200c
201 DO i=1,nfunc
202 IF (ifunc(i) == 0)THEN
203 CALL ancmsg(msgid=126,
204 . msgtype=msgerror,
205 . anmode=aninfo_blind_1,
206 . i1=mat_id,
207 . c1=titr,
208 . i2=ifunc(i))
209 ENDIF
210 ENDDO
211c---
212 ifunc(nfunc + 1) = ifunck
213 ifunc(nfunc + 2) = ifuncr
214 nfunc = nfunc + 2
215c-----------------------------------------------------------------------
216c Default values
217c-----------------------------------------------------------------------
218 IF (emax == zero) emax = e0
219 IF (epsmax == zero) epsmax = one
220 IF (gamma == zero) gamma = onep4
221 IF (rhoext == 0) rhoext = rhoa
222 IF (expo == zero) expo = one
223 IF (hys == zero) hys = one
224 IF (iunload == 0) iunload = 1
225 israte = 1 ! force strain rate computation
226 IF (fcut == zero) fcut = infinity
227c-----------------------------------------------------------------------
228 eint0 = p0/(gamma - one)
229 eint_ext = pext/(gamma - one)
230 a1 = (emax-e0) / epsmax
231 g = half*e0 / (one + nu)
232 bulk = e0/three / (one - two*nu)
233 eint0 = p0/(gamma - one)
234 eint_ext = pext/(gamma - one)
235c-----------------------------------------------------------------------
236 uparam(2) = e0
237 uparam(3) = a1
238 uparam(4) = epsmax
239 uparam(5) = g
240 uparam(6) = nu
241 uparam(7) = nratep
242 uparam(8) = nraten
243 DO i=1,nfunc - 2
244 uparam(i + 8) = rate(i)
245 uparam(i + 8 + nfunc) = yfac(i)
246 END DO
247 uparam(2*nfunc + 9) = iunload
248 uparam(2*nfunc + 10) = expo
249 uparam(2*nfunc + 11) = hys
250 uparam(2*nfunc + 12) = emax
251 npar_foam = 13 + 2*nfunc
252 uparam(npar_foam + 1) = rhoa
253 uparam(npar_foam + 2) = p0
254 uparam(npar_foam + 3) = gamma
255 uparam(npar_foam + 4) = frac
256 uparam(npar_foam + 5) = pext
257 uparam(npar_foam + 6) = fp_ini
258 uparam(npar_foam + 7) = eint0
259 uparam(npar_foam + 8) = kk
260c-----------------------------------------------------------------------
261 nuparam = npar_foam + 8
262 nuvar = 23
263c-----------------------------------------------------------------------
264
265 parmat(1) = bulk
266 parmat(2) = e0
267 parmat(3) = nu
268 parmat(4) = israte
269 parmat(5) = fcut
270 parmat(16) = 2 ! Formulation for solid elements time step computation
271 parmat(17) = (one - two*nu)/(one - nu)
272c
273 pm(192) = rhoa
274 pm(193) = frac
275 pm(194) = aa
276 pm(195) = bb
277 pm(196) = taux
278 pm(197) = kk
279 pm(198) = iclos
280 pm(199) = rhoext
281 pm(200) = eint_ext
282 pm(201) = incgas
283c--------------------------
284 pm(1) = rhor
285 pm(89) = rho0
286c----------------
287 IF (nu > 0.49) THEN
288 CALL init_mat_keyword(matparam,"INCOMPRESSIBLE")
289 ELSE
290 CALL init_mat_keyword(matparam,"COMPRESSIBLE")
291 ENDIF
292 CALL init_mat_keyword(matparam,"HOOK")
293 ! Properties compatibility
294 CALL init_mat_keyword(matparam,"SOLID_ISOTROPIC")
295c--------------------------------------------------
296c Starter output
297c--------------------------------------------------
298 WRITE(iout,1000) trim(titr),mat_id,77
299 WRITE(iout,1100)
300 IF (is_encrypted) THEN
301 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
302 ELSE
303 WRITE(iout,1200) rho0
304 WRITE(iout,1300) e0,nu,emax,epsmax,fp_ini
305 WRITE(iout,1400) fcut,israte,nratep,nraten,iunload,expo,hys
306 WRITE(iout,1500)(ifunc(j),rate(j),yfac(j),j=1,nratep)
307 WRITE(iout,1600)(ifunc(j+nratep),rate(j+nratep),yfac(j+nratep),j=1,nraten)
308 WRITE(iout,2000)
309 WRITE(iout,2100) rhoa,p0,gamma,frac,ifuncr
310 WRITE(iout,2200)
311 WRITE(iout,2300) rhoext,pext,iclos,incgas
312 WRITE(iout,3000)
313 WRITE(iout,3100) aa,bb,taux,kk,ifunck
314 ENDIF
315c-----------------------------------------------------------------------
316 1000 FORMAT(/
317 & 5x,a,/,
318 & 5x,'MATERIAL NUMBER. . . . . . . . . . . . . . .=',i10/,
319 & 5x,'MATERIAL LAW . . . . . . . . . . . . . . . .=',i10/)
320 1100 FORMAT
321 &(5x,'MATERIAL : TABULATED NON-LINEAR VISCO ELASTIC (LAW77) ',/,
322 & 5x,'----------------------------------------------------- ',/)
323 1200 FORMAT(
324 & 5x,'INITIAL DENSITY . . . . . . . . . . . . .=',1pg20.13/)
325 1300 FORMAT(
326 & 5x,'INITIAL YOUNG''S MODULUS . . . . . . . . . .=',1pg20.13/,
327 & 5x,'POISSON''S RATIO . . . . . . . . . . . . . .=',1pg20.13/,
328 & 5x,'MAXIMUM YOUNG''S MODULUS . . . . . . . . . .=',1pg20.13/,
329 & 5x,'MAXIMUM STRAIN . . . . . . . . . . . . . .=',1pg20.13/,
330 & 5x,'INITIAL FOAM PRESSURE. . . . . . . . . . . .=',1pg20.13/)
331 1400 FORMAT(
332 & 5x,'STRAIN RATE CUTOFF FREQUENCY . . . . . . . .=',1pg20.13/,
333 & 5x,'FLAG FOR STRAIN RATE . . . . . . . .=',i10/,
334 & 5x,'NUMBER OF LOAD STRESS FUNCTIONS . . . . . .=',i10/,
335 & 5x,'NUMBER OF UNLOAD STRESS FUNCTIONS. . . . . .=',i10/,
336 & 5x,'CHOICE OF UNLOADING FORMULATION. . . . . . .=',i10/,
337 & 5x,'SHAPE FACTOR FOR UNLOADING . . . . . . . . .=',1pg20.13/,
338 & 5x,'HYSTERETIC UNLOADING FACTOR . . . . . . . .=',1pg20.13 )
339 1500 FORMAT(
340 & 5x,'LOAD YIELD STRESS FUNCTION NUMBER. . . . . .=',i10/,
341 & 5x,'STRAIN RATE. . . . . . . . . . . . . . . . .=',1pg20.13/,
342 & 5x,'SCALE FACTOR . . . . . . . . . . . . . . . .=',1pg20.13/)
343 1600 FORMAT(
344 & 5x,'UNLOAD YIELD STRESS FUNCTION NUMBER. . . . .=',i10/,
345 & 5x,'STRAIN RATE. . . . . . . . . . . . . . . . .=',1pg20.13/,
346 & 5x,'SCALE FACTOR . . . . . . . . . . . . . . . .=',1pg20.13/)
347 2000 FORMAT(
348 & 5x,' GAS PARAMETERS' ,/,
349 & 5x,' -----------------',/)
350 2100 FORMAT(
351 & 5x,'DENSITY. . . . . . . . . . . . . . . . . . .=',1pg20.13/,
352 & 5x,'P0 . . . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
353 & 5x,'GAMMA. . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
354 & 5x,'INITIAL GAS FRACTION (R) . . . . . . . . . .=',1pg20.13/,
355 & 5x,'SCALE FUNCTION FOR GAS FRACTION R(V/V0). . .=',i10/)
356 2200 FORMAT(
357 & 5x,' EXTERNAL GAS PARAMETERS' ,/,
358 & 5x,' -----------------------',/)
359 2300 FORMAT(
360 & 5x,'DENSITY. . . . . . . . . . . . . . . . . . .=',1pg20.13/,
361 & 5x,'PEXT. . . . . . . .. . . . . . . . . . . . .=',1pg20.13/,
362 & 5x,'FLAG FOR CLOSED FOAM . . . . . . . . . . . .=',i10/
363 & 5x,'INCOMNIG GAS FLAG. . . . . . . . . . . . . .=',i10/ )
364 3000 FORMAT(
365 & 5x,' DARCY PARAMETERS ',/,
366 & 5x,' -----------------',/)
367 3100 FORMAT(
368 & 5x,'A. . . . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
369 & 5x,'BETA . . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
370 & 5x,'TAUX . . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
371 & 5x,'INITIAL PERMEABILITY (K) . . . . . . . . . .=',1pg20.13/
372 & 5x,'SCALE FUNCTION FOR PERMEABILITY K(V/V0). . .=',i10/ )
373c-----------------------------------------------------------------------
374 RETURN
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_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_floatv_dim
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
Definition hm_get_floatv_dim.F:159
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
init_mat_keyword
subroutine init_mat_keyword(matparam, keyword)
Definition init_mat_keyword.F:150
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