45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
68 USE matparam_def_mod
72
73
74
75#include "implicit_f.inc"
76
77
78
79#include "units_c.inc"
80#include "param_c.inc"
81#include "com04_c.inc"
82
83
84
85 INTEGER, INTENT(IN) :: ID,MAXFUNC,,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 (UNIT_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)
103
104
105
106 INTEGER :: IFORM,ICONV,IQUAD,ICAS,ISRAT,ILAW
107 my_real :: e,nu,g,rho0,rhor,fcut,nup,c1,a1,a2,epsr,epsf,
108 . xfac,xfac_unit
109 my_real :: tfac(3),yfac(2),fac_unit(5)
110 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED,FOUND
111
112
113
114 is_encrypted = .false.
115 is_available = .false.
116
117
118
120
121 ilaw = 76
122
123 CALL hm_get_floatv(
'MAT_RHO' ,rho0 ,is_available,lsubmodel, unitab)
124 CALL hm_get_floatv(
'Refer_Rho',rhor ,is_available,lsubmodel, unitab)
125
126 CALL hm_get_floatv(
'MAT_E' ,e ,is_available,lsubmodel, unitab)
127 CALL hm_get_floatv(
'MAT_NU' ,nu ,is_available,lsubmodel, unitab)
128
129 CALL hm_get_intv (
'FUN_D1' ,itable(1) ,is_available,lsubmodel)
130 CALL hm_get_intv (
'FUN_D2' ,itable(2) ,is_available,lsubmodel)
131 CALL hm_get_intv (
'FUN_D3' ,itable(3) ,is_available,lsubmodel)
132
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)
137
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)
142 CALL hm_get_floatv(
'MAT_asrate' ,fcut ,is_available, lsubmodel, unitab)
143
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)
146
147 CALL hm_get_intv (
'FUN_A1' ,ifunc(2) ,is_available,lsubmodel)
148 CALL hm_get_floatv(
'SCALE' ,yfac(2) ,is_available, lsubmodel, unitab)
149
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)
153
158 CALL hm_get_floatv_dim(
'MAT_PScale' ,fac_unit(4) ,is_available, lsubmodel, unitab)
160
161
162
163
164 IF (fcut == zero) THEN
165 fcut = 500.0d0*unitab%FAC_T_WORK
166 END IF
167 israt = 0
168 israte = 0
169
170 IF (itable(1) > 0 .AND. itable(2) > 0 .AND. itable(3) > 0) THEN
171 iconv = 1
172 ELSE
173 iconv = 0
174 ENDIF
175
176 IF (itable(1) == 0) THEN
177 CALL ancmsg(msgid=126, msgtype=msgerror, anmode=aninfo,
179 . c1=titr,
180 . i2=itable(1))
181 ENDIF
182
183 IF (epsf == zero) epsf = infinity
184 IF (epsr == zero) epsr = two*epsf
185 IF (iform == 1 .AND. iquad == 0) iquad = 1
186
187
188
189
190
191
192
193
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
200
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)
207
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)
212
213 uparam(1) = e
214 uparam(2) = e/(one - nu*nu)
215 uparam(3) = nu*uparam(2)
216 uparam(4) = g
217 uparam(5) = nu
218 uparam(6) = a1
219 uparam(7) = a2
220 uparam(8) = c1
221 uparam(9) = nup
222 uparam(10) = epsf
223 uparam(11) = epsr
224
225 uparam(13) = iform
226 uparam(14) = iquad
227 uparam(15) = iconv
228 uparam(16) = fcut*pi*two
229 uparam(17) = icas
230 uparam(18) = one / xfac
231 uparam(19) = zero
232 uparam(20) = zero
233 uparam(21) = zero
234 uparam(22) = zero
235 uparam(23) = zero
236 uparam(24) = zero
237 uparam(25) = tfac(1)
238 uparam(26) = tfac(2)
239 uparam(27) = tfac(3)
240 uparam(28) = yfac(1)
241 uparam(29) = yfac(2)
242
243 nuparam = 29
244 nuvar = 7
245 nvartmp = 8
246 nfunc = 2
247 numtabl = 3
248
249
250 parmat(1) = c1
251 parmat(2) = e
252 parmat(3) = nu
253 parmat(4) = israte
254 parmat(5) = zero
255 parmat(16) = 2
256 parmat(17) = (one - two*nu)/(one - nu)
257
258 IF (rhor == zero) rhor=rho0
259 pm(1) = rhor
260 pm(89)= rho0
261
262 mtag%G_EPSD = 1
263 mtag%L_EPSD = 1
264 mtag%G_PLA = 1
265 mtag%L_PLA = 1
266 mtag%G_DMG = 1
267 mtag%L_DMG = 1
268
269 matparam%NTABLE = 3
270 IF (icas == 0) THEN
272 ELSE
274 ENDIF
278
279
282
283
284 WRITE(iout,1010) trim(titr),
id,76
285 WRITE(iout,1000)
286 IF (is_encrypted) THEN
287 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
288 ELSE
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
297 ENDIF
298
299 RETURN
300
301 1000 FORMAT(
302 & 5x,' SEMI ANALYTICAL PLASTIC LAW 76 ',/,
303 & 5x,' ------------------------------ ' ,//)
304 1010 FORMAT(/
305 & 5x,a,/,
306 & 5x,'MATERIAL NUMBER. . . . . . . . . . . . . . . =',i10/,
307 & 5x,'MATERIAL LAW . . . . . . . . . . . . . . . . =',i10/)
308 1020 FORMAT(
309 & 5x,'INITIAL DENSITY. . . . . . . . . . . . . . . =',1pg20.13/)
310 1100 FORMAT(
311 & 5x,'YOUNG''S MODULUS. . . . . . . . . . . . . . .=',1pg20.13/
312 & 5x,'POISSON''S RATIO. . . . . . . . . . . . . . .=',1pg20.13/)
313
314 1200 FORMAT(
315 & 5x,'TENSION YIELD STRESS FUNCTION NUMBER. . . . .=',i10/
316 & 5x,'YIELD SCALE FACTOR. . . . . . . . . . . . . .=',1pg20.13)
317 1210 FORMAT(
318 & 5x,'compression yield stress FUNCTION number. . .=',I10/
319 & 5X,'yield scale factor. . . . . . . . . . . . . .=',1PG20.13)
320
321 1220 FORMAT(
322 & 5X,'shear yield stress function number. . . . . .=',I10/
323 & 5X,'yield scale factor. . . . . . . . . . . . . .=',1PG20.13/
324 & 5X,'strain rate scale factor . . . . . . . . . .=',1PG20.13)
325
326 1300 FORMAT(
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/)
332 1400 FORMAT(
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 )
337 1500 FORMAT(
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/)
345
end diagonal values have been computed in the(sparse) matrix id.SOL
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
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)