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

Go to the source code of this file.

Functions/Subroutines

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

Function/Subroutine Documentation

◆ hm_read_mat78()

subroutine hm_read_mat78 ( intent(inout) uparam,
integer, intent(in) 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(in) maxfunc,
integer, intent(inout) nfunc,
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,
intent(inout) pm,
integer, intent(inout) nvartmp,
type(matparam_struct_), intent(inout) matparam )

Definition at line 40 of file hm_read_mat78.F.

44C-----------------------------------------------
45C D e s c r i p t i o n
46C-----------------------------------------------
47C READ YOSHIDA MATERIAL LAW (/MAT/LAW78)
48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE unitab_mod
52 USE elbuftag_mod
53 USE message_mod
54 USE submodel_mod
55 USE matparam_def_mod
56 USE calculp2_mod
57 USE names_and_titles_mod , ONLY : nchartitle
58C-----------------------------------------------
59C I m p l i c i t T y p e s
60C-----------------------------------------------
61#include "implicit_f.inc"
62C-----------------------------------------------
63C C o m m o n B l o c k s
64C-----------------------------------------------
65#include "param_c.inc"
66#include "units_c.inc"
67C-----------------------------------------------
68C D u m m y A r g u m e n t s
69C-----------------------------------------------
70 INTEGER,INTENT(IN) :: MAT_ID,MAXFUNC,MAXUPARAM
71 TYPE (UNIT_TYPE_) ,INTENT(IN) :: UNITAB
72 TYPE(SUBMODEL_DATA) ,DIMENSION(*) ,INTENT(IN) :: LSUBMODEL
73 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
74 INTEGER ,DIMENSION(MAXFUNC) ,INTENT(INOUT) :: IFUNC
75 my_real ,DIMENSION(NPROPM) ,INTENT(INOUT) :: pm
76 my_real ,DIMENSION(100) ,INTENT(INOUT) :: parmat
77 my_real ,DIMENSION(MAXUPARAM) ,INTENT(INOUT) :: uparam
78 INTEGER ,INTENT(INOUT) :: NFUNC,NUVAR,NVARTMP,NUPARAM,ISRATE,IMATVIS
79 TYPE(MLAW_TAG_) ,INTENT(INOUT) :: MTAG
80 TYPE(MATPARAM_STRUCT_) ,INTENT(INOUT) :: MATPARAM
81C-----------------------------------------------
82C L o c a l V a r i a b l e s
83C-----------------------------------------------
84 INTEGER :: I,NORDRE,ISMSTR,NMAXW,OPTE,OPTR,FUNCID,ILAW,Iplas
85 my_real :: young,yield,bsat,myu,byu,hyu,cyu,kyu,rsat,
86 . nu,sum,gs,p,viscmax,fac_l,fac_t,fac_m,fac_c,
87 . rbulk,shear,lamda,einf,coe,yfac,rho0,
88 . r00,r45,r90,cst,cstt,p1,p2,p3,p4,n3,mexp,c1_kh
89 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
90c-----------------------------------------------
91c S o u r c e L i n e s
92C=======================================================================
93 is_encrypted = .false.
94 is_available = .false.
95 israte = 0
96 imatvis = 0
97 ilaw = 78
98C
99 CALL hm_option_is_encrypted(is_encrypted)
100 !line+1
101 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
102 !line-2
103 CALL hm_get_floatv('MAT_E' ,young ,is_available, lsubmodel, unitab)
104 CALL hm_get_floatv('MAT_NU' ,nu ,is_available, lsubmodel, unitab)
105 !line-3
106 CALL hm_get_floatv('MAT_SIGY' ,yield ,is_available, lsubmodel, unitab)
107 CALL hm_get_floatv('MAT_BSAT' ,byu ,is_available, lsubmodel, unitab)
108 CALL hm_get_floatv('MAT_HARD' ,cyu ,is_available, lsubmodel, unitab)
109 CALL hm_get_floatv('MAT_HYST' ,hyu ,is_available, lsubmodel, unitab)
110 CALL hm_get_floatv('MAT_B' ,bsat ,is_available, lsubmodel, unitab)
111 !line-4
112 CALL hm_get_floatv('MAT_M' ,myu ,is_available, lsubmodel, unitab)
113 CALL hm_get_floatv('MAT_RSAT' ,rsat ,is_available, lsubmodel, unitab)
114 CALL hm_get_intv ('MAT_OptR' ,optr ,is_available, lsubmodel)
115 CALL hm_get_floatv('C1' ,cst ,is_available, lsubmodel, unitab)
116 CALL hm_get_floatv('C2' ,cstt ,is_available, lsubmodel, unitab)
117 !line-5
118 CALL hm_get_floatv('MAT_R00' ,r00 ,is_available, lsubmodel, unitab)
119 CALL hm_get_floatv('MAT_R45' ,r45 ,is_available, lsubmodel, unitab)
120 CALL hm_get_floatv('MAT_R90' ,r90 ,is_available, lsubmodel, unitab)
121 CALL hm_get_floatv('MAT_MEXP' ,mexp ,is_available, lsubmodel, unitab)
122 CALL hm_get_intv ('MAT_IPLAS' ,iplas ,is_available, lsubmodel)
123 !line-6
124 CALL hm_get_intv ('MAT_fct_IDE',funcid ,is_available, lsubmodel)
125 CALL hm_get_floatv('MAT_EA' ,einf ,is_available, lsubmodel, unitab)
126 CALL hm_get_floatv('MAT_CE' ,coe ,is_available, lsubmodel, unitab)
127 CALL hm_get_floatv('MAT_C1KH' ,c1_kh ,is_available, lsubmodel, unitab)
128 !========== DEFAULT VALUES=============!
129 pm(1) = rho0
130 pm(89)= rho0
131C
132 opte = 0
133 IF (funcid > 0 ) opte = 1
134 IF (r00 == zero) r00 = one
135 IF (r45 == zero) r45 = one
136 IF (r90 == zero) r90 = one
137 IF (iplas == 0) iplas = 1
138 IF (nu < zero .OR. nu >= half) THEN
139 CALL ancmsg(msgid=49,
140 . msgtype=msgerror,
141 . anmode=aninfo_blind_2,
142 . r1=nu,
143 . i1=mat_id,
144 . c1=titr)
145 ENDIF
146 IF ((hyu < zero).OR.(hyu > one)) THEN
147 CALL ancmsg(msgid=1886,
148 . msgtype=msgerror,
149 . anmode=aninfo_blind_2,
150 . r1=hyu,
151 . i1=mat_id,
152 . c1=titr)
153 ENDIF
154 IF (c1_kh <= cyu) c1_kh = cyu
155 ! Hill 48
156 IF (iplas == 1) THEN
157 mexp = zero
158 p1 = r00*(one+r90)/r90/(one+r00)
159 p2 = r00/(r00+one)
160 p3 = (r00+r90)*(two*r45+one)/r90/(one+r00)
161 p4 = r00/r90/(one+r00)
162 n3 = p1/(one+r90)
163 ! Barlat 89
164 ELSEIF (iplas == 2) THEN
165 ! Wrong value of M exponent
166 IF ((mexp > zero).AND.(mexp < two)) THEN
167 CALL ancmsg(msgid=1735,
168 . msgtype=msgerror,
169 . anmode=aninfo,
170 . i1=mat_id,
171 . c1=titr)
172 ENDIF
173 ! Default value of M exponent
174 IF (mexp == zero) mexp = six
175 p1 = two - two*sqrt((r00/(one+r00))*(r90/(one+r90))) ! A
176 p2 = two - p1 ! C
177 p3 = sqrt((r00/(one+r00))*((one+r90)/r90)) ! H
178 p4 = one ! P
179 CALL calculp2(p1,p2,p3,p4,mexp,r45) ! USE ROUTINE OF HM_READ_MAT57
180 n3 = mexp ! M
181 ELSE
182 p1 = zero
183 p1 = zero
184 p2 = zero
185 p3 = zero
186 p4 = zero
187 n3 = zero
188 ENDIF
189c---------------------------------
190 nvartmp = 0
191 nuvar = 6
192 nfunc = opte
193 nuparam = 22
194c
195 IF (nfunc == 1) THEN
196 ifunc(1) = funcid
197 nvartmp = 1
198 ENDIF
199C
200 IF (bsat < yield) THEN
201 bsat=yield
202 CALL ancmsg(msgid=922,
203 . msgtype=msgwarning,
204 . anmode=aninfo,
205 . i1=mat_id,
206 . c1=titr)
207 ENDIF
208c----------------------
209 uparam(1) = young
210 uparam(2) = nu
211 uparam(3) = yield
212 uparam(4) = byu
213 uparam(5) = cyu
214 uparam(6) = hyu
215 uparam(7) = bsat
216 uparam(8) = myu
217 uparam(9) = rsat
218 uparam(10) = einf
219 uparam(11) = coe
220 uparam(12) = opte
221 uparam(13) = optr
222 uparam(14) = p1
223 uparam(15) = p2
224 uparam(16) = p3
225 uparam(17) = p4
226 uparam(18) = n3
227 uparam(19) = cst
228 uparam(20) = cstt
229 uparam(21) = iplas
230 uparam(22) = c1_kh
231c---------------------
232 parmat(1) = young/three/(one - two*nu)
233 parmat(2) = young
234 parmat(3) = nu
235c Formulation for solid elements time step computation.
236 parmat(16) = 2
237 parmat(17) = (one - two*nu)/(one - nu) ! == TWO*G/(C1+FOUR_OVER_3*G)
238c------------------------------
239 mtag%G_PLA = 1
240 mtag%L_PLA = 1
241 mtag%L_SIGA = 6
242 mtag%L_SIGB = 6
243 mtag%L_SIGC = 6
244 mtag%G_SEQ = 1
245 mtag%L_SEQ = 1
246c------------------------------
247 ! MATPARAM keywords
248 CALL init_mat_keyword(matparam,"ELASTO_PLASTIC")
249 CALL init_mat_keyword(matparam,"INCREMENTAL")
250 CALL init_mat_keyword(matparam,"LARGE_STRAIN")
251!
252 CALL init_mat_keyword(matparam,"HOOK")
253 CALL init_mat_keyword(matparam,"ORTHOTROPIC")
254C
255 ! Properties compatibility
256 CALL init_mat_keyword(matparam,"SOLID_ISOTROPIC")
257 CALL init_mat_keyword(matparam,"SHELL_ORTHOTROPIC")
258c------------------------------
259 IF(is_encrypted)THEN
260 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
261 ELSE
262 WRITE(iout,1000)
263 WRITE(iout,1001) trim(titr),mat_id,ilaw
264 WRITE(iout,1002) rho0
265 WRITE(iout,1100) young,nu,funcid,einf,coe
266 WRITE(iout,1200) yield,byu,cyu,hyu,bsat,c1_kh
267 WRITE(iout,1300) myu,rsat,optr
268 WRITE(iout,1400) iplas,r00,r45,r90,cst,cstt
269 IF (iplas == 2) WRITE(iout,1500) p1,p2,p3,p4,mexp
270 ENDIF
271c----------------------------------------------------------------
272 1000 FORMAT
273 & (5x,' YOSHIDA-UEMORI MATERIAL LAW ',/
274 & 5x,' --------------------------- ',//)
275 1001 FORMAT(
276 & 5x,a,/,
277 & 5x,'MATERIAL NUMBER. . . . . . . . . . . . =',i10/,
278 & 5x,'MATERIAL LAW . . . . . . . . . . . . . =',i10/)
279 1002 FORMAT(
280 & 5x,'INITIAL DENSITY . . . . . . . . . . . . . . . =',1pg20.13/)
281 1100 FORMAT(
282 & 5x,'YOUNG''S MODULUS . . . . . . . . . . . . . . =',1pg20.13/
283 & 5x,'POISSON''S RATIO . . . . . . . . . . . . . . =',1pg20.13/
284 & 5x,'YOUNG MODULUS EVOLUTION FUNCTION . . . . . . =',i10/
285 & 5x,'MATERIAL PARAMETER (EINF ). . . . . . . . . . =',1pg20.13/
286 & 5x,'MATERIAL PARAMETER (COE ). . . . . . . . . . =',1pg20.13)
287 1200 FORMAT(
288 & 5x,'YIELD STRESS (YIELD). . . . . . . . . . . . . =',1pg20.13/
289 & 5x,'MATERIAL PARAMETER (BYU ) . . . . . . . . . . =',1pg20.13/
290 & 5x,'MATERIAL PARAMETER (CYU ). . . . . . . . . . =',1pg20.13/
291 & 5x,'MATERIAL PARAMETER (HYU ). . . . . . . . . . =',1pg20.13/
292 & 5x,'MATERIAL PARAMETER (BSAT ) . . . . . . . . . =',1pg20.13/
293 & 5x,'MATERIAL PARAMETER (C1_KH ) . . . . . . . . =',1pg20.13)
294 1300 FORMAT(//
295 & 5x,'MATERIAL PARAMETER (MYU ). . . . . . . . . . =',1pg20.13/
296 & 5x,'MATERIAL PARAMETER (RSAT ). . . . . . . . . . =',1pg20.13/
297 & 5x,'FLAG ISOTROPIC HARDENING FUNC (OPTR) . . . . =',i10)
298 1400 FORMAT(//
299 & 5x,'PLASTIC CRITERION FLAG . . . . . . . . . . . =',i10/
300 & 5x,' Icrit=1 HILL 1948 CRITERION'/
301 & 5x,' Icrit=2 BARLAT 1989 CRITERION'/
302 & 5x,'LANKFORD COEFFICIENT R00. . . . . . . . . . . =',1pg20.13/
303 & 5x,'LANKFORD COEFFICIENT R45. . . . . . . . . . . =',1pg20.13/
304 & 5x,'LANKFORD COEFFICIENT R90. . . . . . . . . . . =',1pg20.13/
305 & 5x,'MATERIAL PARAMETER (CST). . . . . . . . . . . =',1pg20.13/
306 & 5x,'MATERIAL PARAMETER (CSTT) . . . . . . . . . . =',1pg20.13/)
307 1500 FORMAT(//
308 & 5x,'BARLAT PARAMETER A. . . . . . . . . . . . . . =',1pg20.13/
309 & 5x,'BARLAT PARAMETER C. . . . . . . . . . . . . . =',1pg20.13/
310 & 5x,'BARLAT PARAMETER H. . . . . . . . . . . . . . =',1pg20.13/
311 & 5x,'BARLAT PARAMETER P. . . . . . . . . . . . . . =',1pg20.13/
312 & 5x,'BARLAT EXPONENT M. . . . . . . . . . . . . . =',1pg20.13/)
313c----------------------------------------------------------------
314 RETURN
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
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