OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat71.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_mat71 (uparam, maxuparam, nuparam, nuvar, mfunc, maxfunc, mtag, parmat, unitab, pm, lsubmodel, id, titr, imatvis, matparam)

Function/Subroutine Documentation

◆ hm_read_mat71()

subroutine hm_read_mat71 ( intent(inout) uparam,
integer, intent(in) maxuparam,
integer, intent(inout) nuparam,
integer, intent(inout) nuvar,
integer, intent(inout) mfunc,
integer, intent(in) maxfunc,
type(mlaw_tag_), intent(inout) mtag,
intent(inout) parmat,
type (unit_type_), intent(in) unitab,
intent(inout) pm,
type(submodel_data), dimension(*), intent(in) lsubmodel,
integer, intent(in) id,
character(len=nchartitle), intent(in) titr,
integer, intent(inout) imatvis,
type(matparam_struct_), intent(inout) matparam )

Definition at line 38 of file hm_read_mat71.F.

42C-----------------------------------------------
43C D e s c r i p t i o n
44C-----------------------------------------------
45C
46C DUMMY ARGUMENTS DESCRIPTION:
47C ===================
48C
49C NAME DESCRIPTION
50C
51C IPM MATERIAL ARRAY(INTEGER)
52C PM MATERIAL ARRAY(REAL)
53C UNITAB UNITS ARRAY
54C ID MATERIAL ID(INTEGER)
55C TITR MATERIAL TITLE
56C LSUBMODEL SUBMODEL STRUCTURE
57C
58C-----------------------------------------------
59C M o d u l e s
60C-----------------------------------------------
61 USE unitab_mod
62 USE elbuftag_mod
63 USE message_mod
64 USE submodel_mod
65 USE matparam_def_mod
66 USE hm_option_read_mod
67 USE names_and_titles_mod , ONLY : nchartitle
68C-----------------------------------------------
69C I m p l i c i t T y p e s
70C-----------------------------------------------
71#include "implicit_f.inc"
72C-----------------------------------------------
73C C o m m o n B l o c k s
74C-----------------------------------------------
75#include "units_c.inc"
76#include "param_c.inc"
77C-----------------------------------------------
78C D u m m y A r g u m e n t s
79C-----------------------------------------------
80 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
81 my_real, DIMENSION(NPROPM) ,INTENT(INOUT) :: pm
82 my_real, DIMENSION(100) ,INTENT(INOUT) :: parmat
83 my_real, DIMENSION(MAXUPARAM) ,INTENT(INOUT) :: uparam
84
85 INTEGER, INTENT(INOUT) :: MFUNC,NUPARAM,NUVAR,IMATVIS
86 TYPE(MLAW_TAG_),INTENT(INOUT) :: MTAG
87 INTEGER,INTENT(IN) :: ID,MAXFUNC,MAXUPARAM
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 :: NBMAT ! Number of declared materials
95 INTEGER :: I,J,ILAW ,EFLAG
96 my_real :: rho0, rhor,e,nu,g,c1,epsl,gm,km,
97 . yld_ass,yld_asf, yld_sas,yld_saf,alpha,
98 . lamda,emart,cas,csa,tsas,tfas, tssa,tfsa,cp,tini
99
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.
106C--------------------------------------------------
107C EXTRACT DATA (IS OPTION CRYPTED)
108C--------------------------------------------------
109 CALL hm_option_is_encrypted(is_encrypted)
110C-----------------------------------------------
111 ilaw = 71
112 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
113 CALL hm_get_floatv('Refer_Rho',rhor ,is_available, lsubmodel, unitab)
114C=======================================================================
115C
116C SHAPE MEMORY
117C
118C=======================================================================
119Card1
120 CALL hm_get_floatv('E' ,e ,is_available, lsubmodel, unitab)
121 CALL hm_get_floatv('nu' ,nu ,is_available, lsubmodel, unitab)
122 CALL hm_get_floatv('E_mart' ,emart ,is_available, lsubmodel, unitab)
123Card2
124 CALL hm_get_floatv('Sig_sas' ,yld_ass ,is_available, lsubmodel, unitab)
125 CALL hm_get_floatv('Sig_fas' ,yld_asf ,is_available, lsubmodel, unitab)
126 CALL hm_get_floatv('Sig_ssa' ,yld_sas ,is_available, lsubmodel, unitab)
127 CALL hm_get_floatv('Sig_fsa' ,yld_saf ,is_available, lsubmodel, unitab)
128 CALL hm_get_floatv('Alpha' ,alpha ,is_available, lsubmodel, unitab)
129Card3
130 CALL hm_get_floatv('EpsL' ,epsl ,is_available, lsubmodel, unitab)
131 CALL hm_get_floatv('CAS' ,cas ,is_available, lsubmodel, unitab)
132 CALL hm_get_floatv('CSA' ,csa ,is_available, lsubmodel, unitab)
133 CALL hm_get_floatv('TSAS' ,tsas ,is_available, lsubmodel, unitab)
134 CALL hm_get_floatv('TFAS' ,tfas ,is_available, lsubmodel, unitab)
135Card4
136 CALL hm_get_floatv('TSSA' ,tssa ,is_available, lsubmodel, unitab)
137 CALL hm_get_floatv('TFSA' ,tfsa ,is_available, lsubmodel, unitab)
138 CALL hm_get_floatv('CP' ,cp ,is_available, lsubmodel, unitab)
139 CALL hm_get_floatv('TINI' ,tini ,is_available, lsubmodel, unitab)
140C=======================================================================
141 eflag = 0
142 IF (yld_ass >= yld_asf)
143 . CALL ancmsg(msgid=1122,
144 . msgtype=msgerror,
145 . anmode=aninfo_blind_1,
146 . i1=id,
147 . c1=titr)
148
149 IF (yld_sas <= yld_saf )
150 . CALL ancmsg(msgid=1123,
151 . msgtype=msgerror,
152 . anmode=aninfo_blind_1,
153 . i1=id,
154 . c1=titr)
155
156 IF (alpha > sqrt(two/three) )
157 . CALL ancmsg(msgid=1124,
158 . msgtype=msgerror,
159 . anmode=aninfo_blind_1,
160 . i1=id,
161 . c1=titr)
162
163
164 IF(yld_ass == zero) yld_ass = em20
165 IF(yld_asf == zero) yld_asf = em20
166 IF(yld_sas == zero) yld_sas = em20
167 IF(yld_saf == zero) yld_saf = em20
168
169 IF(tssa == zero) tssa = 298.0
170 IF(tfsa == zero) tfsa = 298.0
171 IF(tsas == zero) tsas = 298.0
172 IF(tfas == zero) tfas = 298.0
173
174
175 IF(cp == zero) cp = ep20
176 IF(tini == zero) tini = 360.0
177 IF(emart /= zero) eflag = 1
178 IF(emart == e) eflag = 0
179 !IF(EPSL == ZERO) EPSL = un
180c HOOK 3D
181 g = half*e/(one + nu)
182 lamda = e*(one-nu)/(one + nu)/(one - two*nu)
183 c1 = e/three/(one - two*nu)
184c
185 gm = g
186 km = c1
187 IF (eflag == 1 ) THEN
188 gm = half*emart/(one + nu)
189 km = emart/three/(one - two*nu)
190 ENDIF
191c-----------------------------------
192c UPARAM
193c-----------------------------------
194 uparam(1)=e
195 uparam(2)=nu
196 uparam(3)= g
197 uparam(4) = c1
198 uparam(5) = lamda
199 uparam(6) = yld_ass
200 uparam(7) = yld_asf
201 uparam(8) = yld_sas
202 uparam(9) = yld_saf
203 uparam(10) = alpha
204 uparam(11) = epsl
205C HOOk 2D
206 uparam(12 ) = e/(one - nu**2)
207 uparam(13) = nu*e/(one - nu**2)
208 uparam(14) = emart
209 uparam(15) = eflag
210 uparam(16) = gm
211 uparam(17) = km
212 uparam(18) = cas
213 uparam(19) = csa
214 uparam(20) = tsas
215 uparam(21) = tfas
216 uparam(22) = tssa
217 uparam(23) = tfsa
218 uparam(24) = cp
219 uparam(25) = tini
220c-----------------------------------
221 imatvis = 1
222c-----------------------------------
223 nuparam = 25
224 nuvar = 10
225 mfunc = 0
226c-----------------------------------
227c PARMAT
228c-----------------------------------
229 parmat(1) = c1
230 parmat(2) = e
231 parmat(3) = nu
232 parmat(16) = 2 !Formulation for solid elements time step computation.
233 parmat(17) = (one - two*nu)/(one - nu) ! ==TWO*G/(C1+sFOUR_OVER_3*G)
234c--------------------------
235 IF (rhor == zero) rhor=rho0
236 pm(1) = rhor
237 pm(89) = rho0
238 pm(27) = sqrt(e/max(rhor,em20))
239c-----------------------------------
240 mtag%L_PLA = 1
241 mtag%L_FRAC = 1 ! austenite phase fraction for output
242 mtag%L_TEMP = 1
243c-----------------------------------
244 mtag%G_MAXEPS = 3
245 mtag%G_MAXFRAC= 1
246c-----------------------------------
247 ! MATPARAM keywords
248 CALL init_mat_keyword(matparam,"HOOK")
249 ! Properties compatibility
250 CALL init_mat_keyword(matparam,"SHELL_ISOTROPIC")
251 CALL init_mat_keyword(matparam,"SOLID_ISOTROPIC")
252 CALL init_mat_keyword(matparam,"BEAM_INTEGRATED")
253c-----------------------------------
254 WRITE(iout,1000) trim(titr),id,71
255 WRITE(iout,1100)
256 IF (is_encrypted) THEN
257 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
258 ELSE
259 WRITE(iout,1001) rho0
260 WRITE(iout,1300)e,nu,yld_ass, yld_asf,yld_sas, yld_saf,alpha,epsl,emart
261 WRITE(iout,1200)cas,csa,tsas,tfas,tssa,tfsa,cp,tini
262 ENDIF
263C
264 RETURN
265 1000 FORMAT(/
266 & 5x,a,/,
267 & 5x,'MATERIAL NUMBER. . . . . . . . . . . . . . . . . =',i10/,
268 & 5x,'MATERIAL LAW . . . . . . . . . . . . . . . . . . =',i10/)
269 1001 FORMAT(
270 & 5x,'INITIAL DENSITY . . . . . . . . . . . . . . . =',1pg20.13/)
271 1100 FORMAT(
272 & 5x,' SUPERELASTIC MATERIAL FOR SHAPE MEMORY ALLOYS LAW71 ',/,
273 & 5x,' --------------------------------------------------- ',//)
274 1300 FORMAT(
275 & 5x,'YOUNG''S MODULUS. . . . . . . . . . . . . . . . .=',1pg20.13/,
276 & 5x,'POISSON''S RATIO. . . . . . . . . . . . . . . . .=',1pg20.13/,
277 & 5x,'STARTING STRESS VALUE FOR TRANSFORMATION (AS) . .=',1pg20.13/,
278 & 5x,'FINAL STRESS VALUE FOR TRANSFORMATION (AS). . . .=',1pg20.13/,
279 & 5x,'STARTING STRESS VALUE FOR TRANSFORMATION (SA) . .=',1pg20.13/,
280 & 5x,'FINAL STRESS VALUE FOR TRANSFORMATION (SA). . . .=',1pg20.13/,
281 & 5x,'PARAMETER ALPHA . . . . . . . . . . . . . . . . .=',1pg20.13/,
282 & 5x,'MAXIMUM RESIDUAL STRAIN. . . . . . . . . . . . . =',1pg20.13/,
283 & 5x,'MARTENSITE YOUNG''S MODULUS . . . . . . . . . . .=',1pg20.13/)
284 1200 FORMAT(
285 & 5x,'MATERIAL PARAMETER C_AS . . . . . . . . . . . . .=',1pg20.13/,
286 & 5x,'MATERIAL PARAMETER C_SA . . . . . . . . . . . . .=',1pg20.13/,
287 & 5x,'INITIAL TEMPERATURE FOR TRANSFORMATION (AS) . . .=',1pg20.13/,
288 & 5x,'FINAL TEMPERATURE FOR TRANSFORMATION (AS) . . .=',1pg20.13/,
289 & 5x,'INITIAL TEMPERATURE FOR TRANSFORMATION (SA) . . .=',1pg20.13/,
290 & 5x,'FINAL TEMPERATURE FOR TRANSFORMATION (SA) . . .=',1pg20.13/,
291 & 5x,'SPECIFIC HEAT CAPACITY. . . . . . . . . . . . . .=',1pg20.13/,
292 & 5x,'INITIAL TEMPERATURE . . . . . . . . . . . . . . .=',1pg20.13/)
293C
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
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
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
elbuftag_mod
Definition elbuftag_mod.F:227
hm_option_read_mod
Definition hm_option_read_mod.F:408
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