46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
69 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
82
83
84 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
85 my_real,
INTENT(INOUT) :: parmat(100),uparam(maxuparam),pm(npropm)
86 INTEGER, INTENT(INOUT) :: IFUNC(MAXFUNC),NFUNC,MAXFUNC,MAXUPARAM,NUPARAM, NUVAR,ISRATE,IMATVIS
87 INTEGER, INTENT(INOUT) :: NVARTMP
88 INTEGER, INTENT(IN) :: ID
89 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
90 TYPE(SUBMODEL_DATA),INTENT(IN) :: LSUBMODEL(*)
91 TYPE(MLAW_TAG_),INTENT(INOUT) :: MTAG
92 TYPE(MATPARAM_STRUCT_) ,INTENT(INOUT) :: MATPARAM
93
94
95
96 INTEGER I,J,IFLAG,IDAM ,ISMOOTH ,TFLAG,FAIL
98 my_real rate(1000),yfac(1000),yfac_dim(1000)
99 my_real :: rho0, rhor,fcut_unit,econt,tcut
100 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
101
102
103
104 is_encrypted = .false.
105 is_available = .false.
106 idam = 0
107 israte = 0
108 imatvis = 2
109
111
112 CALL hm_get_floatv(
'MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
113 CALL hm_get_floatv(
'Refer_Rho' ,rhor ,is_available, lsubmodel, unitab)
114 CALL hm_get_floatv(
'MAT_E0' ,e0 ,is_available, lsubmodel, unitab)
115 CALL hm_get_floatv(
'MAT_NU' ,nu ,is_available, lsubmodel, unitab)
116 CALL hm_get_intv (
'NL' ,nfunc ,is_available, lsubmodel)
117 CALL hm_get_intv (
'Ismooth' ,ismooth ,is_available, lsubmodel)
118 CALL hm_get_floatv(
'Fcut' ,fcut ,is_available, lsubmodel, unitab)
119 CALL hm_get_floatv(
'MAT_SHAPE' ,shape ,is_available, lsubmodel, unitab)
120 CALL hm_get_floatv(
'Hys' ,hys ,is_available, lsubmodel, unitab)
122 CALL hm_get_intv (
'MAT_TFLAG' ,tflag ,is_available, lsubmodel)
123 CALL hm_get_intv (
'LSD_MAT83_FAIL' ,fail ,is_available, lsubmodel)
125 CALL hm_get_floatv(
'LSD_MAT83_TC' ,tcut ,is_available, lsubmodel, unitab)
126
127!
128
129 IF (nfunc == 0) THEN
131 . msgtype=msgerror,
132 . anmode=aninfo_blind,
134 . c1=titr)
135 ENDIF
136 IF(tflag == 0) tflag = 1
137 IF(econt == zero) econt = e0
138 IF(tcut == zero) tcut = ep20
139
140
141
142 DO i=1,nfunc
147 ENDDO
148
149 DO i=1,nfunc
150 IF (ifunc(i) == 0) THEN
152 . msgtype=msgerror,
153 . anmode=aninfo_blind_1,
155 . c1=titr,
156 . i2=ifunc(i))
157 ENDIF
158 IF(yfac(i) == zero) yfac(i) = yfac_dim(i) * one
159 ENDDO
160 hys = abs(hys)
161 iflag = 0
162 IF (nfunc > 0 .AND. hys == zero) iflag = 1
163 IF (nfunc > 0 .AND. hys > zero) iflag = 2
164 IF (shape == zero) shape = one
166 IF (hys == zero) hys = one
167 IF (rhor==zero) rhor=rho0
168 IF (fcut == zero .AND. nfunc > 1 ) THEN
169 fcut = ep03*unitab%FAC_T_WORK
170 ismooth = 1
171 ENDIF
172 IF(ismooth == 0 .AND. fcut > zero
173 IF(nfunc == 1) ismooth = 0
174 pm(1) = rhor
175 pm(89)= rho0
176
177 g = half*e0/(one + nu)
178 uparam(1) = e0
179 uparam(4) = g
180 uparam(5) = nu
181 uparam(6) = shape
182 uparam(7) = hys
183 uparam(9) = iflag
184 uparam(10) = idam
185 DO i=1,nfunc
186 uparam(i + 10) = rate(i)
187 uparam(i + 10 + nfunc) = yfac(i)
188 END DO
189 nuparam =13 + 2*nfunc
190 uparam(nuparam) =
alpha
191 nuparam = nuparam + 1
192 uparam(nuparam) = tflag
193 nuparam = nuparam + 1
194 uparam(nuparam ) = fail
195 nuparam = nuparam + 1
196 uparam(nuparam ) = tcut
197 nuparam = nuparam + 1
198 uparam(nuparam ) = econt
199
200 c1=econt /three/(one - two*nu)
201 parmat(1) = c1
202 parmat(2) = econt
203 parmat(3) = nu
204 parmat(4) = ismooth
205 parmat(5) = fcut
206
207 israte = ismooth
208 nuvar = 10
209 nvartmp = nfunc*3
210
211 mtag%G_EPSD = 1
212 mtag%L_EPSD = 1
213
214 WRITE(iout,1000)
215 WRITE(iout,1001) trim(titr),
id,90
216 IF (is_encrypted) THEN
217 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
218 ELSE
219 WRITE(iout,1100)rho0
220 WRITE(iout,1150)e0,nu, tflag, econt, tcut,fail
221 WRITE(iout,1200)fcut,ismooth,shape,hys,
alpha
222 WRITE(iout,1300)(ifunc(j),rate(j),yfac(j),j=1,nfunc )
223 ENDIF
224
226 IF (nu >= 0.49) THEN
228 ELSE
230 END IF
232
234
235 RETURN
236
237 1000 FORMAT(
238 & 5x,40h
tabulated non linear visco elastic law,/,
239 & 5x,40h --------------------------------------,//)
240 1001 FORMAT(/
241 & 5x,a,/,
242 & 5x,'MATERIAL NUMBER . . . . . . . . . . . .=',i10/,
243 & 5x,'MATERIAL LAW. . . . . . . . . . . . . .=',i10/)
244 1100 FORMAT(
245 & 5x,'INITIAL DENSITY . . . . . . . . . . . .=',1pg20.13/)
246 1150 FORMAT(
247 & 5x,'INITIAL YOUNG''S MODULUS. . . . . . . .=',1pg20.13/,
248 & 5x,'POISSON''S RATIO. . . . . . . . . . . .=',1pg20.13/,
249 & 5x,'TENSILE STRESS FLAG . . . . . . . . . =',i10/,
250 & 10x, '1 : FOLLOW THE INPUT CURVE ' /,
251 & 10x, '2 : FOLLOW E0 '/
252 & 5x,'OPTIONAL YOUNG MODULUS . . . . . . . . =',1pg20.13/,
253 & 5x,'TENSION CUT-OOF STRESS . . . . . . . . =',1pg20.13/,
254 & 5x,'FAILURE OPTION AFTER CUT-OFF STRESS IS REACHED =',i10/,
255 & 10x, '0 : TENSILE STRESS REMAINS AT CUT-OFF VALUE'/,
256 & 10x, '1 : THE ELEMENT IS DELETED '/)
257
258 1200 FORMAT(
259 & 5x,'STRAIN RATE COEFFICIENT . . . . . . . .=',1pg20.13/,
260 & 5x,'FLAG FOR FILTERING STRAIN RATE . . . .=',i10/,
261 & 5x,'SHAPE FACTOR FOR UNLOADING . . . . . .=',1pg20.13/,
262 & 5x,'HYSTERETIC UNLOADING FACTOR . . . . . .=',1pg20.13/,
263 & 5x,'EXPONANT FACTOR FOR UNLOADING . . . . .=',1pg20.13/)
264 1300 FORMAT(
265 & 5x,'LOADING STRESS FUNCTION NUMBER . . . .=',i10/,
266 & 5x,'STRAIN RATE . . . . . . . . . . . . . .=',1pg20.13/,
267 & 5x,'SCALE FACTOR. . . . . . . . . . . . . .=',1pg20.13/)
268 1500 FORMAT(
269 & 5x,'PRESSURE DEPENDENT YIELD FUNCTION . . .=',i10/
270 & 5x,'PRESSURE SCALE FACTOR . . . . . . . . .=',1pg20.13)
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
subroutine hm_get_float_array_index_dim(name, dim_fac, index, is_available, lsubmodel, unitab)
subroutine hm_get_floatv(name, rval, 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)