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

Function/Subroutine Documentation

◆ hm_read_mat43()

subroutine hm_read_mat43 ( 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 41 of file hm_read_mat43.F.

45C-----------------------------------------------
46C D e s c r i p t i o n
47C-----------------------------------------------
48C READ MAT LAW43 WITH HM READER ( TO BE COMPLETED )
49C
50C DUMMY ARGUMENTS DESCRIPTION:
51C ===================
52C
53C NAME DESCRIPTION
54C
55C PM MATERIAL ARRAY(REAL)
56C UNITAB UNITS ARRAY
57C MAT_ID MATERIAL ID(INTEGER)
58C TITR MATERIAL TITLE
59C LSUBMODEL SUBMODEL STRUCTURE
60C
61C-----------------------------------------------
62C M o d u l e s
63C-----------------------------------------------
64 USE unitab_mod
65 USE elbuftag_mod
66 USE message_mod
67 USE submodel_mod
68 USE matparam_def_mod
70C-----------------------------------------------
71C I m p l i c i t T y p e s
72C-----------------------------------------------
73#include "implicit_f.inc"
74C-----------------------------------------------
75C C o m m o n B l o c k s
76C-----------------------------------------------
77#include "units_c.inc"
78#include "param_c.inc"
79C-----------------------------------------------
80C D u m m y A r g u m e n t s
81C-----------------------------------------------
82 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
83 my_real, INTENT(INOUT) :: pm(npropm),parmat(100),uparam(maxuparam)
84 INTEGER, INTENT(INOUT) :: IPM(NPROPMI),ISRATE,IFUNC(MAXFUNC),NFUNC,MAXFUNC,
85 . 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 INTEGER I,J,NRATE,NPS,IR0
95 my_real
96 . e,nu,g,c1,epsmax,epsr1,epsr2,rate(11),yfac(11),
97 . r0,r45,r90,r,h,fisokin,m,
98 . einf,ce,fac_pres
99 INTEGER IFUNCE, OPTE, NUM_FUNC,NUMCURVES
100 my_real :: rho0, rhor, asrate
101 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
102C-----------------------------------------------
103C S o u r c e L i n e s
104C-----------------------------------------------
105 is_encrypted = .false.
106 is_available = .false.
107 mtag%G_PLA = 1
108 mtag%G_SEQ = 1
109 mtag%L_PLA = 1
110 mtag%L_SEQ = 1
111 mtag%L_EPSD = 1
112 mtag%G_EPSD = 1
113 israte = 0
114 imatvis = 0
115
116
117 CALL hm_option_is_encrypted(is_encrypted)
118 !line+1
119 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
120 !line-2
121 CALL hm_get_floatv('MAT_E' ,e ,is_available, lsubmodel, unitab)
122 CALL hm_get_floatv('MAT_NU' ,nu ,is_available, lsubmodel, unitab)
123 !line-3
124 CALL hm_get_intv ('Yr_fun' ,ifunce ,is_available, lsubmodel)
125 CALL hm_get_floatv('MAT_EFIB' ,einf ,is_available, lsubmodel, unitab)
126 CALL hm_get_floatv('MAT_C' ,ce ,is_available, lsubmodel, unitab)
127 !line-4
128 CALL hm_get_floatv('MAT_R00' ,r0 ,is_available, lsubmodel, unitab)
129 CALL hm_get_floatv('MAT_R45' ,r45 ,is_available, lsubmodel, unitab)
130 CALL hm_get_floatv('MAT_R90' ,r90 ,is_available, lsubmodel, unitab)
131 CALL hm_get_floatv('MAT_CHARD' ,fisokin ,is_available, lsubmodel, unitab)
132 CALL hm_get_intv ('MAT_Iyield' ,ir0 ,is_available, lsubmodel)
133 !line-5
134 CALL hm_get_floatv('MAT_EPS' ,epsmax ,is_available, lsubmodel, unitab)
135 CALL hm_get_floatv('MAT_EPST1' ,epsr1 ,is_available, lsubmodel, unitab)
136 CALL hm_get_floatv('MAT_EPST2' ,epsr2 ,is_available, lsubmodel, unitab)
137 CALL hm_get_floatv('Fcut' ,asrate ,is_available, lsubmodel, unitab)
138 CALL hm_get_intv ('Fsmooth' ,israte ,is_available, lsubmodel)
139 !unit
140 CALL hm_get_floatv_dim('MAT_E' ,fac_pres ,is_available, lsubmodel, unitab)
141 !num_curves
142 CALL hm_get_intv ('NUM_CURVES' ,numcurves ,is_available, lsubmodel)
143
144 !========== DEFAULT VALUES=============!
145 rhor=rho0
146 !IF(RHOR==ZERO)RHOR=RHO0
147 pm(1) =rhor
148 pm(89)=rho0
149 nrate = 0
150
151 DO i=1,numcurves
152 CALL hm_get_int_array_index ('FunctionIds' ,ifunc(i) ,i ,is_available, lsubmodel)
153 CALL hm_get_float_array_index ('ABG_cpa' ,yfac(i) ,i ,is_available, lsubmodel, unitab)
154 CALL hm_get_float_array_index ('ABG_cpb' ,rate(i) ,i ,is_available, lsubmodel, unitab)
155 IF(ifunc(i)/=0) nrate = i
156 ENDDO
157
158 IF (nrate == 0) THEN
159 CALL ancmsg(msgid=366,
160 . msgtype=msgerror,
161 . anmode=aninfo,
162 . i1=mat_id,
163 . c1=titr)
164 ENDIF
165C
166 IF(r0 ==zero) r0 = one
167 IF(r45==zero) r45 = one
168 IF(r90==zero) r90 = one
169 IF(epsr1==zero)epsr1=infinity
170 IF(epsr2==zero)epsr2=two*infinity
171 DO i=1,nrate
172 IF(yfac(i)==zero) yfac(i)=one * fac_pres
173 ENDDO
174C
175 !----------------------------------------------------------
176 ! Filtering frequency
177 IF (asrate /= zero) THEN
178 ! If a filtering frequency is given by the user
179 israte = 1
180 ELSE
181 ! If no filtering frequency is given but the flag is activated
182 IF (israte /= 0) THEN
183 asrate = 10000.0d0*unitab%FAC_T_WORK
184 ! If no filtering frequency and no flag is activated => no filtering
185 ELSE
186 asrate = zero
187 ENDIF
188 ENDIF
189 !----------------------------------------------------------
190C
191 IF (nrate == 1) THEN
192 num_func=2
193 ifunc(2)=ifunc(1)
194 rate(1)=zero
195 rate(2)=one
196 yfac(2)=yfac(1)
197 ELSEIF (rate(1) == 0) THEN
198 num_func=nrate
199 ELSE
200 num_func=nrate+1
201 DO j=nrate,1,-1
202 ifunc(j+1)=ifunc(j)
203 rate(j+1)=rate(j)
204 yfac(j+1)=yfac(j)
205 ENDDO
206 rate(1)=zero
207 ENDIF
208C
209 uparam(1)=num_func
210 uparam(2)=e
211 uparam(3)=e/(one-nu*nu)
212 uparam(4)=nu*uparam(3)
213 g=half*e/(one+nu)
214 uparam(5)=g
215 uparam(6)=nu
216 r=(r0+r45+r45+r90)*fourth
217 h=r/(one+r)
218C-----------A1,A2,A3,A12--------
219 uparam(7)=h*(one+one/r0)
220 uparam(8)=h*(one+one/r90)
221 uparam(9)=h*two
222 uparam(10)=(r45*two + one)*(uparam(7)+uparam(8)-uparam(9))
223 IF (ir0 > 0) THEN
224 uparam(8)=uparam(8)/uparam(7)
225 uparam(9)=uparam(9)/uparam(7)
226 uparam(10)=uparam(10)/uparam(7)
227 uparam(7)=one
228 END IF
229 nps=10
230 DO j=1,num_func
231 uparam(j+nps)=rate(j)
232 ENDDO
233 DO j=1,num_func
234 uparam(j+nps+num_func)=yfac(j)
235 ENDDO
236 uparam(nps+2*num_func+1)=epsmax
237 uparam(nps+2*num_func+2)=epsr1
238 uparam(nps+2*num_func+3)=epsr2
239 uparam(nps+2*num_func+4)=two*g
240 uparam(nps+2*num_func+5)=three*g
241 c1=e/three/(one - two*nu)
242 uparam(nps+2*num_func+6)=c1
243 uparam(nps+2*num_func+7)=c1+ four_over_3*g
244 IF (fisokin>one.OR.fisokin<zero) THEN
245 CALL ancmsg(msgid=913,
246 . msgtype=msgerror,
247 . anmode=aninfo,
248 . i1=mat_id,
249 . c1=titr)
250 END IF
251 uparam(nps+2*num_func+8)=fisokin
252C
253c------------------------------------
254 opte = 0
255 IF (ifunce > 0 )opte = 1
256 nfunc = num_func + 1
257 ifunc(nfunc) = ifunce
258 uparam(nps+2*num_func+9) = nfunc
259 uparam(nps+2*num_func+10) = opte
260 uparam(nps+2*num_func+11) = einf
261 uparam(nps+2*num_func+12) = ce
262c
263 nuparam = nps+2*num_func+12
264c------------------------------------
265 parmat(1) = c1
266 parmat(2) = e
267 parmat(3) = nu
268 parmat(4) = israte
269 parmat(5) = asrate
270 nuvar = 5+num_func
271C
272 ! MATPARAM keywords
273 CALL init_mat_keyword(matparam,"ORTHOTROPIC")
274 ! Properties compatibility
275 CALL init_mat_keyword(matparam,"SHELL_ORTHOTROPIC")
276C
277 WRITE(iout,1001) trim(titr),mat_id,43
278 WRITE(iout,1000)
279 IF(is_encrypted)THEN
280 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
281 ELSE
282 WRITE(iout,1002) rho0
283 WRITE(iout,1100)e,nu,g,r0,r45,r90,fisokin
284 IF (ir0 >0) WRITE(iout,1110)
285 WRITE(iout,1300)epsmax,epsr1,epsr2,ifunce,einf,ce
286 WRITE(iout,1400)israte,asrate
287 WRITE(iout,1200)(ifunc(j),yfac(j),rate(j),j=1,num_func)
288 WRITE(iout,*)' '
289 ENDIF
290C
291 RETURN
292 1000 FORMAT(
293 & 5x,40h tabulated hill orthotropic plasticity,/,
294 & 5x,40h ------------------------------------- /)
295 1001 FORMAT(
296 & 5x,a,/,
297 & 5x,'material number . . . . . . . . . . . .=',I10/,
298 & 5X,'material law. . . . . . . . . . . . . .=',I10/)
299 1002 FORMAT(
300 & 5X,'initial density . . . . . . . . . . . .=',1PG20.13/)
301 1100 FORMAT(
302 & 5X,'young modulus . . . . . . . . . . . . .=',1PG20.13/
303 & 5X,'poisson ratio . . . . . . . . . . . . .=',1PG20.13/
304 & 5X,'shear modulus . . . . . . . . . . . . .=',1PG20.13/
305 & 5X,'lankford coefficient r00. . . . . . . .=',1PG20.13/
306 & 5X,'lankford coefficient r45. . . . . . . .=',1PG20.13/
307 & 5X,'lankford coefficient r90. . . . . . . .=',1PG20.13/
308 & 5X,'iso-kinematic hardening factor. . . . .=',1PG20.13)
309 1110 FORMAT(
310 & 5X,'yield stress is suppossd in orthotropic dir. 1 '/)
311 1200 FORMAT(
312 & 5X,'yield stress FUNCTION number. . . . . .=',I10/
313 & 5X,'yield scale factor. . . . . . . . . . .=',1PG20.13/
314 & 5X,'strain rate . . . . . . . . . . . . . .=',1PG20.13)
315 1300 FORMAT(
316 & 5X,'maximum plastic strain. . . . . . . . .=',1PG20.13/
317 & 5X,'tensile failure strain 1. . . . . . . .=',1PG20.13/
318 & 5X,'tensile failure strain 2. . . . . . . .=',1PG20.13/
319 & 5X,'young modulus scale factor function . .=',I10/
320 & 5X,'young modulus einf. . . . . . . . . . .=',1PG20.13/
321 & 5X,'parameter ce. . . . . . . . . . . . . .=',1PG20.13)
322 1400 FORMAT(
323 & 5X,'strain rate filtering flag . . . . . .=',I10/
324 & 5X,'strain rate cutting frequency . . . . .=',1PG20.13)
325c
#define my_real
Definition cppsort.cpp:32
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
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_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)
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