42
43
44
49 USE matparam_def_mod
52
53
54
55#include "implicit_f.inc"
56
57
58
59#include "units_c.inc"
60#include "param_c.inc"
61
62
63
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
69 TYPE(MLAW_TAG_), INTENT(INOUT) :: MTAG
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
74
75
76
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,
80 . rho0, rhor
81 LOGICAL :: IS_ENCRYPTED, IS_AVAILABLE
82
83
84
85
86 nuvar = 40
87 nfunc = 0
88 imatvis = 1
89
90 is_encrypted = .false.
91 is_available = .false.
92
93
95
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
99 rhor = rho0
100 ENDIF
101 pm(1) = rhor
102 pm(89) = rho0
103
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)
109
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)
115
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)
121
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
130 . msgtype = msgerror,
131 . anmode = aninfo,
132 . r1 = nu1,
133 . i1 = mat_id,
134 . c1 = titr)
135 ENDIF
136 IF (nu2 < zero .OR. nu2 >= half) THEN
138 . msgtype = msgerror,
139 . anmode = aninfo,
140 . r1 = nu2,
141 . i1 = mat_id,
142 . c1 = titr)
143 ENDIF
144 nuparam = 15
145 IF(nuparam > maxuparam)THEN
147 . msgtype = msgerror,
148 . anmode = aninfo,
149 . i1 = mat_id,
150 . c1 = titr,
151 . i2 = nuparam,
152 . i3 = maxuparam)
153 ELSE
154 uparam(1) = ak
155 uparam(2) = g0
156 uparam(3) = g1
157 uparam(4) = g2
158 uparam(5) = g3
159 uparam(6) = g4
160 uparam(7) = g5
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)
166 uparam(13) = astas
167 uparam(14) = bstas
168 uparam(15) = vmisk
169 ENDIF
170
171 stifint(1) = ak
172
173
174 stifint(16) = 2
175 stifint(17) = two * g0 / (ak + four_over_3 * g0)
176
177 IF (nu1 >= 0.49 .or. nu2 >= 0.49) THEN
179 ELSE
181 END IF
183
186
187 WRITE(iout, 800) trim(titr), mat_id, 40
188 WRITE(iout,1000)
189 IF(is_encrypted)THEN
190 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
191 ELSE
192 WRITE(iout, 850) rho0
193 WRITE(iout,1100)ak,g0,g1,g2,g3,g4,g5,
194 . beta1,beta2,beta3,beta4,beta5,
195 . astas,bstas,vmisk
196 ENDIF
197
198 800 FORMAT(/
199 & 5x,a,/,
200 & 5x,'MATERIAL NUMBER. . . . . . . . . . . . . . .=',i10/,
201 & 5x,'MATERIAL LAW . . . . . . . . . . . . . . . .=',i10/)
202 850 FORMAT(
203 & 5x,'INITIAL DENSITY . . . . . . . . . . . . . .=',1pg20.13/)
204 1000 FORMAT(
205 & 5x,' maxwell visco-elastic law ',/,
206 & 5X,' ------------------------- ',//)
207 1100 FORMAT(
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//)
223
224 RETURN
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_option_is_encrypted(is_encrypted)
subroutine init_mat_keyword(matparam, keyword)
integer, parameter nchartitle
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)