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,
DIMENSION(NPROPM) ,
INTENT(INOUT) :: pm
86 my_real,
DIMENSION(100) ,
INTENT(INOUT) :: parmat
87 my_real,
DIMENSION(MAXUPARAM) ,
INTENT(INOUT) :: uparam
88 INTEGER, DIMENSION(MAXFUNC) ,INTENT(INOUT) :: IFUNC
89 INTEGER, INTENT(INOUT) :: MFUNC,NUPARAM,NUVAR
90 TYPE(MLAW_TAG_),INTENT(INOUT) :: MTAG
91 INTEGER,INTENT(IN) :: ID,MAXFUNC,MAXUPARAM
92 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
93 TYPE(),INTENT(IN) :: LSUBMODEL(*)
94 TYPE(MATPARAM_STRUCT_) ,INTENT(INOUT) :: MATPARAM
95
96
97
98 INTEGER :: NBMAT, MAT_ID
99 INTEGER :: I,J,IU,NC,NT,VP,ILAW,ISRATE,IRATE
100 my_real :: e,ec,nu,g,cp,epsp0,sigy,rho0,rhor,
101 . fisokin,yfac_unit,fcut,pc,pt,c1,rpct
102 my_real :: rate(maxfunc+1),yfac(maxfunc+1)
103 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
104
105
106
107 rate(1) = 0
108 is_encrypted = .false.
109 is_available = .false.
110 ilaw = 66
111
112 nc = 0
113 nt = 0
114 epsp0 = ep20
115 cp = one
116 vp = 0
117 sigy = zero
118
119
120
122
123
124 CALL hm_get_floatv(
'MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
125 CALL hm_get_floatv(
'Refer_Rho' ,rhor ,is_available, lsubmodel, unitab)
126
127
128 CALL hm_get_floatv(
'MAT_E' ,e ,is_available, lsubmodel, unitab)
129 CALL hm_get_floatv(
'MAT_NU' ,nu ,is_available, lsubmodel, unitab)
130 CALL hm_get_floatv(
'MAT_HARD' ,fisokin ,is_available, lsubmodel, unitab)
131 CALL hm_get_floatv(
'MAT_asrate' ,fcut ,is_available, lsubmodel, unitab
133 CALL hm_get_intv (
'ISRATE' ,irate ,is_available,lsubmodel)
134
135
136 CALL hm_get_floatv(
'MAT_PC' ,pc ,is_available, lsubmodel, unitab)
137 CALL hm_get_floatv(
'MAT_PT' ,pt ,is_available, lsubmodel, unitab)
138 CALL hm_get_floatv(
'MAT_EC' ,ec ,is_available, lsubmodel, unitab)
139 CALL hm_get_floatv(
'MAT_RPCT' ,rpct ,is_available, lsubmodel, unitab)
140
141
142 IF(irate == 0) irate = 1
143
144 IF(irate < = 3) THEN
145 CALL hm_get_intv (
'FUN_A1' ,ifunc(1) ,is_available,lsubmodel)
146 CALL hm_get_intv (
'FUN_A2' ,ifunc(2) ,is_available,lsubmodel)
147 CALL hm_get_floatv(
'FScale11' ,yfac(1) ,is_available, lsubmodel, unitab)
149 mfunc = 2
150
152 rate(1) = zero
153 IF(yfac(1) == zero) yfac(1)= yfac_unit
155 IF(yfac(2) == zero) yfac(2)= yfac_unit
156 rate(2) = zero
157 ENDIF
158
159 IF(irate < = 2) THEN
160 CALL hm_get_floatv('epsilon_0
' ,EPSP0 ,IS_AVAILABLE, LSUBMODEL, UNITAB)
161 CALL HM_GET_FLOATV('mat_c0' ,CP ,IS_AVAILABLE, LSUBMODEL, UNITAB)
162 CALL HM_GET_FLOATV('sigma_r' ,SIGY ,IS_AVAILABLE, LSUBMODEL, UNITAB)
163 CALL HM_GET_INTV ('vp' ,VP ,IS_AVAILABLE,LSUBMODEL)
164
165.AND. IF(EPSP0 == ZERO CP == ZERO)EPSP0 = EP20
166 IF(EPSP0 == ZERO) EPSP0 = ONE !!!
167
168
169 ELSEIF(IRATE == 3) THEN
170 CALL HM_GET_INTV ('fun_b1' ,IFUNC(3) ,IS_AVAILABLE,LSUBMODEL)
171 CALL HM_GET_INTV ('fun_b2' ,IFUNC(4) ,IS_AVAILABLE,LSUBMODEL)
172 CALL HM_GET_FLOATV('fscale33' ,YFAC(3) ,IS_AVAILABLE, LSUBMODEL, UNITAB)
173 CALL HM_GET_FLOATV('fscale12' ,YFAC(4) ,IS_AVAILABLE, LSUBMODEL, UNITAB)
174 MFUNC = 4
175 DO I=1,MFUNC
176 RATE(I) = ZERO
177 ENDDO
178
179 CALL HM_GET_FLOATV_DIM('fscale33' ,YFAC_UNIT ,IS_AVAILABLE, LSUBMODEL, UNITAB)
180 IF(YFAC(3) == ZERO) YFAC(3)= YFAC_UNIT
181 CALL HM_GET_FLOATV_DIM('fscale12' ,YFAC_UNIT ,IS_AVAILABLE, LSUBMODEL, UNITAB)
182 IF(YFAC(4) == ZERO) YFAC(4)= YFAC_UNIT
183
184 ELSEIF(IRATE == 4) THEN
185 CALL HM_GET_INTV ('nfunc' ,NC ,IS_AVAILABLE,LSUBMODEL)
186 CALL HM_GET_INTV ('tfunc' ,NT ,IS_AVAILABLE,LSUBMODEL)
187 DO I= 1,NC
188 CALL HM_GET_INT_ARRAY_INDEX('abg_ipt' ,IFUNC(I) ,I,IS_AVAILABLE, LSUBMODEL)
189 CALL HM_GET_FLOAT_ARRAY_INDEX('fp1' ,YFAC(I) ,I,IS_AVAILABLE, LSUBMODEL, UNITAB)
190 CALL HM_GET_FLOAT_ARRAY_INDEX('k_a1' ,RATE(I) ,I,IS_AVAILABLE, LSUBMODEL, UNITAB)
191
192 CALL HM_GET_FLOAT_ARRAY_INDEX_DIM('fp1' ,YFAC_UNIT ,I,IS_AVAILABLE, LSUBMODEL, UNITAB)
193 IF(YFAC(I) == ZERO) YFAC(I) = YFAC_UNIT
194 ENDDO
195
196 IF (NC == 1) THEN
197 NC = NC +1
198 IFUNC(2) = IFUNC(1)
199 RATE(1) = ZERO
200 RATE(2) = ONE
201 YFAC(2) = YFAC(1)
202 ELSEIF(RATE(1) /= ZERO)THEN
203 NC = NC + 1
204 DO J=NC,1,-1
205 IFUNC(J+1)=IFUNC(J)
206 RATE(J+1) =RATE(J)
207 YFAC(J+1) =YFAC(J)
208 ENDDO
209 RATE(1)=ZERO
210 ENDIF
211
212 DO I= 1,NT
213 CALL HM_GET_INT_ARRAY_INDEX('abg_ipdel',IFUNC(NC + I) ,I,IS_AVAILABLE, LSUBMODEL)
214 CALL HM_GET_FLOAT_ARRAY_INDEX('fp2' ,YFAC(NC + I) ,I,IS_AVAILABLE, LSUBMODEL, UNITAB)
215 CALL HM_GET_FLOAT_ARRAY_INDEX('k_b1' ,RATE(NC + I) ,I,IS_AVAILABLE, LSUBMODEL, UNITAB)
216
217 CALL HM_GET_FLOAT_ARRAY_INDEX_DIM('fp2' ,YFAC_UNIT ,I,IS_AVAILABLE, LSUBMODEL, UNITAB)
218 IF(YFAC(NC + I) == ZERO) YFAC(NC + I) = YFAC_UNIT
219 ENDDO
220 IF (NT == 1) THEN
221 NT = NT +1
222 IFUNC(NC + 2) = IFUNC(NC + 1)
223 RATE(NC + 2) = ONE
224 RATE(NC + 1) = ZERO
225 YFAC(NC + 2) = YFAC(NC + 1)
226 ELSEIF(RATE(NC + 1) /= ZERO)THEN
227 NT = NT + 1
228 DO J=NT,1,-1
229 IFUNC(NC + J + 1) = IFUNC(NC + J)
230 RATE(NC + J + 1) = RATE(NC + J)
231 YFAC(NC + J + 1) = YFAC(NC + J)
232 ENDDO
233 RATE(NC + 1)=ZERO
234 ENDIF
235 MFUNC = NC + NT
236
237 DO I=1,NC-1
238 IF(RATE(I) > RATE(I+1))THEN
239 CALL ANCMSG(MSGID=478,
240 . MSGTYPE=MSGERROR,
241 . ANMODE=ANINFO_BLIND_1,
242 . I1=ID,
243 . C1=TITR)
244 GOTO 100
245 ENDIF
246 ENDDO
247 100 CONTINUE
248
249 DO I=1,NT-1
250 IF(RATE(NC+I) >= RATE(NC+I+1))THEN
251 CALL ANCMSG(MSGID=478,
252 . MSGTYPE=MSGERROR,
253 . ANMODE=ANINFO_BLIND_1,
254 . I1=ID,
255 . C1=TITR)
256 GOTO 200
257 ENDIF
258 ENDDO
259 200 CONTINUE
260
261 ENDIF ! IRATE
262
263
264
265 RHOR=RHO0
266 IF(RHOR==ZERO)RHOR=RHO0
267 PM(1) =RHOR
268 PM(89)=RHO0
269
270 DO I=1,MFUNC
271 IF(IFUNC(I) == 0)THEN
272 CALL ANCMSG(MSGID=126,
273 . MSGTYPE=MSGERROR,
274 . ANMODE=ANINFO,
275 . I1=ID,
276 . C1=TITR,
277 . I2=IFUNC(I))
278 ENDIF
279 ENDDO
280
281 IF(NU == HALF)NU=ZEP499
282.AND. IF(CP == ZERO IRATE == 1) CP = ONE
283 IF(IRATE == 1 ) CP = ONE/CP
284 G = HALF*E/( ONE + NU)
285
286
287 UPARAM(1) = IRATE
288 UPARAM(2) = E
289 UPARAM(3) = E/(ONE - NU*NU)
290 UPARAM(4) = NU*UPARAM(3)
291 UPARAM(5) = G
292 UPARAM(6) = NU
293 UPARAM(7) = PC
294 UPARAM(8) = PT
295 UPARAM(9) = EPSP0
296 UPARAM(10) = CP
297 UPARAM(11) = NC
298 UPARAM(12) = NT
299 UPARAM(13) = FISOKIN
300 DO I= 1,MFUNC
301 UPARAM(13+I) = YFAC(I)
302 UPARAM(13+I+MFUNC) = RATE(I)
303 ENDDO
304
305 UPARAM(14 + 2*MFUNC) = SIGY
306 UPARAM(15 + 2*MFUNC) = VP
307 UPARAM(16 + 2*MFUNC) = EC
308 UPARAM(17 + 2*MFUNC) = RPCT
309 NUPARAM = 17 + 2*MFUNC
310
311 C1=E/THREE/(ONE - TWO*NU)
312
313 PARMAT(1) = C1
314 PARMAT(2) = E
315 PARMAT(3) = NU
316 PARMAT(4) = ISRATE
317 PARMAT(5) = FCUT
318
319 NUVAR = 7 + MFUNC
320
321 MTAG%G_EPSD = 1
322 MTAG%L_EPSD = 1
323 MTAG%G_PLA = 1
324 MTAG%L_PLA = 1
325
326 ! Properties compatibility
327 CALL INIT_MAT_KEYWORD(MATPARAM,"SHELL_ISOTROPIC")
328 CALL INIT_MAT_KEYWORD(MATPARAM,"SOLID_ISOTROPIC")
329 CALL INIT_MAT_KEYWORD(MATPARAM,"SPH")
330
331
332 WRITE(IOUT,1001) TRIM(TITR),ID,ILAW
333 WRITE(IOUT,1000)
334 IF(IS_ENCRYPTED)THEN
335 WRITE(IOUT,'(5x,a')'confidential data'
336 ELSE
337 WRITE(IOUT,1002) RHO0
338 WRITE(IOUT,1100) E,EC,NU,PC,PT,RPCT,FISOKIN,ISRATE,FCUT
339 WRITE(IOUT,1200) IRATE
340 IF(IRATE <= 2) THEN
341 WRITE(IOUT,1300) IFUNC(1),YFAC(1)
342 write(IOUT,1400) IFUNC(2),YFAC(2)
343 write(IOUT,1500) EPSP0
344 IF (IRATE == 1) THEN
345 WRITE(IOUT,1510) CP
346 ELSE
347 WRITE(IOUT,1520) CP
348 ENDIF
349 write(IOUT,1530) VP,SIGY
350 ELSEIF(IRATE == 3) THEN
351 WRITE(IOUT,1300) IFUNC(1),YFAC(1)
352 write(IOUT,1400) IFUNC(2),YFAC(2)
353 write(IOUT,1600) IFUNC(3),YFAC(3)
354 WRITE(IOUT,1700) IFUNC(4),YFAC(4)
355 ELSE
356 DO I=1,NC
357 WRITE(IOUT,2000) IFUNC(I),YFAC(I),RATE(I)
358 ENDDO
359 DO I=1,NT
360 WRITE(IOUT,3000) IFUNC(I+NC),YFAC(I+NC),RATE(I+NC)
361 ENDDO
362 ENDIF
363 ENDIF
364
365
366 1000 FORMAT(
367 & 5X,' tabulated tension-compression plastic law
',/,
368 & 5X,' ----------------------------- ' ,//)
369 1001 FORMAT(/
370 & 5X,A,/,
371 & 5X,'material number. . . . . . . . . . . . =',I10/,
372 & 5X,'material law . . . . . . . . . . . . . =',I10/)
373 1002 FORMAT(
374 & 5X,'initial density. . . . . . . . . . . . =',1PG20.13/)
375 1100 FORMAT(
376 & 5X,'young''s modulus. . . . . . . . . . .',1PG20.13/
377 & 5X,'young''s modulus in compression . . . . .=',1PG20.13/
378 & 5X,'poisson''s ratio. . . . . . . . . . . . .=',1PG20.13/
379 & 5X,'compression mean stress. . . . . . . . .=',1PG20.13/
380 & 5X,'traction mean stress . . . . . . . . . .=',1PG20.13/
381 & 5X,'fraction of mean stresses . . . . . . . .=',1PG20.13/
382 & 5X,'iso-kinematic hardenning factor . . . . .=',1PG20.13/
383 & 5X,'smooth strain rate option . . . . . . . .=',I10/
384 & 5X,'strain rate cutting frequency . . . . . .=',1PG20.13/)
385 1200 FORMAT(
386 & 5X,'strain rate formulation option . . . . .=', I10/)
387 1300 FORMAT(
388 & 5X,'compression yield stress FUNCTION number.=',I10/
389 & 5X,'yield scale factor. . . . . . . . . . . .=',1PG20.13)
390 1400 FORMAT(
391 & 5X,'traction yield stress function number . .=',I10/
392 & 5X,'yield scale factor. . . . . . . . . . . .=',1PG20.13)
393 1500 FORMAT(
394 & 5X,'reference strain rate . . . . . . . . . .=',1PG20.13)
395 1510 FORMAT(
396 & 5X,'strain rate parameter 1/c . . . . . . . .=',1PG20.13)
397 1520 FORMAT(
398 & 5X,'strain rate parameter c . . . . . . . . .=',1PG20.13)
399 1530 FORMAT(
400 & 5X,'optional strain rate effect : . . . . . .=',I10/,
401 & 5X,' 0 : strain rate effect is activated ',/,
402 & 5X,' 1 : viscplastic option is activated ',/,
403 & 5X,'optional initial yield stress . . . . . .=',1PG20.13/)
404 1600 FORMAT(
405 & 5X,
406 . 'compression strain rate scaling effect function number .=',I10/
407 & 5X,'scale factor. . . . . . . . . . . . . . .=',1PG20.13)
408
409 1700 FORMAT(
410 & 5X,
411 . 'traction strain rate scaling effect function number . . .=',I10/
412 & 5X,'scale factor. . . . . . . . . . . . . . .=',1pg20.13)
413 2000 FORMAT(
414 & 5x,'COMPRESSION YIELD STRESS FUNCTION NUMBER.=',i10/
415 & 5x,' YIELD SCALE FACTOR. . . . . .=',1pg20.13/
416 & 5x,'STRAIN RATE. . . . . . . . . .=',1pg20.13)
417 3000 FORMAT(
418 & 5x,'TRACTION YIELD STRESS FUNCTION NUMBER . .=',i10/
419 & 5x,'YIELD SCALE FACTOR. . . . . . . . . . . .=',1pg20.13/
420 & 5x,'STRAIN RATE . . . . . . . . . . . . . . .=',1pg20.13)
421
422 RETURN
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)
integer, parameter nchartitle
subroutine tabulated(iflag, nel, pm, off, eint, mu, espe, dvol, df, vnew, mat, psh, pnew, dpdm, dpde, npf, tf)