39 . MAXFUNC ,NFUNC , STIFINT ,UNITAB ,MAT_ID ,
40 . MTAG ,TITR , LSUBMODEL ,PM ,IMATVIS,
55#include "implicit_f.inc"
64 TYPE (UNIT_TYPE_),
INTENT(IN) ::UNITAB
65 my_real,
DIMENSION(NPROPM),
INTENT(INOUT) :: PM
66 my_real,
DIMENSION(100),
INTENT(INOUT) :: STIFINT
67 my_real,
DIMENSION(MAXUPARAM),
INTENT(INOUT) :: uparam
68 INTEGER,
INTENT(INOUT) :: NFUNC, NUPARAM, NUVAR, IMATVIS
70 INTEGER,
INTENT(IN) :: MAT_ID, MAXFUNC, MAXUPARAM
71 CHARACTER(LEN=NCHARTITLE),
INTENT(IN) :: TITR
72 TYPE(
submodel_data),
DIMENSION(NSUBMOD),
INTENT(IN) :: LSUBMODEL
73 TYPE(matparam_struct_) ,
INTENT(INOUT) :: MATPARAM
77 my_real :: ak, g0, g1, g2, g3, g4, g5, gt, beta1,
78 . beta2, beta3, beta4, beta5, nu1, nu2,
79 . astas, bstas, vmisk, fac_l, fac_t, fac_m, fac_c,
81 LOGICAL :: IS_ENCRYPTED, IS_AVAILABLE
90 is_encrypted = .false.
91 is_available = .false.
96 CALL hm_get_floatv(
'MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
97 CALL hm_get_floatv(
'Refer_Rho' ,rhor ,is_available, lsubmodel, unitab)
98 IF (rhor == zero)
THEN
104 CALL hm_get_floatv(
'MAT_BULK', ak, is_available, lsubmodel, unitab)
105 CALL hm_get_floatv(
'MAT_GI', g0, is_available, lsubmodel, unitab)
106 CALL hm_get_floatv(
'Astass', astas, is_available, lsubmodel, unitab)
107 CALL hm_get_floatv(
'Bstass', bstas, is_available, lsubmodel, unitab)
108 CALL hm_get_floatv(
'Kvm', vmisk, is_available, lsubmodel, unitab)
110 CALL hm_get_floatv(
'MAT_G0', g1, is_available, lsubmodel, unitab)
111 CALL hm_get_floatv(
'MAT_G2', g2, is_available, lsubmodel, unitab)
112 CALL hm_get_floatv(
'MAT_G3', g3, is_available, lsubmodel, unitab)
113 CALL hm_get_floatv(
'MAT_G4', g4, is_available, lsubmodel, unitab)
114 CALL hm_get_floatv(
'MAT_G5', g5, is_available, lsubmodel, unitab)
116 CALL hm_get_floatv(
'MAT_DECAY', beta1, is_available, lsubmodel, unitab)
117 CALL hm_get_floatv(
'MAT_DECAY2', beta2, is_available, lsubmodel, unitab)
118 CALL hm_get_floatv(
'MAT_DECAY3', beta3, is_available, lsubmodel, unitab)
119 CALL hm_get_floatv(
'MAT_DECAY4', beta4, is_available, lsubmodel, unitab)
120 CALL hm_get_floatv(
'MAT_DECAY5', beta5, is_available, lsubmodel, unitab)
122 IF (astas <= em20) astas = infinity
123 IF (bstas <= em20) bstas = infinity
124 IF (vmisk <= em20) vmisk = infinity
125 nu1 = (three * ak - two * g0) / (two * g0 + six * ak)
126 gt = g0 + g1 + g2 + g3 + g4 + g5
127 nu2 = (three * ak - two * gt) / (two * gt + six * ak)
128 IF (nu1 < zero .OR. nu1 >= half)
THEN
136 IF (nu2 < zero .OR. nu2 >= half)
THEN
138 . msgtype = msgerror,
145 IF(nuparam > maxuparam)
THEN
147 . msgtype = msgerror,
161 uparam(8) =
max(beta1, em20)
162 uparam(9) =
max(beta2, em20)
163 uparam(10) =
max(beta3, em20)
164 uparam(11) =
max(beta4, em20)
165 uparam(12) =
max(beta5, em20)
175 stifint(17) = two * g0 / (ak + four_over_3 * g0)
177 IF (nu1 >= 0.49 .or. nu2 >= 0.49)
THEN
187 WRITE(iout, 800) trim(titr), mat_id, 40
190 WRITE(iout,
'(5X,A,//)')
'CONFIDENTIAL DATA'
192 WRITE(iout, 850) rho0
193 WRITE(iout,1100)ak,g0,g1,g2,g3,g4,g5,
194 . beta1,beta2,beta3,beta4,beta5,
200 & 5x,
'MATERIAL NUMBER. . . . . . . . . . . . . . .=',i10/,
201 & 5x,
'MATERIAL LAW . . . . . . . . . . . . . . . .=',i10/)
203 & 5x,
'INITIAL DENSITY . . . . . . . . . . . . . .=',1pg20.13/)
205 & 5x,
' MAXWELL VISCO-ELASTIC LAW ',/,
206 & 5x,
' ------------------------- ',//)
208 & 5x,
'BULK MODULUS . . . . . . . . . . . . .=',1pg20.13/
209 & 5x,
'LONG TIME SHEAR MODULUS . . . . . . . .=',1pg20.13/
210 & 5x,
'SHEAR MODULUS 1 . . . . . . . . . . . .=',1pg20.13/
211 & 5x,
'SHEAR MODULUS 2 . . . . . . . . . . . .=',1pg20.13/
212 & 5x,
'SHEAR MODULUS 3 . . . . . . . . . . . .=',1pg20.13/
213 & 5x,
'SHEAR MODULUS 4 . . . . . . . . . . . .=',1pg20.13/
214 & 5x,
'SHEAR MODULUS 5 . . . . . . . . . . . .=',1pg20.13/
215 & 5x,
'DECAY CONSTANT 1 . . . . . . . . . . .=',1pg20.13/
216 & 5x,
'DECAY CONSTANT 2 . . . . . . . . . . .=',1pg20.13/
217 & 5x,
'DECAY CONSTANT 3 . . . . . . . . . . .=',1pg20.13/
218 & 5x,
'DECAY CONSTANT 4 . . . . . . . . . . .=',1pg20.13/
219 & 5x,
'DECAY CONSTANT 5 . . . . . . . . . . .=',1pg20.13/
220 & 5x,
'STASSI A COEFFICIENT . . . . . . . . .=',1pg20.13/
221 & 5x,
'STASSI B COEFFICIENT . . . . . . . . .=',1pg20.13/
222 & 5x,
'K VON MISES COEFFICIENT . . . . . . . =',1pg20.13//)
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)