45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
68 USE matparam_def_mod
70
71
72
73#include "implicit_f.inc"
74
75
76
77#include "units_c.inc"
78#include "param_c.inc"
79
80
81
82 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
83 my_real,
INTENT(INOUT) :: pm(npropm),parmat(100),uparam(maxuparam)
84 INTEGER, INTENT(INOUT) :: IPM(NPROPMI),ISRATE,IFUNC(MAXFUNC),NFUNC,MAXFUNC,
85 . MAXUPARAM,NUPARAM, NUVAR,IMATVIS
86 TYPE(MLAW_TAG_),INTENT(INOUT) :: MTAG
87 INTEGER,INTENT(IN) :: MAT_ID
88 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
89 TYPE(SUBMODEL_DATA),INTENT(IN) :: LSUBMODEL(*)
90 TYPE(MATPARAM_STRUCT_) ,INTENT(INOUT) :: MATPARAM
91
92
93
94 INTEGER I,J,NRATE,NPS,IR0
96 . e,nu,g,c1,epsmax,epsr1,epsr2,rate(11),yfac(11),
97 . r0,r45,r90,r,h,fisokin,m,
98 . einf,ce,fac_pres
99 INTEGER IFUNCE, OPTE, NUM_FUNC,NUMCURVES
101 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
102
103
104
105 is_encrypted = .false.
106 is_available = .false.
107 mtag%G_PLA = 1
108 mtag%G_SEQ = 1
109 mtag%L_PLA = 1
110 mtag%L_SEQ = 1
111 mtag%L_EPSD = 1
112 mtag%G_EPSD = 1
113 israte = 0
114 imatvis = 0
115
116
118
119 CALL hm_get_floatv(
'MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
120
121 CALL hm_get_floatv(
'MAT_E' ,e ,is_available, lsubmodel, unitab)
122 CALL hm_get_floatv(
'MAT_NU' ,nu ,is_available, lsubmodel, unitab)
123
124 CALL hm_get_intv (
'Yr_fun' ,ifunce ,is_available, lsubmodel)
125 CALL hm_get_floatv(
'MAT_EFIB' ,einf ,is_available, lsubmodel, unitab)
126 CALL hm_get_floatv(
'MAT_C' ,ce ,is_available, lsubmodel, unitab)
127
128 CALL hm_get_floatv(
'MAT_R00' ,r0 ,is_available, lsubmodel, unitab)
129 CALL hm_get_floatv(
'MAT_R45' ,r45 ,is_available, lsubmodel, unitab)
130 CALL hm_get_floatv(
'MAT_R90' ,r90 ,is_available, lsubmodel, unitab)
131 CALL hm_get_floatv(
'MAT_CHARD' ,fisokin ,is_available, lsubmodel, unitab)
132 CALL hm_get_intv (
'MAT_Iyield' ,ir0 ,is_available, lsubmodel)
133
134 CALL hm_get_floatv(
'MAT_EPS' ,epsmax ,is_available, lsubmodel, unitab)
135 CALL hm_get_floatv(
'MAT_EPST1' ,epsr1 ,is_available, lsubmodel, unitab)
136 CALL hm_get_floatv(
'MAT_EPST2' ,epsr2 ,is_available, lsubmodel, unitab)
137 CALL hm_get_floatv(
'Fcut' ,asrate ,is_available, lsubmodel, unitab)
138 CALL hm_get_intv (
'Fsmooth' ,israte ,is_available, lsubmodel)
139
141
142 CALL hm_get_intv (
'NUM_CURVES' ,numcurves ,is_available, lsubmodel)
143
144
145 rhor=rho0
146
147 pm(1) =rhor
148 pm(89)=rho0
149 nrate = 0
150
151 DO i=1,numcurves
155 IF(ifunc(i)/=0) nrate = i
156 ENDDO
157
158 IF (nrate == 0) THEN
160 . msgtype=msgerror,
161 . anmode=aninfo,
162 . i1=mat_id,
163 . c1=titr)
164 ENDIF
165
166 IF(r0 ==zero) r0 = one
167 IF(r45==zero) r45 = one
168 IF(r90==zero) r90 = one
169 IF(epsr1==zero)epsr1=infinity
170 IF(epsr2==zero)epsr2=two*infinity
171 DO i=1,nrate
172 IF(yfac(i)==zero) yfac(i)=one * fac_pres
173 ENDDO
174
175
176
177 IF (asrate /= zero) THEN
178
179 israte = 1
180 ELSE
181
182 IF (israte /= 0) THEN
183 asrate = 10000.0d0*unitab%FAC_T_WORK
184
185 ELSE
186 asrate = zero
187 ENDIF
188 ENDIF
189
190
191 IF (nrate == 1) THEN
192 num_func=2
193 ifunc(2)=ifunc(1)
194 rate(1)=zero
195 rate(2)=one
196 yfac(2)=yfac(1)
197 ELSEIF (rate(1) == 0) THEN
198 num_func=nrate
199 ELSE
200 num_func=nrate+1
201 DO j=nrate,1,-1
202 ifunc(j+1)=ifunc(j)
203 rate(j+1)=rate(j)
204 yfac(j+1)=yfac(j)
205 ENDDO
206 rate(1)=zero
207 ENDIF
208
209 uparam(1)=num_func
210 uparam(2)=e
211 uparam(3)=e/(one-nu*nu)
212 uparam(4)=nu*uparam(3)
213 g=half*e/(one+nu)
214 uparam(5)=g
215 uparam(6)=nu
216 r=(r0+r45+r45+r90)*fourth
217 h=r/(one+r)
218
219 uparam(7)=h*(one+one/r0)
220 uparam(8)=h*(one+one/r90)
221 uparam(9)=h*two
222 uparam(10)=(r45*two + one)*(uparam(7)+uparam(8)-uparam(9))
223 IF (ir0 > 0) THEN
224 uparam(8)=uparam(8)/uparam(7)
225 uparam(9)=uparam(9)/uparam(7)
226 uparam(10)=uparam(10)/uparam(7)
227 uparam(7)=one
228 END IF
229 nps=10
230 DO j=1,num_func
231 uparam(j+nps)=rate(j)
232 ENDDO
233 DO j=1,num_func
234 uparam(j+nps+num_func)=yfac(j)
235 ENDDO
236 uparam(nps+2*num_func+1)=epsmax
237 uparam(nps+2*num_func+2)=epsr1
238 uparam(nps+2*num_func+3)=epsr2
239 uparam(nps+2*num_func+4)=two*g
240 uparam(nps+2*num_func+5)=three*g
241 c1=e/three/(one - two*nu)
242 uparam(nps+2*num_func+6)=c1
243 uparam(nps+2*num_func+7)=c1+ four_over_3*g
244 IF (fisokin>one.OR.fisokin<zero) THEN
246 . msgtype=msgerror,
247 . anmode=aninfo,
248 . i1=mat_id,
249 . c1=titr)
250 END IF
251 uparam(nps+2*num_func+8)=fisokin
252
253
254 opte = 0
255 IF (ifunce > 0 )opte = 1
256 nfunc = num_func + 1
257 ifunc(nfunc) = ifunce
258 uparam(nps+2*num_func+9) = nfunc
259 uparam(nps+2*num_func+10) = opte
260 uparam(nps+2*num_func+11) = einf
261 uparam(nps+2*num_func+12) = ce
262
263 nuparam = nps+2*num_func+12
264
265 parmat(1) = c1
266 parmat(2) = e
267 parmat(3) = nu
268 parmat(4) = israte
269 parmat(5) = asrate
270 nuvar = 5+num_func
271
272
274
276
277 WRITE(iout,1001) trim(titr),mat_id,43
278 WRITE(iout,1000)
279 IF(is_encrypted)THEN
280 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
281 ELSE
282 WRITE(iout,1002) rho0
283 WRITE(iout,1100)e,nu,g,r0,r45,r90,fisokin
284 IF (ir0 >0) WRITE(iout,1110)
285 WRITE(iout,1300)epsmax,epsr1,epsr2,ifunce,einf,ce
286 WRITE(iout,1400)israte,asrate
287 WRITE(iout,1200)(ifunc(j),yfac(j),rate(j),j=1,num_func)
288 WRITE(iout,*)' '
289 ENDIF
290
291 RETURN
292 1000 FORMAT(
293 & 5x,40h
tabulated hill orthotropic plasticity,/,
294 & 5x,40h ------------------------------------- /)
295 1001 FORMAT(
296 & 5x,a,/,
297 & 5x,'material number . . . . . . . . . . . .=',I10/,
298 & 5X,'material law. . . . . . . . . . . . . .=',I10/)
299 1002 FORMAT(
300 & 5X,'initial density . . . . . . . . . . . .=',1PG20.13/)
301 1100 FORMAT(
302 & 5X,'young modulus . . . . . . . . . . . . .=',1PG20.13/
303 & 5X,'poisson ratio . . . . . . . . . . . . .=',1PG20.13/
304 & 5X,'shear modulus . . . . . . . . . . . . .=',1PG20.13/
305 & 5X,'lankford coefficient r00. . . . . . . .=',1PG20.13/
306 & 5X,'lankford coefficient r45. . . . . . . .=',1PG20.13/
307 & 5X,'lankford coefficient r90. . . . . . . .=',1PG20.13/
308 & 5X,'iso-kinematic hardening factor. . . . .=',1PG20.13)
309 1110 FORMAT(
310 & 5X,'yield stress is suppossd in orthotropic dir. 1 '/)
311 1200 FORMAT(
312 & 5X,'yield stress FUNCTION number. . . . . .=',I10/
313 & 5X,'yield scale factor. . . . . . . . . . .=',1PG20.13/
314 & 5X,'strain rate . . . . . . . . . . . . . .=',1PG20.13)
315 1300 FORMAT(
316 & 5X,'maximum plastic strain. . . . . . . . .=',1PG20.13/
317 & 5X,'tensile failure strain 1. . . . . . . .=',1PG20.13/
318 & 5X,'tensile failure strain 2. . . . . . . .=',1PG20.13/
319 & 5X,'young modulus scale factor function . .=',I10/
320 & 5X,'young modulus einf. . . . . . . . . . .=',1PG20.13/
321 & 5X,'parameter ce. . . . . . . . . . . . . .=',1PG20.13)
322 1400 FORMAT(
323 & 5X,'strain rate filtering flag . . . . . .=',I10/
324 & 5X,'strain rate cutting frequency . . . . .=',1PG20.13)
325
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
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_int_array_index(name, ival, index, is_available, lsubmodel)
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)
subroutine tabulated(iflag, nel, pm, off, eint, mu, espe, dvol, df, vnew, mat, psh, pnew, dpdm, dpde, npf, tf)