46
47
48
49
50
51
52
56 USE matparam_def_mod
60
61
62
63#include "implicit_f.inc"
64
65
66
67#include "units_c.inc"
68#include "param_c.inc"
69#include "com04_c.inc"
70
71
72
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
83
84
85
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
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_AVAILABLE
103
104
105
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
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
220
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
252
253 CALL HM_GET_INTV ('flag_tr_kinetics' , FLAG_TR_KINETICS, IS_AVAILABLE, LSUBMODEL)
254
255
256
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)
262
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)
268
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)
274
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)
278
279
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
324
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)
338
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
372
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
412
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
509
510
511 PARMAT(1) = BULK
512 PARMAT(2) = E
513 PARMAT(3) = NU
514 PARMAT(4) = ISRATE
515 PARMAT(5) = FCUT
516
517 PARMAT(16) = 2
518 PARMAT(17) = (ONE - TWO*NU)/(ONE - NU) ! == TWO*G/(C1+FOUR_OVER_3*G)
519
520 ! MATPARAM keywords
521 CALL INIT_MAT_KEYWORD(MATPARAM,"HOOK")
522
523 ! Properties compatibility
524 CALL INIT_MAT_KEYWORD(MATPARAM,"SOLID_ISOTROPIC")
525 CALL INIT_MAT_KEYWORD(MATPARAM,"SHELL_ISOTROPIC")
526
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
if(complex_arithmetic) id
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_is_encrypted(is_encrypted)
for(i8=*sizetab-1;i8 >=0;i8--)
integer, parameter nchartitle
1.15.0