OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat02.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_mat02 ../starter/source/materials/mat/mat002/hm_read_mat02.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_get_string ../starter/source/devtools/hm_reader/hm_get_string.F
33!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
34!|| init_mat_keyword ../starter/source/materials/mat/init_mat_keyword.f
35!||--- uses -----------------------------------------------------
36!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
37!|| message_mod ../starter/share/message_module/message_mod.F
38!|| submodel_mod ../starter/share/modules1/submodel_mod.F
39!||====================================================================
40 SUBROUTINE hm_read_mat02(
41 . UPARAM ,MAXUPARAM ,NUPARAM ,NUVAR ,
42 . PARMAT ,IFORM ,
43 . UNITAB ,ID ,TITR ,LSUBMODEL,MTAG ,
44 . PM ,IPM ,ISRATE ,MAT_PARAM)
45C-----------------------------------------------
46C D e s c r i p t i o n
47C-----------------------------------------------
48C ROUTINE DESCRIPTION :
49C ===================
50C READ MAT LAW02 WITH HM READER
51C-----------------------------------------------
52C DUMMY ARGUMENTS DESCRIPTION:
53C ===================
54C UNITAB UNITS ARRAY
55C ID MATERIAL ID(INTEGER)
56C TITR MATERIAL TITLE
57C LSUBMODEL SUBMODEL STRUCTURE
58C
59C IFORM 0 (PLAS_JOHNSON) 1 (PLAS_ZERILLI) 2 (PLAS_PREDEF)
60C
61C-----------------------------------------------
62C M o d u l e s
63C-----------------------------------------------
64 USE unitab_mod
65 USE elbuftag_mod
66 USE message_mod
67 USE submodel_mod
68 USE matparam_def_mod
69 USE names_and_titles_mod , ONLY : nchartitle
70C-----------------------------------------------
71C I m p l i c i t T y p e s
72C-----------------------------------------------
73#include "implicit_f.inc"
74C-----------------------------------------------
75C C o m m o n B l o c k s
76C-----------------------------------------------
77#include "units_c.inc"
78#include "param_c.inc"
79C-----------------------------------------------
80C D u m m y A r g u m e n t s
81C-----------------------------------------------
82 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
83 INTEGER, INTENT(IN) :: ID,MAXUPARAM,IFORM
84 INTEGER, INTENT(INOUT) :: ISRATE
85 INTEGER, INTENT(INOUT) :: NUPARAM,NUVAR
86 INTEGER, INTENT(INOUT) :: IPM(NPROPMI)
87 my_real, INTENT(INOUT) :: pm(npropm)
88 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
89 TYPE(submodel_data), DIMENSION(*),INTENT(IN) :: LSUBMODEL
90 my_real, DIMENSION(MAXUPARAM), INTENT(INOUT) :: uparam
91 my_real, INTENT(INOUT) :: parmat(100)
92 TYPE(mlaw_tag_),INTENT(INOUT) :: MTAG
93 TYPE(matparam_struct_),INTENT(INOUT) :: MAT_PARAM
94C-----------------------------------------------
95C L o c a l V a r i a b l e s
96C-----------------------------------------------
97 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
98 INTEGER :: I,VP
99 my_real :: RHOR,RHO0
100 INTEGER ICC,ISRAT1,IFLAG,MFLAG
101 my_real :: young,anu,ca,cb,cn,epsm,sigm,cc,eps0,g,e0,c0,c1
102 my_real :: e1mn2, en1n2, sdsp,c3,c4
103 my_real :: fcut,fisokin,cb0,rm,ag,cn0
104 my_real :: rhocp,tref,tmelt,tmax,pmin,m_exp
105 my_real :: fac_dens,fac_pres,eps0_unit,fac_m,fac_l,fac_t,asrate
106 CHARACTER PREDEF*16
107C-----------------------------------------------
108C S o u r c e L i n e s
109C-----------------------------------------------
110 is_encrypted = .false.
111 is_available = .false.
112 epsm = zero
113 sigm = zero
114 cc = zero
115 eps0 = zero
116 asrate = zero
117 fisokin = zero
118 young = zero
119 anu = zero
120 ca = zero
121 cb = zero
122 cn = zero
123 rhor = zero
124 sdsp = zero
125!
126 c3 = zero
127 c4 = zero
128 m_exp = zero
129 rhocp = zero
130 pmin = zero
131 tmelt = zero
132 tref = zero
133 tmax = zero
134!
135 iflag = 0
136 mflag = 0
137 icc = 0
138 nuvar = 1
139 nuparam = 0
140 vp = 0
141
142 CALL hm_option_is_encrypted(is_encrypted)
143
144 IF (iform==2) THEN
145 !/MAT/PLAS_PREDEF
146 CALL hm_get_string('Material_Name_Str' ,predef ,16, is_available)
147 IF (predef(1:5) == 'STEEL') THEN
148 mflag = 1
149 ELSEIF (predef(1:3) == 'HSS') THEN
150 mflag = 2
151 ELSEIF (predef(1:4) == 'UHSS') THEN
152 mflag = 3
153 ELSEIF (predef(1:6) == 'AA5182') THEN
154 mflag = 4
155 ELSEIF (predef(1:9) == 'AA6082-T6')THEN
156 mflag = 5
157 ELSEIF (predef(1:7) == 'PA6GF30') THEN
158 mflag = 6
159 ELSEIF (predef(1:5) == 'PPT40') THEN
160 mflag = 7
161 ELSE
162 mflag =999 ! to unplug parameter check with PLAS_JOHNS and PLAS_ZERIL
163 CALL ancmsg(msgid=769,
164 . msgtype=msgerror,
165 . anmode=aninfo,
166 . i1=id,
167 . c1=titr,
168 . c2=predef)
169 GOTO 999
170 ENDIF
171 ELSE IF (iform==1) THEN ! Zerilli-Armstrong
172 !line-1
173 CALL hm_get_floatv('RHO_I' ,rho0 ,is_available, lsubmodel, unitab)
174 CALL hm_get_floatv('RHO_O' ,rhor ,is_available, lsubmodel, unitab)
175 !line-2
176 CALL hm_get_floatv('E' ,young ,is_available, lsubmodel, unitab)
177 CALL hm_get_floatv('Nu' ,anu ,is_available, lsubmodel, unitab)
178 CALL hm_get_intv ('MAT_VP' ,vp ,is_available, lsubmodel)
179 !line-3
180 CALL hm_get_floatv('C0' ,ca ,is_available, lsubmodel, unitab)
181 CALL hm_get_floatv('C5' ,cb ,is_available, lsubmodel, unitab)
182 CALL hm_get_floatv('n' ,cn ,is_available, lsubmodel, unitab)
183 CALL hm_get_floatv('EPS_max' ,epsm ,is_available, lsubmodel, unitab)
184 CALL hm_get_floatv('sig_max' ,sigm ,is_available, lsubmodel, unitab)
185 !line-4
186 CALL hm_get_floatv('C1' ,cc ,is_available, lsubmodel, unitab)
187 CALL hm_get_floatv('EPS_0' ,eps0 ,is_available, lsubmodel, unitab)
188 CALL hm_get_intv ('ICC' ,icc ,is_available, lsubmodel)
189 CALL hm_get_intv ('Fsmooth' ,israte ,is_available, lsubmodel)
190 CALL hm_get_floatv('Fcut' ,asrate ,is_available, lsubmodel, unitab)
191 !line-5
192 CALL hm_get_floatv('C3' ,c3 ,is_available, lsubmodel, unitab)
193 CALL hm_get_floatv('C4' ,c4 ,is_available, lsubmodel, unitab)
194 CALL hm_get_floatv('rhoC_p' ,rhocp ,is_available, lsubmodel, unitab)
195 CALL hm_get_floatv('T_r' ,tref ,is_available, lsubmodel, unitab)
196 !units for default values
197 CALL hm_get_floatv_dim('EPS_0' ,eps0_unit ,is_available, lsubmodel, unitab)
198 CALL hm_get_floatv_dim('E' ,fac_pres ,is_available, lsubmodel, unitab)
199 CALL hm_get_floatv_dim('RHO_I' ,fac_dens ,is_available, lsubmodel, unitab)
200 ELSE IF (iform==0) THEN ! Johnson-Cook
201 !line-1
202 CALL hm_get_floatv('RHO_I' ,rho0 ,is_available, lsubmodel, unitab)
203 CALL hm_get_floatv('RHO_O' ,rhor ,is_available, lsubmodel, unitab)
204 !line-2
205 CALL hm_get_floatv('E' ,young ,is_available, lsubmodel, unitab)
206 CALL hm_get_floatv('Nu' ,anu ,is_available, lsubmodel, unitab)
207 CALL hm_get_intv ('MAT_VP' ,vp ,is_available, lsubmodel)
208 CALL hm_get_intv ('Iflag' ,iflag ,is_available, lsubmodel)
209 CALL hm_get_floatv('Pmin' ,pmin ,is_available, lsubmodel, unitab)
210 !line-3
211 IF (iflag == 1) THEN
212 CALL hm_get_floatv('SIG_Y' ,ca ,is_available, lsubmodel, unitab)
213 CALL hm_get_floatv('UTS' ,cb ,is_available, lsubmodel, unitab)
214 CALL hm_get_floatv('EUTS' ,cn ,is_available, lsubmodel, unitab)
215 CALL hm_get_floatv('EPS_p_max' ,epsm ,is_available, lsubmodel, unitab)
216 CALL hm_get_floatv('SIG_max0' ,sigm ,is_available, lsubmodel, unitab)
217 ELSE
218 CALL hm_get_floatv('a' ,ca ,is_available, lsubmodel, unitab)
219 CALL hm_get_floatv('b' ,cb ,is_available, lsubmodel, unitab)
220 CALL hm_get_floatv('n' ,cn ,is_available, lsubmodel, unitab)
221 CALL hm_get_floatv('EPS_p_max' ,epsm ,is_available, lsubmodel, unitab)
222 CALL hm_get_floatv('SIG_max0' ,sigm ,is_available, lsubmodel, unitab)
223 ENDIF
224 !line-4
225 CALL hm_get_floatv('c' ,cc ,is_available, lsubmodel, unitab)
226 CALL hm_get_floatv('EPS_DOT_0' ,eps0 ,is_available, lsubmodel, unitab)
227 CALL hm_get_intv ('ICC' ,icc ,is_available, lsubmodel)
228 CALL hm_get_intv ('Fsmooth' ,israte ,is_available, lsubmodel)
229 CALL hm_get_floatv('F_cut' ,asrate ,is_available, lsubmodel, unitab)
230 CALL hm_get_floatv('Chard' ,fisokin ,is_available, lsubmodel, unitab)
231 !line-5
232 CALL hm_get_floatv('m' ,m_exp ,is_available, lsubmodel, unitab)
233 CALL hm_get_floatv('T_melt' ,tmelt ,is_available, lsubmodel, unitab)
234 CALL hm_get_floatv('rhoC_p' ,rhocp ,is_available, lsubmodel, unitab)
235 CALL hm_get_floatv('T_r' ,tref ,is_available, lsubmodel, unitab)
236 CALL hm_get_floatv('T_max' ,tmax ,is_available, lsubmodel, unitab)
237 !units for default values
238 CALL hm_get_floatv_dim('EPS_DOT_0' ,eps0_unit ,is_available, lsubmodel, unitab)
239 CALL hm_get_floatv_dim('E' ,fac_pres ,is_available, lsubmodel, unitab)
240 CALL hm_get_floatv_dim('RHO_I' ,fac_dens ,is_available, lsubmodel, unitab)
241 ENDIF
242 IF(vp==0)vp = 2
243
244 IF(mflag == 0) THEN
245 ! Exponent must be set to one if equals to zero in the input
246 ! in any case (Iflag=0 or Iflag=1)
247 IF (cn == zero) cn = one
248 ! If Iflag == 1, parameters B and n must be recomputed
249 IF (iflag == 1) THEN
250 cb0 = cb
251 rm = cb *(one+cn)
252 ag = log(one+cn)
253 cn0 = cn
254 cn = rm*ag / (rm-ca)
255 cb = rm/(cn*ag**(cn-one))
256 IF (cn > one) THEN
257 cn = one
258 cb = (cb0*(one+cn0)-ca)/(log(1+cn0)-cb0*(1+cn0)/young-ca/young)
259 CALL ancmsg(msgid=277,
260 . msgtype=msgwarning,
261 . anmode=aninfo_blind_1,
262 . i1=id,
263 . c1=titr)
264 ENDIF
265 IF (cn < zero .AND. cb < zero) THEN
266 cn = zero
267 cb = zero
268 CALL ancmsg(msgid=278,
269 . msgtype=msgwarning,
270 . anmode=aninfo_blind_1,
271 . i1=id,
272 . c1=titr)
273 ENDIF
274 ENDIF
275 ELSE ! small material database, materials as in /FAIL/BiQUAD
276 IF (mflag >= 1) THEN ! Mild Seel unit = Ton, sec, mm
277 fac_m = unitab%FAC_M_WORK
278 fac_l = unitab%FAC_L_WORK
279 fac_t = unitab%FAC_T_WORK
280 fac_pres = fac_m/ (fac_l*fac_t*fac_t)
281 fac_dens = fac_m/ (fac_l*fac_l*fac_l)
282 SELECT CASE (mflag)
283 CASE(1) ! Mild steel
284c! RHO0 = 7.85d-9 * FAC_DENS
285 rho0 = 7850d0 / fac_dens
286 pm(1) = rho0
287 pm(89)= rho0
288c! YOUNG = 210000.0d0 * FAC_PRES
289 young = 210000000000.0d0 / fac_pres
290 anu = 0.3d0
291 ca = 160000000.0d0 / fac_pres
292 cb = 513330169.33870d0/ fac_pres
293 cn = 0.3257084899598d0
294 CASE(2) ! HSS steel
295 rho0 = 7850d0 / fac_dens
296 pm(1) = rho0
297 pm(89)= rho0
298 young = 210000000000.0d0 / fac_pres
299 anu = 0.3d0
300 ca = 300000000.0d0 / fac_pres
301 cb = 611407465.14830d0/ fac_pres
302 cn = 0.3967613457219d0
303 CASE(3)
304 rho0 = 7850d0 / fac_dens
305 pm(1) = rho0
306 pm(89)= rho0
307 young = 210000000000.0d0 / fac_pres
308 anu = 0.3d0
309 ca = 500000000.0d0 / fac_pres
310 cb = 1306278496.3090d0/ fac_pres
311 cn = 6.4633693574514d-02
312 CASE(4) ! Aluminium AA5182
313 rho0 = 2700d0 / fac_dens
314 pm(1) = rho0
315 pm(89)= rho0
316 young = 70000000000.0d0 / fac_pres
317 anu = 0.33d0
318 ca = 150000000.0d0 / fac_pres
319 cb = 393050051.47810d0/ fac_pres
320 cn = 0.3719059188570d0
321 CASE(5) ! Aluminium AA6082-T6
322 rho0 = 2700d0 / fac_dens
323 pm(1) = rho0
324 pm(89)= rho0
325 young = 70000000000.0d0 / fac_pres
326 anu = 0.33d0
327 ca = 300000000.0d0 / fac_pres
328 cb = 210717297.9723d0 / fac_pres
329 cn = 0.3369645584879d0
330 CASE(6) ! Plastic PA6GF30
331 rho0 = 1300d0 / fac_dens
332 pm(1) = rho0
333 pm(89)= rho0
334 young = 7000000000.0d0 / fac_pres
335 anu = 0.35d0
336 ca = 50000000.0d0 / fac_pres
337 cb = 60557060.655832d0/ fac_pres
338 cn = 3.8843615080968d-02
339 CASE(7) ! GENERIC PP T40
340 rho0 = 1200d0 / fac_dens
341 pm(1) = rho0
342 pm(89)= rho0
343 young = 4000000000d0 / fac_pres
344 anu = 0.3d0
345 ca = 20000000.0d0 / fac_pres
346 cb = 18439331.380790d0/ fac_pres
347 cn = 0.1570297693511d0
348 CASE DEFAULT ! ELSE --> Mild Seel
349 rho0 = 7850d0 / fac_dens
350 pm(1) = rho0
351 pm(89)= rho0
352 young = 210000000000d0 / fac_pres
353 anu = 0.3d0
354 ca = 160000000.0d0 / fac_pres
355 cb = 513330169.33870d0/ fac_pres
356 cn = 0.3257084899598d0
357 END SELECT
358 ENDIF
359 ENDIF
360C-----
361 IF(cc > zero .AND. eps0 > zero .AND. asrate == zero .AND.vp/=1) THEN
362 CALL ancmsg(msgid=1220,
363 . msgtype=msgwarning,
364 . anmode=aninfo_blind_1,
365 . i1=id,
366 . c1=titr)
367 ENDIF
368
369 IF (rhor==zero) rhor=rho0
370C-----
371 IF (anu == half) anu=zep499
372C
373 IF (icc == 0) icc=1
374 IF (pmin == zero) pmin =-ep20
375C
376 IF (epsm == zero) epsm = ep20
377 IF (sigm == zero) sigm = ep20
378 IF (cc == zero) THEN
379 eps0 = one
380 israte = 0
381 ELSE
382 israte = 1
383 END IF
384 IF(anu<=-one) THEN
385 CALL ancmsg(msgid=300,msgtype=msgerror,anmode=aninfo,i1=2,i2=id,c1=titr)
386 ENDIF
387C-----
388 g=young/(two*(one + anu))
389 e0=zero
390 c0=zero
391 c1=young/(three*(one - two*anu))
392 e1mn2=young/(one - anu**2)
393 en1n2=anu*e1mn2
394 sdsp =sqrt(young/max(rhor,em20))
395
396 IF (young<=zero) THEN
397 CALL ancmsg(msgid=276,msgtype=msgerror,anmode=aninfo,i1=2,i2=id,c1=titr)
398 ENDIF
399
400
401 IF (vp == 1) THEN
402 ! If plastic strain is chosen, filtering by default
403 israte = 1
404 asrate = 10000.0d0*unitab%FAC_T_WORK
405 fcut = asrate
406 ELSE
407 IF (cc == zero)THEN
408 eps0 = one
409 israte = 0
410 asrate = zero
411 fcut = asrate
412 ELSE
413 IF (asrate /= zero ) THEN
414 ! If a filtering frequency is given by the user
415 israte = 1
416 fcut = asrate
417 asrate = asrate*two*pi
418 ELSE
419 ! If no filtering frequency is given but the flag is activated
420 israte = 1
421 asrate = ep20
422 fcut = asrate
423 ENDIF
424 ENDIF
425 ENDIF
426
427C-----
428 pm(1) =rhor
429 pm(89)=rho0
430 pm(20)=young
431 pm(21)=anu
432 pm(22)=g
433 pm(23)=e0
434 pm(24)=e1mn2
435 pm(25)=en1n2
436 pm(26)=five*one_over_6
437 pm(27)=sdsp
438 pm(28)=one/young
439 pm(29)=-anu*pm(28)
440 pm(30)=one/g
441 pm(31)=c0
442 pm(32)=c1
443 pm(38)=ca
444 pm(39)=cb
445 pm(40)=cn
446 pm(41)=epsm
447 pm(42)=sigm
448 pm(43)=cc
449 pm(44)=eps0
450 pm(49)=icc
451 pm(9) = asrate
452
453 ipm(255) = vp
454
455 pm(37)= pmin ! default pressure cut-off for EOS
456 pm(47)= tmax ! like in law4
457C
458 IF (tref <= zero) tref = three100
459c
460C--------------------------------
461
462 IF(iform==0)THEN
463 WRITE(iout,1010) trim(titr),id
464 ELSEIF(iform==1)THEN
465 WRITE(iout,1011) trim(titr),id
466 ELSEIF(iform == 2) THEN
467 WRITE(iout,1012)trim(titr),id
468 ENDIF
469 WRITE(iout,1000)
470 IF(.NOT.is_encrypted)WRITE(iout,1100)rho0
471 IF(mflag /= 0 .AND. .NOT.is_encrypted) THEN
472 IF(mflag == 1) THEN
473 WRITE (iout,1407) 'GENERIC MILD STEEL',rho0,young,anu,g,
474 . 160000000.0d0/fac_pres,380000000.0d0/fac_pres,0.24d0
475 ENDIF
476 IF(mflag == 2) THEN
477 WRITE (iout,1407) 'GENERIC HSS STEEL',rho0,young,anu,g,
478 . 300000000.0d0/fac_pres,510000000.0d0/fac_pres,0.23d0
479 ENDIF
480 IF(mflag == 3) THEN
481 WRITE (iout,1407) 'GENERIC UHSS STEEL',rho0,young,anu,g,
482 . 500000000.0d0/fac_pres,1500000000.0d0/fac_pres,0.045d0
483 ENDIF
484 IF(mflag == 4) THEN
485 WRITE (iout,1407) 'GENERIC ALUMINIUM: AA5182',rho0,young,anu,g,
486 . 150000000.0d0/fac_pres,300000000.0d0/fac_pres,0.25d0
487 ENDIF
488 IF(mflag == 5) THEN
489 WRITE (iout,1407) 'GENERIC ALUMINIUM: AA6082-T6',rho0,young,anu,g,
490 . 300000000.0d0/fac_pres,360000000.0d0/fac_pres,0.08d0
491 ENDIF
492 IF(mflag == 6) THEN
493 WRITE (iout,1407) 'GENERIC PA6GF30',rho0,young,anu,g,
494 . 50000000.0d0/fac_pres,100000000.0d0/fac_pres,0.02d0
495 ENDIF
496 IF(mflag == 7) THEN
497 WRITE (iout,1407) 'GENERIC PP T40',rho0,young,anu,g,
498 . 20000000.0d0/fac_pres,30000000.0d0/fac_pres,0.06d0
499 ENDIF
500 IF(mflag > 7) THEN
501 WRITE (iout,1407) 'GENERIC MILD STEEL',rho0,young,anu,g,
502 . 160000000.0d0/fac_pres,380000000.0d0/fac_pres,0.24d0
503 ENDIF
504 ENDIF
505
506 IF(iform /= 2)THEN
507 IF(.NOT.is_encrypted)THEN
508 WRITE(iout,1300)young,anu,g
509 ELSE
510 WRITE(iout,1700)
511 ENDIF
512 ENDIF
513!
514 IF (iform == 0 .OR. iform == 2)THEN ! johnson-Cook
515 IF(iflag == 0 .AND. iform /= 2)THEN
516 IF(.NOT.is_encrypted)WRITE(iout,1400)ca,cb,cn,epsm,sigm,fisokin
517 ELSE
518 IF(.NOT.is_encrypted .AND. mflag == 0 .AND. iform /= 2)THEN
519 WRITE(iout,1405)ca,cb0,cn0,ca,cb,cn,epsm,sigm,fisokin
520 ENDIF
521 IF(.NOT.is_encrypted .AND. mflag /= 0 .AND. iform /= 2)THEN
522 WRITE(iout,1400)ca,cb,cn,epsm,sigm,fisokin
523 ENDIF
524 ENDIF
525!
526 !
527 IF (m_exp == zero) m_exp=one
528 IF (tmelt == zero) tmelt=ep20
529 IF (tmax == zero) tmax =ep20
530 IF(.NOT.is_encrypted .AND. iform /= 2)THEN
531 israt1 = 1
532 WRITE(iout,1600)vp,cc,eps0,icc,israt1,fcut,m_exp,tmelt,rhocp,tref,tmax,pmin
533 ENDIF
534 pm(50) = zero ! flag JC
535 pm(51) = m_exp
536 pm(80) = tmelt
537 ELSE ! Zerilli
538 IF(.NOT.is_encrypted .AND. iform /= 2)THEN
539 WRITE(iout,1410)ca,cb,cn,epsm,sigm,fisokin
540 israt1 = 1
541 WRITE(iout,1610)vp,icc,israt1,fcut,eps0,cc,c3,c4,rhocp,tref
542 ENDIF
543 pm(50)=one ! flag Zerilli
544 pm(51)=c3
545 pm(52)=c4
546 ENDIF
547!
548 IF (rhocp <= zero) THEN
549 pm(53) = zero
550 ELSE
551 pm(53) = one/rhocp
552 ENDIF
553 pm(54) = tref ! for Zerilli
554!
555 ! same stockage of initial, melting temp and rho_cp as in /heat/mat
556 pm(79) = tref ! for J-C
557 pm(80) = tmelt
558 pm(69) = rhocp
559C -----------------
560 pm(55)=fisokin
561C
562 IF (fisokin>one.OR.fisokin<zero) THEN
563 CALL ancmsg(msgid=912,
564 . msgtype=msgerror,
565 . anmode=aninfo_blind_1,
566 . i1=id,c1='2',
567 . c2=titr)
568 END IF
569C
570 IF(ca<=zero) THEN
571 CALL ancmsg(msgid=301,
572 . msgtype=msgerror,
573 . anmode=aninfo,
574 . i1=2,
575 . i2=id,
576 . c1=titr)
577 ENDIF
578 IF(cn>1.) THEN
579 CALL ancmsg(msgid=213,
580 . msgtype=msgerror,
581 . anmode=aninfo,
582 . i1=2,
583 . i2=id,
584 . c1=titr)
585 ENDIF
586 IF(eps0 == zero) THEN
587 CALL ancmsg(msgid=298,
588 . msgtype=msgerror,
589 . anmode=aninfo,
590 . i1=2,
591 . i2=id,
592 . c1=titr)
593 ENDIF
594C-----------
595C Formulation for solid elements time step computation.
596 ipm(252)= 2
597 pm(105) = two*g/(c1+four_over_3*g)
598!
599C---- Definition des variables internes (stockage elementaire)
600c
601 mtag%G_EPSD = 1
602 mtag%G_PLA = 1
603 mtag%G_DMG = 1
604 mtag%G_TEMP = 1
605c
606 mtag%L_EPSD = 1
607 mtag%L_EPSQ = 1
608 mtag%L_PLA = 1
609 mtag%L_SIGB = 6
610 mtag%L_DMG = 1
611 mtag%L_TEMP = 1
612!
613 ! activate heat source calculation in material
614 mat_param%HEAT_FLAG = 1
615c-------------------------
616 CALL init_mat_keyword(mat_param,"ELASTO_PLASTIC")
617 CALL init_mat_keyword(mat_param,"INCREMENTAL")
618 CALL init_mat_keyword(mat_param,"LARGE_STRAIN")
619 ! Properties compatibility
620 CALL init_mat_keyword(mat_param,"SOLID_ISOTROPIC")
621 CALL init_mat_keyword(mat_param,"SHELL_ISOTROPIC")
622 CALL init_mat_keyword(mat_param,"BEAM_ALL")
623 CALL init_mat_keyword(mat_param,"TRUSS")
624 CALL init_mat_keyword(mat_param,"SPH")
625c
626 ! Material compatibility with /EOS option
627 CALL init_mat_keyword(mat_param,"EOS")
628C-----------
629 RETURN
630C-----------
631 999 CALL freerr(3)
632 RETURN
633C-----------
634 1010 FORMAT(//
635 & 5x,a,/,
636 & 5x,40hmaterial number . . . . . . . . . . . .=,i10/,
637 & 5x,'MATERIAL LAW. . . . . . . . . . . . . .= PLAS_JOHNS',/)
638 1011 FORMAT(//
639 & 5x,a,/,
640 & 5x,40hmaterial number . . . . . . . . . . . .=,i10/,
641 & 5x,'MATERIAL LAW. . . . . . . . . . . . . .= PLAS_ZERIL',/)
642 1012 FORMAT(//
643 & 5x,a,/,
644 & 5x,40hmaterial number . . . . . . . . . . . .=,i10/,
645 & 5x,'MATERIAL LAW. . . . . . . . . . . . . .= PLAS_PREDEF',/)
646 1000 FORMAT(
647 & 5x,' ELASTIC PLASTIC LAW ',/,
648 & 5x,' ------------------- ',//)
649 1100 FORMAT(
650 & 5x,'INITIAL DENSITY . . . . . . . . . . . .=',1pg20.13/)
651 1300 FORMAT(
652 & 5x,'YOUNG''S MODULUS . . . . . . . . . . . .=',1pg20.13/,
653 & 5x,'POISSON''S RATIO . . . . . . . . . . . .=',1pg20.13/,
654 & 5x,'SHEAR MODULUS . . . . . . . . . . . . .=',1pg20.13//)
655 1400 FORMAT(
656 & 5x,'JOHNSON COOK MODEL :',/,
657 & 5x,'YIELD COEFFICIENT A . . . . . . . . . .=',1pg20.13/,
658 & 5x,'YIELD COEFFICIENT B . . . . . . . . . .=',1pg20.13/,
659 & 5x,'YIELD COEFFICIENT N . . . . . . . . . .=',1pg20.13/,
660 & 5x,'EPS-MAX . . . . . . . . . . . . . . . .=',1pg20.13/,
661 & 5x,'SIG-MAX . . . . . . . . . . . . . . . .=',1pg20.13/,
662 & 5x,'ISO-KINEMATIC HARDENING FACTOR. . . . .=',1pg20.13//)
663 1405 FORMAT(
664 & 5x,'JOHNSON COOK MODEL :',/,
665 & 5x,'yield stress . . . . . . . . . . . . .=',1PG20.13/,
666 & 5X,'ultimate stress(uts) . . . . . . . . .=',1PG20.13/,
667 & 5X,'strain at uts(ag). . . . . . . . . . .=',1pg20.13/,
668 & 5x,'YIELD COEFFICIENT A . . . . . . . . . .=',1pg20.13/,
669 & 5x,'YIELD COEFFICIENT B . . . . . . . . . .=',1pg20.13/,
670 & 5x,'YIELD COEFFICIENT N . . . . . . . . . .=',1pg20.13/,
671 & 5x,'EPS-MAX . . . . . . . . . . . . . . . .=',1pg20.13/,
672 & 5x,'SIG-MAX . . . . . . . . . . . . . . . .=',1pg20.13/,
673 & 5x,'ISO-KINEMATIC HARDENING FACTOR. . . . .=',1pg20.13//)
674 1407 FORMAT(
675 & 5x,'PREDEFINED VALUES USED FOR. . . . . . .: ',a/,
676 & 5x,'DENSITY . . . . . . . . . . . . . . . .=',1pg20.13/,
677 & 5x,'YOUNG''S MODULUS . . . . . . . . . . . .=',1pg20.13/,
678 & 5x,'POISSON''S RATIO . . . . . . . . . . . .=',1pg20.13/,
679 & 5x,'SHEAR MODULUS . . . . . . . . . . . . .=',1pg20.13/,
680 & 5x,'YIELD STRESS. . . . . . . . . . . . . .=',1pg20.13/,
681 & 5x,'ULTIMATE STRESS (UTS) . . . . . . . . .=',1pg20.13/,
682 & 5x,'STRAIN AT UTS (Ag). . . . . . . . . . .=',1pg20.13//)
683 1410 FORMAT(
684 & 5x,'ZERILLI ARMSTRONG MODEL :',/,
685 & 5x,'YIELD COEFFICIENT C0. . . . . . . . . .=',1pg20.13/,
686 & 5x,'YIELD COEFFICIENT C5. . . . . . . . . .=',1pg20.13/,
687 & 5x,'YIELD COEFFICIENT N . . . . . . . . . .=',1pg20.13/,
688 & 5x,'EPS-MAX . . . . . . . . . . . . . . . .=',1pg20.13/,
689 & 5x,'SIG-MAX . . . . . . . . . . . . . . . .=',1pg20.13/,
690 & 5x,'ISO-KINEMATIC HARDENING FACTOR. . . . .=',1pg20.13//)
691 1600 FORMAT(
692 & 5x,'FLAG FOR STRAIN RATE DEPENDENCY TYPE. .=',i10/,
693 & 5x,' VP=1 EQUIVALENT PLASTIC STRAIN RATE'/
694 & 5x,' VP=2 TOTAL STRAIN RATE (DEFAULT)'/
695 & 5x,' VP=3 DEVIATORIC STRAIN RATE'/
696 & 5x,'STRAIN RATE COEFFICIENT CC. . . . . . .=',1pg20.13/,
697 & 5x,'REFERENCE STRAIN RATE . . . . . . . . .=',1pg20.13/,
698 & 5x,'FLAG FOR STRAIN RATE ON SIG-MAX . . . .=',i10/,
699 & 5x,'SMOOTH STRAIN RATE OPTION . . . . . . .=',i10/,
700 & 5x,'STRAIN RATE CUTTING FREQUENCY . . . . .=',1pg20.13/,
701 & 5x,'TEMPERATURE EXPONENT. . . . . . . . . .=',1pg20.13/,
702 & 5x,'MELTING TEMPERATURE K . . . . . . . . .=',1pg20.13/,
703 & 5x,'SPECIFIC HEAT Rho*Cp. . . . . . . . . .=',1pg20.13/,
704 & 5x,'INITIAL TEMPERATURE K . . . . . . . . .=',1pg20.13/,
705 & 5x,'MAXIMAL TEMPERATURE K . . . . . . . . .=',1pg20.13/,
706 & 5x,'PRESSURE CUTOFF IN TENSION. . . . . . .=',1pg20.13//)
707 1610 FORMAT(
708 & 5x,'FLAG FOR STRAIN RATE DEPENDENCY TYPE. .=',i10/,
709 & 5x,' VP=1 EQUIVALENT PLASTIC STRAIN RATE'/
710 & 5x,' VP=2 TOTAL STRAIN RATE (DEFAULT)'/
711 & 5x,' VP=3 DEVIATORIC STRAIN RATE'/
712 & 5x,'FLAG FOR STRAIN RATE ON SIG-MAX . . . .=',i10/,
713 & 5x,'SMOOTH STRAIN RATE OPTION . . . . . . .=',i10/,
714 & 5x,'STRAIN RATE CUTTING FREQUENCY . . . . .=',1pg20.13/,
715 & 5x,'REFERENCE STRAIN RATE . . . . . . . . .=',1pg20.13/,
716 & 5x,'STRAIN RATE COEFFICIENT C1. . . . . . .=',1pg20.13/,
717 & 5x,'STRAIN RATE COEFFICIENT C3. . . . . . .=',1pg20.13/,
718 & 5x,'STRAIN RATE COEFFICIENT C4. . . . . . .=',1pg20.13/,
719 & 5x,'SPECIFIC HEAT Rho*Cp. . . . . . . . . .=',1pg20.13/,
720 & 5x,'INITIAL TEMPERATURE K . . . . . . . . .=',1pg20.13//)
721 1700 FORMAT(5x,'CONFIDENTIAL DATA'//)
722C-----------
723 END
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_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_get_string
subroutine hm_get_string(name, sval, size, is_available)
Definition hm_get_string.F:76
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:284
hm_read_mat02
subroutine hm_read_mat02(uparam, maxuparam, nuparam, nuvar, parmat, iform, unitab, id, titr, lsubmodel, mtag, pm, ipm, israte, mat_param)
Definition hm_read_mat02.F:45
init_mat_keyword
subroutine init_mat_keyword(matparam, keyword)
Definition init_mat_keyword.F:150
max
#define max(a, b)
Definition macros.h:21
elbuftag_mod
Definition elbuftag_mod.F:227
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
freerr
subroutine freerr(it)
Definition freform.F:506
starter
program starter
Definition starter.F:39
elbuftag_mod::mlaw_tag_
Definition elbuftag_mod.F:232
submodel_mod::submodel_data
Definition submodel_mod.F:723