OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat90.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_mat90 (uparam, maxuparam, nuparam, nuvar, ifunc, maxfunc, nfunc, parmat, unitab, id, titr, israte, pm, imatvis, lsubmodel, mtag, matparam, nvartmp)

Function/Subroutine Documentation

◆ hm_read_mat90()

subroutine hm_read_mat90 ( dimension(maxuparam), intent(inout) uparam,
integer, intent(inout) maxuparam,
integer, intent(inout) nuparam,
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) id,
character(len=nchartitle), intent(in) titr,
integer, intent(inout) israte,
dimension(npropm), intent(inout) pm,
integer, intent(inout) imatvis,
type(submodel_data), dimension(*), intent(in) lsubmodel,
type(mlaw_tag_), intent(inout) mtag,
type(matparam_struct_), intent(inout) matparam,
integer, intent(inout) nvartmp )

Definition at line 42 of file hm_read_mat90.F.

46C-----------------------------------------------
47C ROUTINE DESCRIPTION :
48C ===================
49C READ MAT LAW90 WITH HM READER
50C-----------------------------------------------
51C DUMMY ARGUMENTS DESCRIPTION:
52C ===================
53C
54C NAME DESCRIPTION
55C
56C IPM MATERIAL ARRAY(INTEGER)
57C PM MATERIAL ARRAY(REAL)
58C UNITAB UNITS ARRAY
59C ID MATERIAL ID(INTEGER)
60C TITR MATERIAL TITLE
61C LSUBMODEL SUBMODEL STRUCTURE
62C-----------------------------------------------
63C M o d u l e s
64C-----------------------------------------------
65 USE unitab_mod
66 USE message_mod
67 USE table_mod
68 USE submodel_mod
69 USE matparam_def_mod
70 USE elbuftag_mod
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, INTENT(INOUT) :: parmat(100),uparam(maxuparam),pm(npropm)
86 INTEGER, INTENT(INOUT) :: IFUNC(MAXFUNC),NFUNC,MAXFUNC,MAXUPARAM,NUPARAM, NUVAR,ISRATE,IMATVIS
87 INTEGER, INTENT(INOUT) :: NVARTMP
88 INTEGER, INTENT(IN) :: ID
89 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
90 TYPE(SUBMODEL_DATA),INTENT(IN) :: LSUBMODEL(*)
91 TYPE(MLAW_TAG_),INTENT(INOUT) :: MTAG
92 TYPE(MATPARAM_STRUCT_) ,INTENT(INOUT) :: MATPARAM
93C-----------------------------------------------
94C L o c a l V a r i a b l e s
95C-----------------------------------------------
96 INTEGER I,J,IFLAG,IDAM ,ISMOOTH ,TFLAG,FAIL
97 my_real e0,nu,fcut,g,c1,shape,hys,alpha
98 my_real rate(1000),yfac(1000),yfac_dim(1000)
99 my_real :: rho0, rhor,fcut_unit,econt,tcut
100 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
101C-----------------------------------------------
102C S o u r c e L i n e s
103C-----------------------------------------------
104 is_encrypted = .false.
105 is_available = .false.
106 idam = 0
107 israte = 0
108 imatvis = 2
109
110 CALL hm_option_is_encrypted(is_encrypted)
111
112 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
113 CALL hm_get_floatv('Refer_Rho' ,rhor ,is_available, lsubmodel, unitab)
114 CALL hm_get_floatv('MAT_E0' ,e0 ,is_available, lsubmodel, unitab)
115 CALL hm_get_floatv('MAT_NU' ,nu ,is_available, lsubmodel, unitab)
116 CALL hm_get_intv ('NL' ,nfunc ,is_available, lsubmodel)
117 CALL hm_get_intv ('Ismooth' ,ismooth ,is_available, lsubmodel)
118 CALL hm_get_floatv('Fcut' ,fcut ,is_available, lsubmodel, unitab)
119 CALL hm_get_floatv('MAT_SHAPE' ,shape ,is_available, lsubmodel, unitab)
120 CALL hm_get_floatv('Hys' ,hys ,is_available, lsubmodel, unitab)
121 CALL hm_get_floatv('MAT_ALPHA' ,alpha ,is_available, lsubmodel, unitab)
122 CALL hm_get_intv ('MAT_TFLAG' ,tflag ,is_available, lsubmodel)
123 CALL hm_get_intv ('LSD_MAT83_FAIL' ,fail ,is_available, lsubmodel)
124 CALL hm_get_floatv('LSD_MAT83_ED' ,econt ,is_available, lsubmodel, unitab)
125 CALL hm_get_floatv('LSD_MAT83_TC' ,tcut ,is_available, lsubmodel, unitab)
126! IDAM ---> not documented, not included within LAW90.cfg
127!! CALL HM_GET_INTV ('IDAM' ,IDAM ,IS_AVAILABLE, LSUBMODEL)
128!
129 IF (nfunc == 0) THEN
130 CALL ancmsg(msgid=866,
131 . msgtype=msgerror,
132 . anmode=aninfo_blind,
133 . i1=id,
134 . c1=titr)
135 ENDIF
136 IF(tflag == 0) tflag = 1
137 IF(econt == zero) econt = e0
138 IF(tcut == zero) tcut = ep20
139!
140!... fonction de charge
141!
142 DO i=1,nfunc
143 CALL hm_get_int_array_index ('fct_IDL' ,ifunc(i) ,i ,is_available, lsubmodel)
144 CALL hm_get_float_array_index ('EpsilondotL' ,rate(i) ,i ,is_available, lsubmodel, unitab)
145 CALL hm_get_float_array_index ('FscaleL' ,yfac(i) ,i ,is_available, lsubmodel, unitab)
146 CALL hm_get_float_array_index_dim('FscaleL' ,yfac_dim(i) ,i ,is_available, lsubmodel, unitab)
147 ENDDO
148!
149 DO i=1,nfunc
150 IF (ifunc(i) == 0) THEN
151 CALL ancmsg(msgid=126,
152 . msgtype=msgerror,
153 . anmode=aninfo_blind_1,
154 . i1=id,
155 . c1=titr,
156 . i2=ifunc(i))
157 ENDIF
158 IF(yfac(i) == zero) yfac(i) = yfac_dim(i) * one
159 ENDDO
160 hys = abs(hys)
161 iflag = 0
162 IF (nfunc > 0 .AND. hys == zero) iflag = 1
163 IF (nfunc > 0 .AND. hys > zero) iflag = 2 ! unloading is quasi-static
164 IF (shape == zero) shape = one
165 IF (alpha == zero) alpha = one
166 IF (hys == zero) hys = one
167 IF (rhor==zero) rhor=rho0
168 IF (fcut == zero .AND. nfunc > 1 ) THEN
169 fcut = ep03*unitab%FAC_T_WORK
170 ismooth = 1
171 ENDIF
172 IF(ismooth == 0 .AND. fcut > zero .AND. nfunc > 1) ismooth = 1
173 IF(nfunc == 1) ismooth = 0
174 pm(1) = rhor
175 pm(89)= rho0
176
177 g = half*e0/(one + nu)
178 uparam(1) = e0
179 uparam(4) = g
180 uparam(5) = nu
181 uparam(6) = shape
182 uparam(7) = hys
183 uparam(9) = iflag
184 uparam(10) = idam
185 DO i=1,nfunc
186 uparam(i + 10) = rate(i)
187 uparam(i + 10 + nfunc) = yfac(i)
188 END DO
189 nuparam =13 + 2*nfunc
190 uparam(nuparam) = alpha
191 nuparam = nuparam + 1
192 uparam(nuparam) = tflag
193 nuparam = nuparam + 1
194 uparam(nuparam ) = fail
195 nuparam = nuparam + 1
196 uparam(nuparam ) = tcut
197 nuparam = nuparam + 1
198 uparam(nuparam ) = econt
199!
200 c1=econt /three/(one - two*nu)
201 parmat(1) = c1
202 parmat(2) = econt
203 parmat(3) = nu
204 parmat(4) = ismooth
205 parmat(5) = fcut
206
207 israte = ismooth
208 nuvar = 10
209 nvartmp = nfunc*3
210 ! MTAG variable activation
211 mtag%G_EPSD = 1
212 mtag%L_EPSD = 1
213C
214 WRITE(iout,1000)
215 WRITE(iout,1001) trim(titr),id,90
216 IF (is_encrypted) THEN
217 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
218 ELSE
219 WRITE(iout,1100)rho0
220 WRITE(iout,1150)e0,nu, tflag, econt, tcut,fail
221 WRITE(iout,1200)fcut,ismooth,shape,hys,alpha
222 WRITE(iout,1300)(ifunc(j),rate(j),yfac(j),j=1,nfunc )
223 ENDIF
224c-----------------
225 CALL init_mat_keyword(matparam,"TOTAL")
226 IF (nu >= 0.49) THEN
227 CALL init_mat_keyword(matparam,"INCOMPRESSIBLE")
228 ELSE
229 CALL init_mat_keyword(matparam,"COMPRESSIBLE")
230 END IF
231 CALL init_mat_keyword(matparam,"HOOK")
232 ! Properties compatibility
233 CALL init_mat_keyword(matparam,"SOLID_ISOTROPIC")
234c-----------------
235 RETURN
236!---
237 1000 FORMAT(
238 & 5x,40h tabulated non linear visco elastic law,/,
239 & 5x,40h --------------------------------------,//)
240 1001 FORMAT(/
241 & 5x,a,/,
242 & 5x,'MATERIAL NUMBER . . . . . . . . . . . .=',i10/,
243 & 5x,'MATERIAL LAW. . . . . . . . . . . . . .=',i10/)
244 1100 FORMAT(
245 & 5x,'INITIAL DENSITY . . . . . . . . . . . .=',1pg20.13/)
246 1150 FORMAT(
247 & 5x,'INITIAL YOUNG''S MODULUS. . . . . . . .=',1pg20.13/,
248 & 5x,'POISSON''S RATIO. . . . . . . . . . . .=',1pg20.13/,
249 & 5x,'TENSILE STRESS FLAG . . . . . . . . . =',i10/,
250 & 10x, '1 : FOLLOW THE INPUT CURVE ' /,
251 & 10x, '2 : FOLLOW E0 '/
252 & 5x,'OPTIONAL YOUNG MODULUS . . . . . . . . =',1pg20.13/,
253 & 5x,'TENSION CUT-OOF STRESS . . . . . . . . =',1pg20.13/,
254 & 5x,'FAILURE OPTION AFTER CUT-OFF STRESS IS REACHED =',i10/,
255 & 10x, '0 : TENSILE STRESS REMAINS AT CUT-OFF VALUE'/,
256 & 10x, '1 : THE ELEMENT IS DELETED '/)
257
258 1200 FORMAT(
259 & 5x,'STRAIN RATE COEFFICIENT . . . . . . . .=',1pg20.13/,
260 & 5x,'FLAG FOR FILTERING STRAIN RATE . . . .=',i10/,
261 & 5x,'SHAPE FACTOR FOR UNLOADING . . . . . .=',1pg20.13/,
262 & 5x,'HYSTERETIC UNLOADING FACTOR . . . . . .=',1pg20.13/,
263 & 5x,'EXPONANT FACTOR FOR UNLOADING . . . . .=',1pg20.13/)
264 1300 FORMAT(
265 & 5x,'LOADING STRESS FUNCTION NUMBER . . . .=',i10/,
266 & 5x,'STRAIN RATE . . . . . . . . . . . . . .=',1pg20.13/,
267 & 5x,'SCALE FACTOR. . . . . . . . . . . . . .=',1pg20.13/)
268 1500 FORMAT(
269 & 5x,'PRESSURE DEPENDENT YIELD FUNCTION . . .=',i10/
270 & 5x,'PRESSURE SCALE FACTOR . . . . . . . . .=',1pg20.13)
#define my_real
Definition cppsort.cpp:32
#define alpha
Definition eval.h:35
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
subroutine hm_get_float_array_index_dim(name, dim_fac, index, is_available, lsubmodel, unitab)
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_is_encrypted(is_encrypted)
subroutine init_mat_keyword(matparam, keyword)
initmumps id
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:889
subroutine tabulated(iflag, nel, pm, off, eint, mu, espe, dvol, df, vnew, mat, psh, pnew, dpdm, dpde, npf, tf)
Definition tabulated.F:32