42
43
44
49 USE matparam_def_mod
51
52
53
54#include "implicit_f.inc"
55
56
57
58#include "units_c.inc"
59#include "param_c.inc"
60
61
62
63 TYPE (UNIT_TYPE_),INTENT(IN) :: UNITAB
64 INTEGER, INTENT(IN) :: MAT_ID,MAXUPARAM
65 my_real,
DIMENSION(NPROPM) ,
INTENT(INOUT) :: pm
66 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
67 INTEGER, INTENT(INOUT) :: ISRATE
68 INTEGER, INTENT(OUT) :: NUPARAM,NUVAR
69 my_real,
DIMENSION(MAXUPARAM) ,
INTENT(INOUT) :: uparam
70 my_real,
DIMENSION(100),
INTENT(OUT) :: parmat
71 TYPE(SUBMODEL_DATA), DIMENSION(*),INTENT(IN) :: LSUBMODEL
72 TYPE(MLAW_TAG_), INTENT(OUT) :: MTAG
73 TYPE(MATPARAM_STRUCT_) ,INTENT(INOUT) :: MATPARAM
74 my_real,
INTENT(INOUT) :: asrate
75
76
77
78 INTEGER I,J,K,ILAW,IRATE,DTYPE,DFLAG,IREG,IDEL
79
81 . rho0,young,nu,a,g,g2,lam,bulk,fcut,fc,ft,gft,
82 . ah,bh,ch,dh,hp,as,qh0,ecc,m0,wf,wf1,ft1,df,bs,
83 . efc,epsi
85 . fc0,epst0,epstmax,deltas,betas,epsc0,epscmax,alphas,gammas
86
87 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
88
89 is_encrypted = .false.
90 is_available = .false.
91 ilaw = 124
92
94
95
96
97 CALL hm_get_floatv(
'MAT_RHO' ,rho0 ,is_available,lsubmodel,unitab)
98
99 CALL hm_get_floatv(
'MAT_E' ,young ,is_available,lsubmodel,unitab)
100 CALL hm_get_floatv(
'MAT_NU' ,nu ,is_available,lsubmodel,unitab)
101 CALL hm_get_intv (
'IDEL' ,idel ,is_available,lsubmodel)
102 CALL hm_get_intv (
'IRATE' ,irate ,is_available,lsubmodel)
103 CALL hm_get_floatv(
'FCUT' ,asrate ,is_available,lsubmodel,unitab)
104
105 CALL hm_get_floatv(
'MAT_ECC' ,ecc ,is_available,lsubmodel,unitab)
106 CALL hm_get_floatv(
'MAT_QH0' ,qh0 ,is_available,lsubmodel,unitab)
107 CALL hm_get_floatv(
'MAT_FT' ,ft ,is_available,lsubmodel,unitab
108 CALL hm_get_floatv(
'MAT_FC' ,fc ,is_available,lsubmodel,unitab)
109 CALL hm_get_floatv(
'MAT_HP' ,hp ,is_available,lsubmodel,unitab
110
111 CALL hm_get_floatv(
'MAT_AH' ,ah ,is_available,lsubmodel,unitab)
112 CALL hm_get_floatv(
'MAT_BH' ,bh ,is_available,lsubmodel,unitab)
113 CALL hm_get_floatv(
'MAT_CH' ,ch ,is_available,lsubmodel,unitab)
114 CALL hm_get_floatv(
'MAT_DH' ,dh ,is_available,lsubmodel,unitab)
115
116 CALL hm_get_floatv(
'MAT_AS' ,as ,is_available,lsubmodel,unitab)
117 CALL hm_get_floatv(
'MAT_BS' ,bs ,is_available,lsubmodel,unitab)
118 CALL hm_get_floatv(
'MAT_DF' ,df ,is_available,lsubmodel,unitab)
119 CALL hm_get_intv (
'DFLAG' ,dflag ,is_available,lsubmodel)
120 CALL hm_get_intv (
'DTYPE' ,dtype ,is_available,lsubmodel)
121 CALL hm_get_intv (
'IREG' ,ireg ,is_available,lsubmodel)
122
123 CALL hm_get_floatv(
'MAT_WF' ,wf ,is_available,lsubmodel,unitab)
124 CALL hm_get_floatv(
'MAT_WF1' ,wf1 ,is_available,lsubmodel,unitab)
125 CALL hm_get_floatv(
'MAT_FT1' ,ft1 ,is_available,lsubmodel,unitab)
126 CALL hm_get_floatv(
'MAT_EFC' ,efc ,is_available,lsubmodel,unitab)
127
128
129
130
131
132 IF (nu < zero .OR. nu >= half) THEN
134 . msgtype=msgerror,
135 . anmode=aninfo_blind_2,
136 . r1=nu,
137 . i1=mat_id,
138 . c1=titr)
139 ENDIF
140
141 g2 = young / (one + nu)
142 g = half * g2
143 lam = g2 * nu /(one - two*nu)
144 bulk = third * young / (one - nu*two)
145
146 IF (wf1 == zero) THEN
147 wf1 = 0.15d0*wf
148 ENDIF
149
150 IF (ft1 == zero) THEN
151 ft1 = 0.3d0*ft
152 ENDIF
153
154 IF (qh0 == zero) THEN
155 qh0 = 0.3d0
156 ENDIF
157
158 IF (ah == zero) THEN
159 ah = 8.0d-2
160 ENDIF
161 IF (bh == zero) THEN
162 bh = 3.0d-3
163 ENDIF
164 IF (ch == zero) THEN
165 ch = 2.0d0
166 ENDIF
167 IF (dh == zero) THEN
168 dh = 1.0d-6
169 ENDIF
170
171 IF (df == zero) THEN
172 df = 0.85d0
173 ENDIF
174
175 IF (efc == zero) THEN
176 efc = 1.0d-4
177 ENDIF
178
179 IF (as == zero) THEN
180 as = 15.0d0
181 ENDIF
182 IF (bs == zero) THEN
183 bs = one
184 ENDIF
185
186 IF (ecc == zero) THEN
187 epsi = ft*((1.16d0*fc
188 ecc = (one + epsi)/(two - epsi
189 ENDIF
190
191 m0 = three*(((fc**2)-(ft**2))/(fc*ft))*(ecc/(ecc + one))
192
193 IF (idel == 0) idel = 1
196
197 IF (dflag == 0) dflag = 1
198 dflag =
min(
max(1,dflag),4)
199
200 IF (dtype == 0) dtype = 2
201 dtype =
min(
max(1,dtype),3)
202
203 IF (ireg == 0) ireg = 2
206
207 fc0 = ten*ep06*unitab%FAC_T_WORK*unitab%FAC_T_WORK*unitab%FAC_L_WORK/unitab%FAC_M_WORK
208
209 epst0 = 30.0d0*em06*unitab%FAC_T_WORK
210 epstmax = one*unitab%FAC_T_WORK
211 deltas = one / (one + eight*(fc/fc0))
212 betas = exp(six*deltas - two)
213
214 epsc0 = 30.0d0*em06*unitab%FAC_T_WORK
215 epscmax = 30.0d0*unitab%FAC_T_WORK
216 alphas = one / (five + nine*(fc/fc0))
217 gammas = exp(6.156d0*alphas - two)
218
219 IF (irate == 0) irate = 1
222 IF (irate > 1) THEN
223 israte = 1
224
225 IF (asrate == zero) THEN
226 asrate = 10000.0d0*unitab%FAC_T_WORK
227 ENDIF
228 ELSE
229 israte = 0
230 asrate = zero
231 ENDIF
232
233
234
235
236
237 nuparam = 36
238
239 nuvar = 16
240
241
242
243 uparam(1) = young
244 uparam(2) = nu
245 uparam(3) = g
246 uparam(4) = g2
247 uparam(5) = lam
248 uparam(6) = bulk
249
250 uparam(7) = ft
251 uparam(8) = fc
252 uparam(9) = ecc
253 uparam(10) = m0
254 uparam(11) = qh0
255 uparam(12) = hp
256 uparam(13) = ah
257 uparam(14) = bh
258 uparam(15) = ch
259 uparam(16) = dh
260
261 uparam(17) = as
262 uparam(18) = bs
263 uparam(19) = df
264 uparam(20) = dflag
265 uparam(21) = dtype
266 uparam(22) = ireg
267 uparam(23) = wf
268 uparam(24) = wf1
269 uparam(25) = ft1
270 uparam(26) = efc
271
272 uparam(27) = irate
273 uparam(28) = epst0
274 uparam(29) = epstmax
275 uparam(30) = deltas
276 uparam(31) = betas
277 uparam(32) = epsc0
278 uparam(33) = epscmax
279 uparam(34) = alphas
280 uparam(35) = gammas
281
282 uparam(36) = idel
283
284
285 parmat(1) = bulk
286 parmat(2) = young
287 parmat(3) = nu
288 parmat(4) = israte
289 parmat(5) = asrate
290
291
292 pm(1) = rho0
293 pm(89) = rho0
294 pm(27) = sqrt((bulk + four_over_3*g)/rho0)
295 pm(100)= bulk
296
297
298 mtag%G_PLA = 1
299 mtag%L_PLA = 1
300 mtag%G_EPSD = 1
301 mtag%L_EPSD = 1
302
303
304
305 matparam%NMOD = 2
306
307
308
309 mtag%G_DMG = 1 + matparam%NMOD
310 mtag%L_DMG = 1 + matparam%NMOD
311
312 ALLOCATE(matparam%MODE(matparam%NMOD))
313 matparam%MODE(1) = "Tension damage"
314 matparam%MODE(2) = "Compression damage"
315
320
321
323
324
325
326
327 WRITE(iout,1000) trim(titr),mat_id,ilaw
328 WRITE(iout,1100)
329 IF (is_encrypted) THEN
330 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
331 ELSE
332 WRITE(iout,1200) rho0
333 WRITE(iout,1300) young,nu
334 WRITE(iout,1400) irate
335 IF (irate > 0) WRITE(iout,1500) asrate
336 WRITE(iout,1600) ecc,qh0,ft,fc,hp
337 WRITE(iout,1700) ah,bh,ch,dh
338 WRITE(iout,1800) as,df,bs
339 WRITE(iout,1900) dflag
340 WRITE(iout,2000) dtype
341 WRITE(iout,2100) ireg
342 WRITE(iout,2200) wf,wf1,ft1,efc
343 WRITE(iout,2300) idel
344 ENDIF
345
346 1000 FORMAT(/
347 & 5x,a,/,
348 & 5x,'MATERIAL NUMBER. . . . . . . . . . . . =',i10/,
349 & 5x,'MATERIAL LAW . . . . . . . . . . . . . =',i10/)
350 1100 FORMAT(
351 & 5x,'-----------------------------------------------------------',/
352 & 5x,' CONCRETE DAMAGE PLASTICITY MODEL 2 ',/,
353 & 5x,'-----------------------------------------------------------',/)
354 1200 FORMAT(
355 & 5x,'INITIAL DENSITY . . . . . . . . . . . . . . . . . . . . . . .=',1pg20.13/)
356 1300 FORMAT(
357 & 5x,'YOUNG (YOUNG MODULUS) . . . . . . . . . . . . . . . . . . . .=',1pg20.13/
358 & 5x,'nu(poisson ratio). . . . . . . . . . . . . . . . . . . . . .=',1PG20.13/)
359 1400 FORMAT(
360 & 5X,'strain rate effect flag irate . . . . . . . . . . . . . . . .=',I3/
361 & 5X,' 1: no strain rate effect(default) '/
362 & 5X,' 2: strain rate effect activated '/)
363 1500 FORMAT(
364 & 5X,'strain rate filtering cutoff frequency. . . . . . . . . . . .=',1PG20.13/)
365 1600 FORMAT(
366 & 5X,'ecc(eccentricity). . . . . . . . . . . . . . . . . . . . . .=',1PG20.13/
367 & 5X,'qh0(initial hardening) . . . . . . . . . . . . . . . . . . .=',1PG20.13/
368 & 5X,'ft(uniaxial tension strength) . . . . . . . . . . . . . . .=',1PG20.13/
369 & 5X,'fc(uniaxial compression strength) . . . . . . . . . . . . .=',1PG20.13/
370 & 5X,'hp(hardening modulus) . . . . . . . . . . . . . . . . . . .',1PG20.13/)
371 1700 FORMAT(
372 & 5X,'ah (hardening ductility param 1) . . . . . . . . . . . . . .=',1PG20.13/
373 & 5X,'bh(hardening ductility param 2) . . . . . . . . . . . . . .=',1PG20.13/
374 & 5X,'ch(hardening ductility param 3) . . . . . . . . . . . . . .=',1PG20.13/
375 & 5X,'dh(hardening ductility param 4) . . . . . . . . . . . . . .=',1PG20.13/)
376 1800 FORMAT(
377 & 5X,'as (damage ductility measure). . . . . . . . . . . . . . . .=',1PG20.13/
378 & 5X,'df(dilation constant) . . . . . . . . . . . . . . . . . . .=',1PG20.13/
379 & 5X,'bs(damage ductility PARAMETER). . . . . . . . . . . . . . .=',1PG20.13/)
380 1900 FORMAT(
381 & 5X,'dflag(damage flag) . . . . . . . . . . . . . . . . . . . . .=',I3/
382 & 5X,' 1: standard model with two damage variables(default) ',/
383 & 5X,' 2: isotropic model with one damage variable ',/
384 & 5X,' 3: multiplicative model with two damage variables ',/
385 & 5X,' 4: no damage effect ',/)
386 2000 FORMAT(
387 & 5X,'dtype(tension damage shape) . . . . . . . . . . . . . . . .=',I3/
388 & 5X,' 1: linear softening ',/
389 & 5X,' 2: bilinear softening(default) ',/
390 & 5X,' 3: exponential softening ',/)
391 2100 FORMAT(
392 & 5X,'element length regularization flag. . . . . . . . . . . . . .=',I3/
393 & 5X,' 1: no regularization ',/
394 & 5X,' 2: regularization activated(default) ',/)
395 2200 FORMAT(
396 & 5X,'wf(damage displacement threshold 0) . . . . . . . . . . . .=',1PG20.13/
397 & 5X,'wf1(damage displacement threshold 1) . . . . . . . . . . . .=',1PG20.13/
398 & 5X,'ft1(uniaxial stress threshold 1) . . . . . . . . . . . . . .=',1PG20.13/
399 & 5X,'efc(strain threshold in compression) . . . . . . . . . . . .=',1PG20.13/)
400 2300 FORMAT(
401 & 5X,'element deletion flag. . . . . . .. . . . . . . . . . . . . .=',I3/
402 & 5X,' 1: no element deletion(default) ',/
403 & 5X,' 2: element deletion activated ',/)
404
subroutine hm_get_floatv(name, rval, 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)