OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat80.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| hm_read_mat80 ../starter/source/materials/mat/mat080/hm_read_mat80.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_mat ../starter/source/materials/mat/hm_read_mat.F90
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
30!|| hm_get_floatv_dim ../starter/source/devtools/hm_reader/hm_get_floatv_dim.F
31!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
32!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
33!|| init_mat_keyword ../starter/source/materials/mat/init_mat_keyword.F
34!||--- uses -----------------------------------------------------
35!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
36!|| message_mod ../starter/share/message_module/message_mod.F
37!|| submodel_mod ../starter/share/modules1/submodel_mod.F
38!|| table_mod ../starter/share/modules1/table_mod.F
39!||====================================================================
40 SUBROUTINE hm_read_mat80(
41 . UPARAM ,MAXUPARAM,NUPARAM ,NUVAR ,NFUNC ,
42 . MAXFUNC ,IFUNC ,PARMAT ,MAT_ID ,PM ,
43 . ISRATE_IN ,MTAG ,TITR ,UNITAB ,LSUBMODEL,
44 . ITABLE ,MAXTABL ,NUMTABL ,NVARTMP ,TABLE ,
45 . MATPARAM )
46C-----------------------------------------------
47C D e s c r i p t i o n
48C-----------------------------------------------
49C READ MAT LAW80 WITH HM READER
50C-----------------------------------------------
51C M o d u l e s
52C-----------------------------------------------
53 USE unitab_mod
54 USE message_mod
55 USE submodel_mod
56 USE matparam_def_mod
57 USE elbuftag_mod
58 USE table_mod
59 USE names_and_titles_mod , ONLY : nchartitle
60C-----------------------------------------------
61C I m p l i c i t T y p e s
62C-----------------------------------------------
63#include "implicit_f.inc"
64C-----------------------------------------------
65C C o m m o n B l o c k s
66C-----------------------------------------------
67#include "units_c.inc"
68#include "param_c.inc"
69#include "com04_c.inc"
70C-----------------------------------------------
71C D u m m y A r g u m e n t s
72C-----------------------------------------------
73 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
74 my_real, INTENT(INOUT) :: PARMAT(100), UPARAM(MAXUPARAM), PM(NPROPM)
75 INTEGER, INTENT(INOUT) :: IFUNC(MAXFUNC), NFUNC, MAXFUNC, MAXUPARAM,
76 . NUPARAM, NUVAR,NVARTMP, ISRATE_IN, ITABLE(MAXTABL), NUMTABL
77 INTEGER, INTENT(IN) :: MAT_ID, MAXTABL
78 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
79 TYPE(submodel_data),INTENT(IN) :: LSUBMODEL(*)
80 TYPE(mlaw_tag_), INTENT(INOUT) :: MTAG
81 TYPE(TTABLE) TABLE(NTABLE)
82 TYPE(matparam_struct_) ,INTENT(INOUT) :: MATPARAM
83C-----------------------------------------------
84C L o c a l V a r i a b l e s
85C-----------------------------------------------
86 INTEGER MATS,IFLAG1,IFLAG2,ITEMAX,j,FLAGEPS,ISRATE, I,
87 . heatflag,flag_heat_id,flag_loc,
88 . flag_tr_strain,flag_tr_kinetics,ndim(5)
89
90 my_real
91 . yscale1,yscale2,yscale3,yscale4,yscale5,xscale(5),rscale_unit(5),
92 . xscale2,xscale3,xscale4,xscale5,efac,unitt,rscale(5),
93 . teta2, teta3,teta4, teta5,qr2,qr3,qr4,alpha2, tref,
94 . ae1, ae3,bs,ms,gsize,b, mo,mn,w,al,c,cr,si,cu,as,
95 . co,ni,v,p,ti,e,nu,ceps, peps, bulk,ce,hfp,hb,hm,tini,
96 . alfa1, alfa2,kf,kp,lat1,lat2,ac1,ac3,tau1,tau3,
97 . fcfer,fcper,fcbai,fgrain,kper,kbain,t1,t2,xeq2,ceut,
98 . flagfiltre, alphaeps,xeqtest, rho0, rhor, fcut,
99 . gfac_f,phi_f,psi_f,cr_f,cf,gfac_p,phi_p,psi_p,cr_p,cp,
100 . gfac_b,phi_b,psi_b,cr_b,cb,phi_m,psi_m,n_m,fgfer,fgper,fgbai
101
102 LOGICAL :: IS_ENCRYPTED, IS_AVAILABLE
103C-----------------------------------------------
104C S o u r c e
105C-----------------------------------------------
106 ISRATE_IN = 1
107 flag_loc = 0
108
109 mtag%G_EPSD = 1
110 mtag%L_EPSD = 1
111 mtag%G_PLA = 1
112 mtag%L_PLA = 1
113 mtag%L_TEMP = 1
114
115 is_encrypted = .false.
116 is_available = .false.
117
118 CALL hm_option_is_encrypted(is_encrypted)
119
120 nfunc =7
121 numtabl = 5
122 nvartmp = 15
123
124 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
125 CALL hm_get_floatv('Refer_Rho' ,rhor ,is_available, lsubmodel, unitab)
126 IF (rhor == zero) THEN
127 rhor = rho0
128 ENDIF
129 pm(1) = rhor
130 pm(89) = rho0
131
132 CALL hm_get_floatv('MAT_E' , e , is_available, lsubmodel, unitab)
133 CALL hm_get_floatv('MAT_NU' , nu , is_available, lsubmodel, unitab)
134 CALL hm_get_intv ('MAT_fct_IDE', ifunc(1), is_available, lsubmodel)
135 CALL hm_get_floatv('SCALE' , efac , is_available, lsubmodel, unitab)
136 CALL hm_get_floatv('time_inputunit_value' , unitt, is_available, lsubmodel, unitab)
137
138 IF(unitt == zero) unitt = three*ep03+six*ep02
139
140 CALL hm_get_intv ('Fsmooth' , israte, is_available, lsubmodel)
141 CALL hm_get_floatv('Fcut' , fcut , is_available, lsubmodel, unitab)
142 CALL hm_get_floatv('MAT_CAP_END', ceps , is_available, lsubmodel, unitab)
143 CALL hm_get_floatv('MAT_PC' , peps , is_available, lsubmodel, unitab)
144
145 CALL hm_get_intv('FUN_A1', itable(1), is_available, lsubmodel)
146 CALL hm_get_intv('FUN_A2', itable(2), is_available, lsubmodel)
147 CALL hm_get_intv('FUN_A3', itable(3), is_available, lsubmodel)
148 CALL hm_get_intv('FUN_A4', itable(4), is_available, lsubmodel)
149 CALL hm_get_intv('FUN_A5', itable(5), is_available, lsubmodel)
150
151 CALL hm_get_floatv('FScale11', yscale1, is_available, lsubmodel, unitab)
152 CALL hm_get_floatv('FScale22', yscale2, is_available, lsubmodel, unitab)
153 CALL hm_get_floatv('FScale33', yscale3, is_available, lsubmodel, unitab)
154 CALL hm_get_floatv('FScale12', yscale4, is_available, lsubmodel, unitab)
155 CALL hm_get_floatv('FScale23', yscale5, is_available, lsubmodel, unitab)
156
157 CALL hm_get_floatv('scale1', xscale(1), is_available, lsubmodel, unitab)
158 CALL hm_get_floatv('scale2', xscale(2), is_available, lsubmodel, unitab)
159 CALL hm_get_floatv('scale3', xscale(3), is_available, lsubmodel, unitab)
160 CALL hm_get_floatv('scale4', xscale(4), is_available, lsubmodel, unitab)
161 CALL hm_get_floatv('scale5', xscale(5), is_available, lsubmodel, unitab)
162
163 CALL hm_get_floatv('FScale11_2', teta2, is_available, lsubmodel, unitab)
164 CALL hm_get_floatv('FScale22_2', teta3, is_available, lsubmodel, unitab)
165 CALL hm_get_floatv('FScale33_2', teta4, is_available, lsubmodel, unitab)
166 CALL hm_get_floatv('FScale12_2', teta5, is_available, lsubmodel, unitab)
167
168 CALL hm_get_floatv('ALPHA1' , alfa1 , is_available, lsubmodel, unitab)
169 CALL hm_get_floatv('ALPHA2' , alfa2 , is_available, lsubmodel, unitab)
170 CALL hm_get_intv ('flag_heat' , heatflag , is_available, lsubmodel)
171 CALL hm_get_intv ('FCT_flag_heat', flag_heat_id, is_available, lsubmodel)
172 CALL hm_get_intv ('flag_loc' , flag_loc , is_available, lsubmodel)
173
174 CALL hm_get_floatv('qa_l' , qr2 , is_available, lsubmodel, unitab)
175 CALL hm_get_floatv('qb_l' , qr3 , is_available, lsubmodel, unitab)
176 CALL hm_get_floatv('Q' , qr4 , is_available, lsubmodel, unitab)
177 CALL hm_get_floatv('Alpha_y', alpha2, is_available, lsubmodel, unitab)
178 CALL hm_get_floatv('WPREF' , tref , is_available, lsubmodel, unitab)
179 IF(qr2 == zero)qr2= 11575.
180 IF(qr3 == zero)qr3= 13840.
181 IF(qr4 == zero)qr4= 13588.
182 IF(alpha2 == zero)alpha2= 0.011
183
184 ae1 = zero
185 ae3 = zero
186 bs = zero
187 ms = zero
188 CALL hm_get_floatv('PrMesh_Size' , gsize, is_available, lsubmodel, unitab)
189
190 CALL hm_get_floatv('MAT_K' , kf , is_available, lsubmodel, unitab)
191 CALL hm_get_floatv('MAT_K_UNLOAD', kp , is_available, lsubmodel, unitab)
192 CALL hm_get_floatv('MAT_Lamda' , lat1, is_available, lsubmodel, unitab)
193 CALL hm_get_floatv('MAT_Theta' , lat2, is_available, lsubmodel, unitab)
194 CALL hm_get_floatv('T_Initial' , tini, is_available, lsubmodel, unitab)
195
196 CALL hm_get_floatv('MAT_B' , b , is_available, lsubmodel, unitab)
197 CALL hm_get_floatv('MAT_MUE1' , mo, is_available, lsubmodel, unitab)
198 CALL hm_get_floatv('MAT_MUE2' , mn, is_available, lsubmodel, unitab)
199 CALL hm_get_floatv('MAT_Wmax_pt1', w , is_available, lsubmodel, unitab)
200 CALL hm_get_floatv('MAT_A1' , al, is_available, lsubmodel, unitab)
201
202 CALL hm_get_floatv('MAT_C' , c , is_available, lsubmodel, unitab)
203 CALL hm_get_floatv('MAT_c1_t', cr, is_available, lsubmodel, unitab)
204 CALL hm_get_floatv('MAT_SRE' , si, is_available, lsubmodel, unitab)
205 CALL hm_get_floatv('MAT_c2_t', cu, is_available, lsubmodel, unitab)
206 CALL hm_get_floatv('MAT_A2' , as, is_available, lsubmodel, unitab)
207
208 CALL hm_get_floatv('MAT_c1_c', co, is_available, lsubmodel, unitab)
209 CALL hm_get_floatv('MAT_NUt' , ni, is_available, lsubmodel, unitab)
210 CALL hm_get_floatv('MAT_VOL' , v , is_available, lsubmodel, unitab)
211 CALL hm_get_floatv('MAT_PR' , p , is_available, lsubmodel, unitab)
212 CALL hm_get_floatv('MAT_T0' , ti, is_available, lsubmodel, unitab)
213
214
215 !Parameters for austenization during heating phase
216 CALL hm_get_floatv('TAU1' , tau1, is_available, lsubmodel, unitab)
217 CALL hm_get_floatv('TAU3' , tau3, is_available, lsubmodel, unitab)
218
219 !flag for transformation strain model
220c------------------------------------------------------------------------
221 CALL hm_get_intv ('flag_tr_strain' , flag_tr_strain , is_available, lsubmodel)
222 CALL hm_get_intv ('ID_R_aus' , ifunc(3), is_available, lsubmodel)
223 CALL hm_get_intv ('ID_R_fer' , ifunc(4), is_available, lsubmodel)
224 CALL hm_get_intv ('ID_R_Per' , ifunc(5), is_available, lsubmodel)
225 CALL hm_get_intv ('ID_R_bai' , ifunc(6), is_available, lsubmodel)
226 CALL hm_get_intv ('ID_R_Mar' , ifunc(7), is_available, lsubmodel)
227 CALL hm_get_floatv('FScaleA', rscale(1), is_available, lsubmodel, unitab)
228 CALL hm_get_floatv('FScaleF', rscale(2), is_available, lsubmodel, unitab)
229 CALL hm_get_floatv('FScaleP', rscale(3), is_available, lsubmodel, unitab)
230 CALL hm_get_floatv('FScaleB', rscale(4), is_available, lsubmodel, unitab)
231 CALL hm_get_floatv('FScaleM', rscale(5), is_available, lsubmodel, unitab)
232 IF(rscale(1) == zero) THEN
233 CALL hm_get_floatv_dim('FScaleA' ,rscale_unit(1) ,is_available, lsubmodel, unitab)
234 rscale(1) = rscale_unit(1)
235 ENDIF
236 IF(rscale(2) == zero) THEN
237 CALL hm_get_floatv_dim('FScaleA' ,rscale_unit(2) ,is_available, lsubmodel, unitab)
238 rscale(2) = rscale_unit(2)
239 ENDIF
240 IF(rscale(3) == zero) THEN
241 CALL hm_get_floatv_dim('FScaleA' ,rscale_unit(3) ,is_available, lsubmodel, unitab)
242 rscale(3) = rscale_unit(3)
243 ENDIF
244 IF(rscale(4) == zero) THEN
245 CALL hm_get_floatv_dim('FScaleA' ,rscale_unit(4) ,is_available, lsubmodel, unitab)
246 rscale(4) = rscale_unit(4)
247 ENDIF
248 IF(rscale(5) == zero) THEN
249 CALL hm_get_floatv_dim('FScaleA' ,rscale_unit(5) ,is_available, lsubmodel, unitab)
250 rscale(5) = rscale_unit(5)
251 ENDIF
252c------------------------------------------------------------------------
253 CALL hm_get_intv ('flag_tr_kinetics' , flag_tr_kinetics, is_available, lsubmodel)
254c------------------------------------------------------------------------
255C NEW TRANSFORMATION KINETICS -reference PAUL HIPPCHEN 2015
256c------------------------------------------------------------------------
257 CALL hm_get_floatv('GFAC_F', gfac_f, is_available, lsubmodel, unitab)
258 CALL hm_get_floatv('PHI_F' , phi_f , is_available, lsubmodel, unitab)
259 CALL hm_get_floatv('PSI_F' , psi_f , is_available, lsubmodel, unitab)
260 CALL hm_get_floatv('CR_F' , cr_f , is_available, lsubmodel, unitab)
261 CALL hm_get_floatv('CF' , cf , is_available, lsubmodel, unitab)
262c
263 CALL hm_get_floatv('GFAC_P', gfac_p, is_available, lsubmodel, unitab)
264 CALL hm_get_floatv('PHI_P' , phi_p , is_available, lsubmodel, unitab)
265 CALL hm_get_floatv('PSI_P' , psi_p , is_available, lsubmodel, unitab)
266 CALL hm_get_floatv('CR_P' , cr_p , is_available, lsubmodel, unitab)
267 CALL hm_get_floatv('cp' , CP , IS_AVAILABLE, LSUBMODEL, UNITAB)
268c
269 CALL HM_GET_FLOATV('gfac_b', GFAC_B, IS_AVAILABLE, LSUBMODEL, UNITAB)
270 CALL HM_GET_FLOATV('phi_b' , PHI_B , IS_AVAILABLE, LSUBMODEL, UNITAB)
271 CALL HM_GET_FLOATV('psi_b' , PSI_B , IS_AVAILABLE, LSUBMODEL, UNITAB)
272 CALL HM_GET_FLOATV('cr_b' , CR_B , IS_AVAILABLE, LSUBMODEL, UNITAB)
273 CALL HM_GET_FLOATV('cb' , CB , IS_AVAILABLE, LSUBMODEL, UNITAB)
274c
275 CALL HM_GET_FLOATV('phi_m' , PHI_M , IS_AVAILABLE, LSUBMODEL, UNITAB)
276 CALL HM_GET_FLOATV('psi_m' , PSI_M , IS_AVAILABLE, LSUBMODEL, UNITAB)
277 CALL HM_GET_FLOATV('n_m' , N_M , IS_AVAILABLE, LSUBMODEL, UNITAB)
278c------------------------------------------------------------------------
279c------------------------------------------------------------------------
280 IF (FLAG_HEAT_ID /= 0) IFUNC(2) = FLAG_HEAT_ID
281 IF (ISRATE == 0) ISRATE = 1
282 IF (FLAG_TR_STRAIN == 0) FLAG_TR_STRAIN = 1
283
284 IF( TAU1 < TAU3) THEN
285 CALL ANCMSG(MSGID=1740,
286 . MSGTYPE=MSGERROR,
287 . ANMODE=ANINFO_BLIND_1,
288 . I1=MAT_ID,
289 . C1=TITR)
290 ENDIF
291
292
293
294.OR..OR..OR. IF(ITABLE(1)==ZEROITABLE(2)==ZEROITABLE(3)==ZERO
295.OR. . ITABLE(4)==ZEROITABLE(5)==ZERO)THEN
296 CALL ANCMSG(MSGID=1020,
297 . MSGTYPE=MSGERROR,
298 . ANMODE=ANINFO_BLIND_1,
299 . I1=MAT_ID,
300 . C1=TITR)
301
302 ENDIF
303
304 DO I = 1,NTABLE
305 DO J=1,5
306 IF (TABLE(I)%NOTABLE == ITABLE(J)) THEN
307 NDIM(J) = TABLE(I)%NDIM
308 ENDIF
309 ENDDO
310 ENDDO
311.OR..OR..OR. IF(NDIM(1) == 3 NDIM(2)==3 NDIM(3)==3
312.OR. . NDIM(4)==3 NDIM(5)==3 )THEN
313.OR. IF(CEPS /= ZERO PEPS /= ZERO ) THEN
314 CEPS = ZERO
315 PEPS = ZERO
316 CALL ANCMSG(MSGID=2041,
317 . MSGTYPE=MSGWARNING,
318 . ANMODE=ANINFO_BLIND_1,
319 . I1=MAT_ID,
320 . C1=TITR)
321 ENDIF
322
323 ENDIF
324C
325 NUVAR = 44
326.AND. IF (ISRATE > 0 FCUT == ZERO) FCUT = EP05*UNITAB%FAC_T_WORK ! default : force filtering
327 IF (FLAG_LOC == 0) FLAG_LOC = 2
328 IF (YSCALE1 == ZERO)YSCALE1 = ONE
329 IF (YSCALE2 == ZERO)YSCALE2 = ONE
330 IF (YSCALE3 == ZERO)YSCALE3 = ONE
331 IF (YSCALE4 == ZERO)YSCALE4 = ONE
332 IF (YSCALE5 == ZERO)YSCALE5 = ONE
333 DO I= 1,NUMTABL
334 IF (XSCALE(I) == ZERO)XSCALE(I) = ONE
335 ENDDO
336 BULK=E/THREE/(ONE-TWO*NU)
337 CE=SQRT(BULK/RHO0)
338C
339 UPARAM(1) = E
340 UPARAM(2) = NU
341 UPARAM(3) = IFUNC(1)
342 IF (EFAC==ZERO)EFAC=ONE
343 UPARAM(4) = EFAC
344 UPARAM(10)= YSCALE1
345 UPARAM(11)= YSCALE2
346 UPARAM(12)= YSCALE3
347 UPARAM(13)= YSCALE4
348 UPARAM(14)= YSCALE5
349 UPARAM(15)= CEPS
350 UPARAM(16)= PEPS
351 UPARAM(17)= TETA2
352 UPARAM(18)= TETA3
353 UPARAM(19)= TETA4
354 UPARAM(20)= TETA5
355 UPARAM(21)= QR2
356 UPARAM(22)= QR3
357 UPARAM(23)= QR4
358 UPARAM(24)= ALPHA2 ! =0.011
359 UPARAM(25)= TREF
360 AE3= 912.-203.*sqrt(C)-15.2*NI+44.7*SI+104.*V+31.5*MO+13.1*W-30.*MN-11.*CR-20.*CU+700.*P+400.*AL+120.*AS+400.*TI+273.0
361 AE1= 723.-10.7*MN-16.9*NI+29.*SI+16.9*CR+290.*AS+ 6.4 *W + 273.0
362 BS = 656.-58.*C-35.*MN-75.*SI-15.*NI-34.*CR-41.*MO +273.0
363 MS = 561.-474.*C-33.*MN-17.*NI-17.*CR-21.*MO +273.0
364 UPARAM(26)= AE1
365 UPARAM(27)= AE3
366 UPARAM(28)= BS
367 UPARAM(29)= MS
368 UPARAM(30)= GSIZE
369 UPARAM(31)= ALFA1
370 UPARAM(32)= ALFA2
371
372c---- COMPOSITION FOR FERRITE PEARLITE BAINITE
373 FCFER =1/(59.6*MN+1.45*NI+67.7*CR+244.0*MO+KF*B)
374 FCPER =1/(1.79+5.42*(CR+MO+FOUR*MO*NI)+KP*B)
375 FCBAI =1/((2.34+10.1*C+3.8*CR+19.0*MO)*EM04)
376
377
378 IF(CF == ZERO) CF = FCFER
379 IF(CP == ZERO) CP = FCPER
380 IF(CB == ZERO) CB = FCBAI
381
382 FGRAIN=TWO**((GSIZE-ONE)*HALF)
383 UPARAM(33)= FCFER
384 UPARAM(34)= FCPER
385 UPARAM(35)= FCBAI
386 UPARAM(36)= FGRAIN
387
388 KPER=0.01*C+0.52*MO
389 UPARAM(37)= KPER
390
391 KBAIN= 1.9*C+2.5*MN+0.9*NI+1.7*CR+4*MO-2.6
392 UPARAM(38)= KBAIN
393
394 T1=912.0-15.2*NI+44.7*SI+104.0*V+315.0*MO+13.1*W
395 T2=30.0*MN+11.0*CR+20.0*CU-700.0*P-400.0*AL-120.0*AS-400.0*TI
396 CEUT= (T1-T2-AE1-273.)*(T1-T2-AE1-273.)/203.0/203.0
397 XEQ2= (CEUT-C)/CEUT
398 UPARAM(39)= XEQ2
399
400 UPARAM(40)= LAT1
401 UPARAM(41)= LAT2
402
403 HFP=42.+223.*C+53.*SI+30.*MN+12.*NI+7.*CR+19.*MO+(10.-19.*SI+4.*NI+8.*CR+130.*V)
404 HB =259.4-254.7*C+4834.1*C*C
405 HM =181.1+2031.9*C-1940.1*C*C
406 UPARAM(42)= HFP
407 UPARAM(43)= HB
408 UPARAM(44)= HM
409
410 UPARAM(45)= TINI
411 UPARAM(46)= UNITT
412C
413 NUPARAM= 46
414 UPARAM(46+1) = 0.
415 UPARAM(46+2) = 0.
416 UPARAM(46+3) = 0.125
417 UPARAM(46+4) = 2.530
418 UPARAM(46+5) = 0.250
419 UPARAM(46+6) = 4.000
420 UPARAM(46+7) = 0.500
421 UPARAM(46+8) = 2.760
422 UPARAM(46+9) = 0.750
423 UPARAM(46+10)= 1.330
424 UPARAM(46+11)= 1.000
425 UPARAM(46+12)= 1.000
426
427 NUPARAM= NUPARAM +12 !58
428
429 DO I= 1,NUMTABL
430 UPARAM(58 +I) = ONE/XSCALE(I)
431 ENDDO
432 UPARAM(58 + NUMTABL + 1) = HEATFLAG
433
434 UPARAM(58 + NUMTABL + 2) = TAU1
435 UPARAM(58 + NUMTABL + 3) = TAU3
436 UPARAM(58 + NUMTABL + 4) = FLAG_LOC
437
438 UPARAM(58 + NUMTABL + 5) = FLAG_TR_STRAIN
439 UPARAM(58 + NUMTABL + 6) = FLAG_TR_KINETICS
440
441 !UPARAM(58 + NUMTABL + 6) = IFUNC(1)!FLAG_HEAT_ID
442
443 NUPARAM= NUPARAM + NUMTABL + 6 !2for transformation strain ! 58 + 5 + 6 = 69
444 UPARAM(58 + NUMTABL + 7) = RSCALE(1)
445 UPARAM(58 + NUMTABL + 8) = RSCALE(2)
446 UPARAM(58 + NUMTABL + 9) = RSCALE(3)
447 UPARAM(58 + NUMTABL +10) = RSCALE(4)
448 UPARAM(58 + NUMTABL +11) = RSCALE(5) ! 58 + 11 + 5= 74 !SINCE NUMTABL = 5
449
450 NUPARAM= NUPARAM + 5 !74
451
452
453
454 IF (FLAG_TR_KINETICS ==2 ) THEN
455
456 IF (GFAC_F == ZERO)GFAC_F = 0.32
457 IF (PHI_F == ZERO)PHI_F = 0.4
458 IF (PSI_F == ZERO)PSI_F = 0.4
459
460 IF (GFAC_P == ZERO)GFAC_P = 0.32
461 IF (PHI_P == ZERO)PHI_P = 0.4
462 IF (PSI_P == ZERO)PSI_P = 0.4
463
464 IF (GFAC_B == ZERO)GFAC_B = 0.32
465 IF (PHI_B == ZERO)PHI_B = 0.4
466 IF (PSI_B == ZERO)PSI_B = 0.4
467
468 IF (PHI_M == ZERO)PHI_M = 0.0428
469 IF (PSI_M == ZERO)PSI_M = 0.382
470 IF (N_M == ZERO)N_M = 0.191
471
472 ENDIF
473
474
475 UPARAM(75) = GFAC_F
476 UPARAM(76) = PHI_F
477 UPARAM(77) = PSI_F
478 UPARAM(78) = CR_F
479
480 UPARAM(79) = GFAC_P
481 UPARAM(80) = PHI_P
482 UPARAM(81) = PSI_P
483 UPARAM(82) = CR_P
484
485 UPARAM(83) = GFAC_B
486 UPARAM(84) = PHI_B
487 UPARAM(85) = PSI_B
488 UPARAM(86) = CR_B
489
490 UPARAM(84) = PHI_M
491 UPARAM(85) = PSI_M
492 UPARAM(86) = N_M
493
494
495 FGFER = TWO**(GSIZE*GFAC_F)
496 FGPER = TWO**(GSIZE*GFAC_P)
497 FGBAI = TWO**(GSIZE*GFAC_B)
498
499 UPARAM(87) = FGFER
500 UPARAM(88) = FGPER
501 UPARAM(89) = FGBAI
502
503 UPARAM(90) = CF
504 UPARAM(91) = CP
505 UPARAM(92) = CB
506
507
508 NUPARAM = 92
509c----------------------------
510
511 PARMAT(1) = BULK
512 PARMAT(2) = E
513 PARMAT(3) = NU
514 PARMAT(4) = ISRATE
515 PARMAT(5) = FCUT
516CC Formulation for solid elements time step computation.
517 PARMAT(16) = 2
518 PARMAT(17) = (ONE - TWO*NU)/(ONE - NU) ! == TWO*G/(C1+FOUR_OVER_3*G)
519C------------------------------
520 ! MATPARAM keywords
521 CALL INIT_MAT_KEYWORD(MATPARAM,"HOOK")
522C
523 ! Properties compatibility
524 CALL INIT_MAT_KEYWORD(MATPARAM,"SOLID_ISOTROPIC")
525 CALL INIT_MAT_KEYWORD(MATPARAM,"SHELL_ISOTROPIC")
526C------------------------------
527 WRITE(IOUT, 900) TRIM(TITR),MAT_ID,80
528 WRITE(IOUT,1000)
529 IF(IS_ENCRYPTED)THEN
530 WRITE(IOUT,'(5x,a,//)')'confidential data'
531 ELSE
532 WRITE(IOUT, 950) RHO0
533 WRITE(IOUT,1100)E,NU, IFUNC(1), EFAC,UNITT
534 WRITE(IOUT,1200)ITABLE(1),ITABLE(2),ITABLE(3),
535 . ITABLE(4),ITABLE(5),YSCALE1,YSCALE2,YSCALE3,YSCALE4,
536 . YSCALE5, XSCALE(1),XSCALE(2),XSCALE(3),
537 . XSCALE(4),XSCALE(5),CEPS, PEPS,ISRATE,FCUT
538 WRITE(IOUT,1300)HEATFLAG,FLAG_HEAT_ID,TAU1,TAU3,FLAG_LOC
539 WRITE(IOUT,1400)TETA2, TETA3,TETA4, TETA5
540 WRITE(IOUT,1500)ALFA1, ALFA2
541 WRITE(IOUT,1600)QR2,QR3,QR4,ALPHA2, TREF
542 WRITE(IOUT,1700)AE1, AE3,BS,MS,GSIZE,
543 . KF,KP,LAT1,LAT2,TINI
544 WRITE(IOUT,1900)B, MO,MN,W,AL,C,CR,SI,CU,AS,
545 . CO,NI,V,P,TI
546 WRITE(IOUT,1901)FLAG_TR_STRAIN
547 IF(FLAG_TR_STRAIN == 2 )THEN
548 WRITE(IOUT,2000)IFUNC(3),IFUNC(4),IFUNC(5),
549 . IFUNC(6),IFUNC(7),RSCALE(1),RSCALE(2),RSCALE(3),RSCALE(4),RSCALE(5)
550 ENDIF
551 WRITE(IOUT,1902)FLAG_TR_KINETICS
552 IF(FLAG_TR_KINETICS == 2 )THEN
553 WRITE(IOUT,3000)GFAC_F,PHI_F,PSI_F,CR_F,GFAC_P,PHI_P,PSI_P,CR_P,
554 . GFAC_B,PHI_B,PSI_B,CR_B,PHI_M,PSI_M,N_M,CF,CP,CB
555 ENDIF
556
557 WRITE(IOUT,*)' '
558 ENDIF
559 RETURN
560 900 FORMAT(/
561 & 5X,A,/,
562 & 5X,'material number. . . . . . . . . . . . . . .=',I10/,
563 & 5X,'material law . . . . . . . . . . . . . . . .=',I10/)
564 950 FORMAT(
565 & 5X,'initial density . . . . . . . . . . . . .=',1PG20.13/)
5661000 FORMAT(
567 & 5X,40H HOT STAMPING LAW FOR BORON STEEL ,/,
568 & 5X,40H -------------------------------- ,//)
569 1100 FORMAT(
570 & 5X,'young''s modulus . . . . . . . . . . . .=',1PG20.13/
571 & 5X,'poisson''s ratio . . . . . . . . . . . .=',1PG20.13/
572 & 5X,'young FUNCTION id for t dependence . . .=',I10/
573 & 5X,'young modulus scale factor. . . . . . . =',1PG20.13/
574 & 5X,'time scaling for vivkers hardness . . . =',1PG20.13/)
575 1200 FORMAT(
576 & 5X,'yield table id austenite. . . . . . . . =',I10/
577 & 5X,'yield table id ferrite. . . . . . . . . =',I10/
578 & 5X,'yield table id pearlite . . . . . . . . =',I10/
579 & 5X,'yield table id bainite. . . . . . . . . =',I10/
580 & 5X,'yield table id martensite . . . . . . . =',I10/
581 & 5X,'yield scale factor austenite . . . . . .=',1PG20.13/
582 & 5X,'yield scale factor ferrite . . . . . . .=',1PG20.13/
583 & 5X,'yield scale factor pearlite. . . . . . .=',1PG20.13/
584 & 5X,'yield scale factor bainite . . . . . . .=',1PG20.13/
585 & 5X,'yield scale factor martensite. . . . . .=',1PG20.13/
586 & 5X,'strain rate scale factor austenite . . .=',1PG20.13/
587 & 5X,'strain rate scale factor ferrite . . . .=',1PG20.13/
588 & 5X,'strain rate scale factor pearlite. . . .=',1PG20.13/
589 & 5X,'strain rate scale factor bainite . . . .=',1PG20.13/
590 & 5X,'strain rate scale factor martensite. . .=',1PG20.13/
591 & 5X,'cowper symonds parameter c . . . . . . .=',1PG20.13/
592 & 5X,'cowper symonds parameter p . . . . . . .=',1PG20.13/
593 & 5X,'smooth strain rate option. . . . . . . .=',I10/
594 & 5X,'strain rate cutting frequency. . . . . .=',1PG20.13/)
595
596 1300 FORMAT(
597 & 5X,'flag for heating option . . . . . . . . =',I10/
598 & 5X,'function defining heating flag vs time .=',I10/
599 & 5X,'tau1 . . . . . . . . . . . . . . . . . .=',1PG20.13/
600 & 5X,'tau3 . . . . . . . . . . . . . . . . . .=',1PG20.13/
601 & 5X,'flag defining if phase change is local .=',I10/
602 & 5X,'flag defining deformation strain model .=',I10/)
603
604 1400 FORMAT(
605 & 5X,'memory coefficient ferrite . . . . . . .=',1PG20.13/
606 & 5X,'memory coefficient pearlite. . . . . . .=',1PG20.13/
607 & 5X,'memory coefficient bainite . . . . . . .=',1PG20.13/
608 & 5X,'memory coefficient martensite. . . . . .=',1PG20.13/)
609 1500 FORMAT(
610 & 5X,'thermal expansion coef austenite . . . .=',1PG20.13/
611 & 5X,'thermal expansion coef products. . . . .=',1PG20.13/)
612 1600 FORMAT(
613 & 5X,'q/r for ferrite. . . . . . . . . . . . .=',1PG20.13/
614 & 5X,'q/r for pearlite . . . . . . . . . . . .=',1PG20.13/
615 & 5X,'q/r for bainite. . . . . . . . . . . . .=',1PG20.13/
616 & 5X,'martensite material constant . . . . . .=',1PG20.13/
617 & 5X,'reference temperature. . . . . . . . . .=',1PG20.13/)
618 1700 FORMAT(
619 & 5X,'temperature ae1.(K) . . . . . . . . . .=',1PG20.13/
620 & 5X,'temperature ae3.(K) . . . . . . . . . .=',1PG20.13/
621 & 5X,'temperature bs (K). . . . . . . . . . .=',1PG20.13/
622 & 5X,'temperature ms (K). . . . . . . . . . .=',1PG20.13/
623 & 5X,'grain size . . . . . . . . . . . . . . =',1PG20.13/
624 & 5X,'boron constant in ferrite. . . . . . . =',1PG20.13/
625 & 5X,'boron constant in pearlite . . . . . . =',1PG20.13/
626 & 5X,'latent heat (F, P, B). . . . . . . . . =',1PG20.13/
627 & 5X,'latent heat (M). . . . . . . . . . . . =',1PG20.13/
628 & 5X,'initial temperature.(K). . . . . . . . =',1PG20.13/)
629 1900 FORMAT(
630 & 5X,'boron. . . . . . . . . . . . . . . . . =',1PG20.13/
631 & 5X,'molybdenum . . . . . . . . . . . . . . =',1PG20.13/
632 & 5X,'manganese. . . . . . . . . . . . . . . =',1PG20.13/
633 & 5X,'tungsten . . . . . . . . . . . . . . . =',1PG20.13/
634 & 5X,'aluminium. . . . . . . . . . . . . . . =',1PG20.13/
635 & 5X,'carbon . . . . . . . . . . . . . . . . =',1PG20.13/
636 & 5X,'chromium . . . . . . . . . . . . . . . =',1PG20.13/
637 & 5X,'silicium . . . . . . . . . . . . . . . =',1PG20.13/
638 & 5X,'copper . . . . . . . . . . . . . . . . =',1PG20.13/
639 & 5X,'arsenic. . . . . . . . . . . . . . . . =',1PG20.13/
640 & 5X,'cobalt . . . . . . . . . . . . . . . . =',1PG20.13/
641 & 5X,'nickel . . . . . . . . . . . . . . . . =',1PG20.13/
642 & 5X,'vanadium . . . . . . . . . . . . . . . =',1PG20.13/
643 & 5X,'phosphorous. . . . . . . . . . . . . . =',1PG20.13/
644 & 5X,'titanium . . . . . . . . . . . . . . . =',1PG20.13/)
645
646 1901 FORMAT(
647 & 5X,'flag for transformation strain. . . . .=',I10/)
648 2000 FORMAT(
649 & 5X,'density function id austenite. . . . . . . . =',I10/
650 & 5X,'density function id ferrite. . . . . . . . . =',I10/
651 & 5X,'density function id pearlite . . . . . . . . =',I10/
652 & 5X,'density function id bainite. . . . . . . . . =',I10/
653 & 5X,'density function id martensite . . . . . . . =',I10/
654 & 5X,'density scale factor austenite . . . . . . . =',1PG20.13/
655 & 5X,'density scale factor ferrite . . . . . . . . =',1PG20.13/
656 & 5X,'density scale factor pearlite. . . . . . . . =',1PG20.13/
657 & 5X,'density scale factor bainite . . . . . . . . =',1PG20.13/
658 & 5X,'density scale factor martensite. . . . . . . =',1PG20.13/)
659 1902 FORMAT(
660 & 5X,'flag for transformation kinetics. . . . . . .=',I10/)
661 3000 FORMAT(
662 & 5X,'ferrite grain size factor w_f . . . . . . . . . . =',1PG20.13/
663 & 5X,'ferrite evolution parameter for incubation phi . . =',1PG20.13/
664 & 5X,'ferrite evolution parameter for time control psi . =',1PG20.13/
665 & 5X,'ferrite evolution parameter for retardation cr_f . =',1PG20.13/
666 & 5X,'pearlite grain size factor w_f. . . . . . . . . . =',1PG20.13/
667 & 5X,'pearlite evolution parameter for incubation phi. . =',1PG20.13/
668 & 5X,'pearlite evolution parameter for time control psi. =',1PG20.13/
669 & 5X,'pearlite evolution parameter for retardation cr_f. =',1PG20.13/
670 & 5X,'bainite grain size factor w_f . . . . . . . . . . =',1PG20.13/
671 & 5X,'bainite evolution parameter for incubation phi . . =',1PG20.13/
672 & 5X,'bainite evolution parameter for time control psi . =',1PG20.13/
673 & 5X,'bainite evolution parameter for retardation cr_f . =',1PG20.13/
674 & 5X,'martensite evolution parameter factor phi . . . . =',1PG20.13/
675 & 5X,'martensite evolution exponent ksi. . . . . . . . . =',1PG20.13/
676 & 5X,'martensite evolution exponent n_m. . . . . . . . . =',1PG20.13/
677 & 5X,'ferrite alloy dependent factor cf. . . . . . . . . =',1PG20.13/
678 & 5X,'pearlite alloy dependent factor cp. . . . . . . . =',1PG20.13/
679 & 5X,'bainite alloy dependent factor cb. . . . . . . . =',1PG20.13/)
680 RETURN
681 END
if
if(complex_arithmetic) id
alpha2
#define alpha2
Definition eval.h:48
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_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
hm_read_mat80
subroutine hm_read_mat80(uparam, maxuparam, nuparam, nuvar, nfunc, maxfunc, ifunc, parmat, mat_id, pm, israte_in, mtag, titr, unitab, lsubmodel, itable, maxtabl, numtabl, nvartmp, table, matparam)
Definition hm_read_mat80.F:46
id
initmumps id
Definition multiplerhs_example.m:4
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
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
table_mod
Definition table_mod.F:112
unitab_mod
Definition unitab_mod.F:513
elbuftag_mod::mlaw_tag_
Definition elbuftag_mod.F:232
submodel_mod::submodel_data
Definition submodel_mod.F:723