42 . MAXFUNC ,NFUNC ,PARMAT ,UNITAB ,ID ,
43 . MTAG ,TITR ,LSUBMODEL,PM ,ISRATE ,
44 . MATPARAM ,MAXTABL ,NUMTABL ,ITABLE ,NVARTMP )
75#include "implicit_f.inc"
85 INTEGER,
INTENT(IN) :: ID,MAXFUNC,MAXTABL,MAXUPARAM
86 INTEGER,
INTENT(INOUT) :: NFUNC
87 INTEGER,
INTENT(INOUT) :: NUMTABL
88 INTEGER,
INTENT(INOUT) :: NUPARAM
89 INTEGER,
INTENT(INOUT) :: NUVAR
90 INTEGER,
INTENT(INOUT) :: NVARTMP
91 INTEGER,
INTENT(INOUT) :: ISRATE
92 my_real,
DIMENSION(NPROPM) ,
INTENT(INOUT) :: pm
93 my_real,
DIMENSION(100) ,
INTENT(INOUT) :: parmat
94 my_real,
DIMENSION(MAXUPARAM) ,
INTENT(INOUT) :: uparam
95 INTEGER,
DIMENSION(MAXFUNC) ,
INTENT(INOUT) :: IFUNC
96 INTEGER,
DIMENSION(MAXTABL) ,
INTENT(INOUT) :: ITABLE
97 CHARACTER(LEN=NCHARTITLE) ,
INTENT(IN) :: TITR
98 TYPE (),
INTENT(IN) ::UNITAB
99 TYPE (SUBMODEL_DATA),
INTENT(IN) :: LSUBMODEL(*)
100 TYPE (MLAW_TAG_) ,
INTENT(INOUT) :: MTAG
101 TYPE (MATPARAM_STRUCT_) ,
INTENT(INOUT) :: MATPARAM
102 TYPE (TTABLE) TABLE(NTABLE)
106 INTEGER :: IFORM,ICONV,IQUAD,ICAS,ISRAT,ILAW
107 my_real :: E,NU,G,RHO0,RHOR,FCUT,NUP,C1,A1,A2,EPSR,EPSF,
109 my_real :: tfac(3),yfac(2),fac_unit(5)
110 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED,FOUND
114 is_encrypted = .false.
115 is_available = .false.
123 CALL hm_get_floatv(
'MAT_RHO' ,rho0 ,is_available,lsubmodel, unitab)
124 CALL hm_get_floatv(
'Refer_Rho',rhor ,is_available,lsubmodel, unitab)
126 CALL hm_get_floatv(
'MAT_E' ,e ,is_available,lsubmodel, unitab)
129 CALL hm_get_intv (
'FUN_D1' ,itable(1) ,is_available,lsubmodel)
130 CALL hm_get_intv (
'FUN_D2' ,itable(2) ,is_available,lsubmodel)
133 CALL hm_get_floatv(
'FScale11' ,tfac(1) ,is_available, lsubmodel, unitab)
134 CALL hm_get_floatv(
'FScale22' ,tfac(2) ,is_available, lsubmodel, unitab)
135 CALL hm_get_floatv(
'FScale33' ,tfac(3) ,is_available, lsubmodel, unitab)
136 CALL hm_get_floatv(
'FACX' ,xfac ,is_available, lsubmodel, unitab)
138 CALL hm_get_floatv(
'MAT_NUt' ,nup ,is_available, lsubmodel, unitab)
139 CALL hm_get_intv (
'FUN_B5' ,ifunc(1) ,is_available,lsubmodel)
140 CALL hm_get_floatv(
'MAT_PScale' ,yfac(1) ,is_available, lsubmodel, unitab)
141 CALL hm_get_intv (
'ISRATE' ,israt ,is_available,lsubmodel)
144 CALL hm_get_floatv(
'MAT_Epsilon_F' ,epsf ,is_available, lsubmodel, unitab)
145 CALL hm_get_floatv(
'Epsilon_0' ,epsr ,is_available, lsubmodel, unitab)
147 CALL hm_get_intv (
'FUN_A1' ,ifunc(2) ,is_available,lsubmodel)
148 CALL hm_get_floatv(
'SCALE' ,yfac(2) ,is_available, lsubmodel, unitab)
150 CALL hm_get_intv (
'IFORM' ,iform ,is_available,lsubmodel)
151 CALL hm_get_intv (
'MAT_Iflag' ,iquad ,is_available,lsubmodel)
152 CALL hm_get_intv (
'Gflag' ,iconv ,is_available,lsubmodel)
158 CALL hm_get_floatv_dim(
'MAT_PScale' ,fac_unit(4) ,is_available, lsubmodel, unitab)
164 IF (fcut == zero)
THEN
165 fcut = 500.0d0*unitab%FAC_T_WORK
170 IF (itable(1) > 0 .AND. itable(2) > 0 .AND. itable(3) > 0)
THEN
176 IF (itable(1) == 0)
THEN
177 CALL ancmsg(msgid=126, msgtype=msgerror, anmode=aninfo,
183 IF (epsf == zero) epsf = infinity
184 IF (epsr == zero) epsr = two*epsf
185 IF (iform == 1 .AND. iquad == 0) iquad = 1
194 icas =
min(itable(2),1) +
min(itable(3),1)
195 IF (icas == 2) icas = -1
196 IF (itable(2) > 0 .AND. icas == 1) icas = 1
197 IF (itable(3) > 0 .AND. icas == 1) icas = 2
198 nup =
max(zero,
min(nup, half))
199 IF(icas==0 .AND. nup == zero .AND. ifunc(1)==0)nup = half
201 IF (xfac == zero) xfac = xfac_unit
202 IF (tfac(1) == zero) tfac(1) = fac_unit(1)
203 IF (tfac(2) == zero) tfac(2) = fac_unit(2)
204 IF (tfac(3) == zero) tfac(3) = fac_unit(3)
205 IF (yfac(1) == zero) yfac(1) = fac_unit(4)
206 IF (yfac(2) == zero) yfac(2) = fac_unit(5)
208 g = half*e/( one + nu)
209 a1 = e*(one-nu) /((one + nu)*(one - two*nu))
210 a2 = a1*nu/(one - nu)
211 c1 = e/three/(one - two*nu)
214 uparam(2) = e/(one - nu*nu)
215 uparam(3) = nu*uparam(2)
228 uparam(16) = fcut*pi*two
230 uparam(18) = one / xfac
256 parmat(17) = (one - two*nu)/(one - nu)
258 IF (rhor == zero) rhor=rho0
284 WRITE(iout,1010) trim(titr),id,76
286 IF (is_encrypted)
THEN
287 WRITE(iout,
'(5X,A,//)')
'CONFIDENTIAL DATA'
289 WRITE(iout,1020) rho0
290 WRITE(iout,1100) e,nu
291 WRITE(iout,1200) itable(1),tfac(1)
292 WRITE(iout,1210) itable(2),tfac(2)
293 WRITE(iout,1220) itable(3),tfac(3),xfac
294 WRITE(iout,1300) nup,ifunc(1),yfac(1),israte,fcut
295 WRITE(iout,1400) epsf,epsr,ifunc(2),yfac(2)
296 WRITE(iout,1500) iform,iquad,iconv
302 & 5x,' semi analytical plastic law 76
',/,
303 & 5X,' ------------------------------
' ,//)
306 & 5X,'material number. . . . . . . . . . . . . . . =
',I10/,
307 & 5X,'material law . . . . . . . . . . . . . . . . =
',I10/)
309 & 5X,'initial density. . . . . . . . . . . . . . . =
',1PG20.13/)
311 & 5X,'young
''s modulus. . . . . . . . . . . . . . .=',1pg20.13/
312 & 5x,
'POISSON''S RATIO. . . . . . . . . . . . . . .=',1pg20
315 & 5x,
'TENSION YIELD STRESS FUNCTION NUMBER. . . . .=',i10/
316 & 5x,
'YIELD SCALE FACTOR. . . . . . . . . . . . . .=',1pg20.13)
318 & 5x,
'COMPRESSION YIELD STRESS FUNCTION NUMBER. . .=',i10/
319 & 5x,
'YIELD SCALE FACTOR. . . . . . . . . . . . . .=',1pg20.13)
322 & 5x,
'SHEAR YIELD STRESS FUNCTION NUMBER. . . . . .=',i10/
323 & 5x,
'YIELD SCALE FACTOR. . . . . . . . . . . . . .=',1pg20.13/
324 & 5x,
'STRAIN RATE SCALE FACTOR . . . . . . . . . .=',1pg20.13)
327 & 5x,
'PLASTIC POISSON RATIO . . . . . . . . . . =',1pg20.13/
328 & 5x,'plastic poisson ratio
FUNCTION number . . . =
',I10/
329 & 5X,'yield scale factor. . . . . . . . . . . . . =
',1PG20.13/
330 & 5X,'smooth strain rate option. . . . . . . . . . =
',I10/
331 & 5X,'strain rate cutting frequency . . . . . . . .=
',1PG20.13/)
333 & 5X,'failure plastic strain . . . . . . . . . . .=
',1PG20.13/
334 & 5X,'rupture plastic strain. . . . . . . . . . . .=
',1PG20.13/
335 & 5X,'damage function number . . . . . . . . . . =
',I10/,
336 & 5X,'damage scale factor. . . . . . . . . . . . . =
',1PG20.13 )
338 & 5X,'formulation flag . . . . . . . . . . . . . =
', I10,/
339 & 5X,' = 0 no associated formulation
' ,/
340 & 5X,' = 1 vonmises associated formulation
' ,/
341 & 5X,' yield surface flag . . . . . . . . . . . . .=
', I10,/
342 & 5X, ' = 0 yield surface is linear in
the vonmises
',/
343 & 5X, ' = 1 yield surface is quadratic in
the vonmises',/
344 & 5x, 'convexity condition . . . . . . . . . . . =
',I10/)
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)