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

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ hm_read_mat80()

subroutine hm_read_mat80 ( dimension(maxuparam), intent(inout) uparam,
integer, intent(inout) maxuparam,
integer, intent(inout) nuparam,
integer, intent(inout) nuvar,
integer, intent(inout) nfunc,
integer, intent(inout) maxfunc,
integer, dimension(maxfunc), intent(inout) ifunc,
dimension(100), intent(inout) parmat,
integer, intent(in) mat_id,
dimension(npropm), intent(inout) pm,
integer, intent(inout) israte_in,
type(mlaw_tag_), intent(inout) mtag,
character(len=nchartitle), intent(in) titr,
type (unit_type_), intent(in) unitab,
type(submodel_data), dimension(*), intent(in) lsubmodel,
integer, dimension(maxtabl), intent(inout) itable,
integer, intent(in) maxtabl,
integer, intent(inout) numtabl,
integer, intent(inout) nvartmp,
type(ttable), dimension(ntable) table,
type(matparam_struct_), intent(inout) matparam )

Definition at line 40 of file hm_read_mat80.F.

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 j,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 . 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,tau1,tau3,
97 . fcfer,fcper,fcbai,fgrain,kper,kbain,t1,t2,xeq2,ceut,
98 . 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 IF(itable(1)==zero.OR.itable(2)==zero.OR.itable(3)==zero.OR.
295 . itable(4)==zero.OR.itable(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 IF(ndim(1) == 3 .OR.ndim(2)==3 .OR.ndim(3)==3 .OR.
312 . ndim(4)==3 .OR.ndim(5)==3 )THEN
313 IF(ceps /= zero .OR. 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 IF (israte > 0 .AND. 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
my_real
#define my_real
Definition cppsort.cpp:32
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:418
hm_get_floatv_dim
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
Definition hm_get_floatv_dim.F:161
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:288
init_mat_keyword
subroutine init_mat_keyword(matparam, keyword)
Definition init_mat_keyword.F:153
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
elbuftag_mod
Definition elbuftag_mod.F:230
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
submodel_mod
Definition submodel_mod.F:717
table_mod
Definition table_mod.F:113
unitab_mod
Definition unitab_mod.F:517
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:895