43 . MFUNC ,MAXFUNC ,MTAG ,PARMAT ,UNITAB ,
44 . IMATVIS ,PM ,LSUBMODEL, ID ,TITR ,
75#include "implicit_f.inc"
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
89 INTEGER,
INTENT(INOUT) :: MFUNC,NUPARAM,NUVAR,IMATVIS
90 INTEGER,
DIMENSION(MAXFUNC) ,
INTENT(INOUT) :: IFUNC
91 TYPE(MLAW_TAG_),
INTENT(INOUT) ::
92 INTEGER,
INTENT(IN) :: ID,MAXFUNC,MAXUPARAM
93 CHARACTER(LEN=NCHARTITLE) ,
INTENT(IN) :: TITR
95 TYPE(matparam_struct_) ,
INTENT(INOUT) :: MATPARAM
99 INTEGER :: NBMAT, MAT_ID
100 INTEGER :: I,J,NRATE,NPS,ILAW,NFUNC,ITEST,N_NETWORK, FLAG_HE, FLAG_MUL, EXPPL,
101 . FLAG_PL,NHYPER,NET,N,TAB,SHIFT,
102 . nmul,ntemp,nplas,nvisc(10),flag_visc(10)
103 my_real :: rho0, e,nu,g,rbulk,tauref_unit,
104 . c1,c2,c3,c4,c5,mu,lm,d,beta,facpl, scale1, scale2,scalefac,
105 . c10,c01,c20,c11,c02 ,fac_unit,fac_sm,fac_bm,
106 . c30, c21,c12,c03,sb,d1,d2,d3,ff,epshat,tauy ,
108 . expm(10),ksi(10),stiffn(10),b0(10),expn(10),tauref(10)
109 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
113 is_encrypted = .false.
114 is_available = .false.
123 CALL hm_get_floatv(
'MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
147 CALL hm_get_intv(
'MAT_N_net' , n_network, is_available, lsubmodel)
148 CALL hm_get_intv(
'MAT_Flag_HE', flag_he , is_available, lsubmodel)
149 CALL hm_get_intv(
'MAT_Flag_Cr', flag_pl , is_available, lsubmodel)
151 IF (n_network > 10 )
THEN
154 . anmode=aninfo_blind_2,
167 IF (flag_he == 1)
THEN
169 CALL hm_get_floatv(
'MAT_C_10' ,c10 ,is_available, lsubmodel, unitab)
170 CALL hm_get_floatv(
'MAT_C_01' ,c01 ,is_available, lsubmodel, unitab)
171 CALL hm_get_floatv(
'MAT_C_20' ,c20 ,is_available, lsubmodel, unitab)
172 CALL hm_get_floatv(
'MAT_C_11' ,c11 ,is_available, lsubmodel, unitab)
173 CALL hm_get_floatv(
'MAT_C_02' ,c02 ,is_available, lsubmodel, unitab)
175 CALL hm_get_floatv(
'MAT_C_30' ,c30 ,is_available, lsubmodel, unitab)
176 CALL hm_get_floatv(
'MAT_C_21' ,c21 ,is_available, lsubmodel, unitab)
177 CALL hm_get_floatv(
'MAT_C_12' ,c12 ,is_available, lsubmodel, unitab)
178 CALL hm_get_floatv(
'MAT_C_03' ,c03 ,is_available, lsubmodel, unitab)
180 CALL hm_get_floatv(
'MAT_D_1' ,d1 ,is_available, lsubmodel, unitab)
181 CALL hm_get_floatv(
'MAT_D_2' ,d2 ,is_available, lsubmodel, unitab)
182 CALL hm_get_floatv(
'MAT_D_3' ,d3 ,is_available, lsubmodel, unitab)
185 ELSEIF (flag_he == 2)
THEN
187 CALL hm_get_floatv(
'MAT_MUE1' ,mu ,is_available, lsubmodel, unitab)
188 CALL hm_get_floatv(
'MAT_D' ,d ,is_available, lsubmodel, unitab)
189 CALL hm_get_floatv(
'Lambda' ,lm ,is_available, lsubmodel, unitab)
191 CALL hm_get_intv (
'Itype' ,itest ,is_available, lsubmodel)
192 CALL hm_get_intv (
'MAT_fct_ID_AB' ,ifunc(1) ,is_available, lsubmodel)
193 CALL hm_get_floatv(
'MAT_NU' ,nu ,is_available, lsubmodel, unitab)
194 CALL hm_get_floatv(
'Fscale_AB' ,scalefac ,is_available, lsubmodel, unitab)
195 IF(scalefac == zero)
THEN
197 scalefac = one * fac_unit
199 IF(itest == 0) itest = 1
201 IF(ifunc(1) /= 0) nfunc = 1
203 ELSEIF (flag_he == 3)
THEN
205 CALL hm_get_floatv(
'MAT_C_10' ,c10 ,is_available, lsubmodel, unitab)
206 CALL hm_get_floatv(
'MAT_D_1' ,d1 ,is_available, lsubmodel, unitab)
209 ELSEIF (flag_he == 4)
THEN
211 CALL hm_get_floatv(
'MAT_C_10' ,c10 ,is_available, lsubmodel, unitab)
212 CALL hm_get_floatv(
'MAT_C_01' ,c01 ,is_available, lsubmodel, unitab)
213 CALL hm_get_floatv(
'MAT_D_1' ,d1 ,is_available, lsubmodel, unitab)
216 ELSEIF (flag_he == 5)
THEN
218 CALL hm_get_floatv(
'MAT_C_10' ,c10 ,is_available, lsubmodel, unitab)
219 CALL hm_get_floatv(
'MAT_C_20' ,c20 ,is_available, lsubmodel, unitab)
220 CALL hm_get_floatv(
'MAT_C_30' ,c30 ,is_available, lsubmodel, unitab)
221 CALL hm_get_floatv(
'MAT_D_1' ,d1 ,is_available, lsubmodel, unitab)
224 ELSEIF (flag_he == 13)
THEN
226 CALL hm_get_intv (
'MAT_fct_ID_SM' ,ifunc(1) ,is_available, lsubmodel)
227 CALL hm_get_intv (
'MAT_fct_ID_BM' ,ifunc(2) ,is_available, lsubmodel)
228 CALL hm_get_floatv(
'MAT_Fscale_SM' ,scale1 ,is_available, lsubmodel, unitab)
229 CALL hm_get_floatv(
'MAT_Fscale_BM' ,scale2 ,is_available, lsubmodel, unitab)
230 IF(scale1 == zero)
THEN
232 scale1 = one * fac_sm
234 IF(scale2 == zero)
THEN
236 scale2 = one * fac_bm
241 IF(ifunc(1)==0 .OR. ifunc(2)==0)
THEN
244 . anmode=aninfo_blind_2,
253 . anmode=aninfo_blind_2,
263 IF (flag_pl == 1)
THEN
266 CALL hm_get_floatv(
'MAT_Sigma_pl' ,tauy ,is_available, lsubmodel, unitab)
267 CALL hm_get_floatv(
'MAT_F_pl' ,ff ,is_available, lsubmodel, unitab)
269 CALL hm_get_intv (
'MAT_N_pl' ,exppl ,is_available, lsubmodel)
271 IF(exppl == 0) exppl=1
272 IF(facpl == zero) facpl=one
273 IF(epshat == zero) epshat=one
274 IF(ff == zero) ff=one
275 IF(tauy == zero) tauy = one
286 DO net = 1, n_network
291 IF (flag_visc(net) == 1)
THEN
300 IF(tauref(net) == zero)
THEN
302 tauref(net) = one * tauref_unit
307 ELSEIF (flag_visc(net) == 2)
THEN
315 ELSEIF (flag_visc(net) == 3)
THEN
324 . anmode=aninfo_blind_2,
332 nuvar = nuvar + shift
340 sb = sb + stiffn(net)
344 IF (flag_he == 1 .OR. flag_he == 3 .OR.flag_he == 4 .OR.flag_he == 5 )
THEN
346 IF(d2 /= zero ) d2 = one/d2
347 IF(d3 /= zero ) d3 = one/d3
348 g = two * (c10 + c01) *(sb + one)
351 rbulk= two*d1 *(one + sb)
352 nu = (three*rbulk -two*g)/(three*rbulk + g)/two
353 e = nine*rbulk*g/(three*rbulk + g)
358 rbulk = two_third*g*(one + nu)/(one-two*nu)
363 ELSEIF (flag_he == 2)
THEN
370 IF(d == zero ) d = em20
371 IF(lm == zero) lm = seven
373 g = mu*(one + three*beta /five + eighty19*beta*beta/175.
374 . + 513.*beta**3/875. + 42039.*beta**4/67375.)*(sb + one)
375 rbulk = two *(one + sb) /d
376 e = nine*rbulk*g/(three*rbulk + g)
377 IF(ifunc(1) == 0)
THEN
378 nu = (three*rbulk -two*g)/(three*rbulk + g)/two
381 IF (nu == zero) nu= 0.495
388 uparam(1) = n_network
401 IF (flag_he == 1 .OR. flag_he == 3 .OR.flag_he == 4 .OR.flag_he == 5 )
THEN
402 uparam(tab + 1) = c10
403 uparam(tab + 2) = c01
404 uparam(tab + 3) = c20
405 uparam(tab + 4) = c11
406 uparam(tab + 5) = c02
407 uparam(tab + 6) = c30
408 uparam(tab + 7) = c21
409 uparam(tab + 8) = c12
410 uparam(tab + 9) = c03
411 uparam(tab + 10) = d1
412 uparam(tab + 11) = d2
413 uparam(tab + 12) = d3
415 ELSEIF (flag_he == 2)
THEN
422 uparam(tab + 7) = one/d
423 uparam(tab + 8) = beta
424 uparam(tab + 9) = itest
426 uparam(tab +11) = scalefac
428 ELSEIF (flag_he == 13)
THEN
429 uparam(tab + 1) = scale1
430 uparam(tab + 2) = scale2
431 uparam(tab + 3) = nfunc
438 IF (flag_pl == 1)
THEN
441 uparam(tab + 2) = epshat
442 uparam(tab + 3) = tauy
443 uparam(tab + 4) = exppl
444 uparam(tab + 5) = facpl
450 uparam(tab + 1) = stiffn(n)
451 uparam(tab + 2) = flag_visc(n)
452 uparam(tab + 3) = nvisc(n)
453 IF (flag_visc(n) == 1)
THEN
454 IF(expm(n) == zero)expm(n) = one
455 IF(expc(n) == zero)expc(n) = -0.700000000
456 IF(ksi(n) == zero)ksi(n) = em02
457 uparam(tab + 4) = a(n)
458 uparam(tab + 5) = expc(n)
459 uparam(tab + 6) = expm(n)
460 uparam(tab + 7) = ksi(n)
461 uparam(tab + 8) = tauref(n)
462 tab = tab + 3 + nvisc(n)
464 ELSEIF (flag_visc(n) == 2)
THEN
465 uparam(tab + 4) = a(n)
466 uparam(tab + 5) = b0(n)
467 uparam(tab + 6) = expn(n)
468 tab = tab + 3 + nvisc(n)
469 ELSEIF (flag_visc(n) == 3)
THEN
470 uparam(tab + 4) = a(n)
471 uparam(tab + 5) = expn(n)
472 uparam(tab + 6) = expm(n)
473 tab = tab + 3 + nvisc(n)
476 IF (flag_he /= 13)
THEN
478 uparam(tab + 2) = rbulk
497 WRITE(iout,1001) trim(titr),id,100
499 IF (is_encrypted)
THEN
500 WRITE(iout,
'(5X,A,//)')
'CONFIDENTIAL DATA'
503 WRITE(iout,900)n_network, flag_he,flag_pl
504 IF (flag_he == 1)
THEN
505 WRITE(iout,1100)c10,c01,c20,c11,c02,
506 . c30, c21,c12,c03,d1,d2,d3
508 ELSEIF (flag_he == 2)
THEN
509 WRITE(iout,2000)mu,d, lm
510 IF(ifunc(1) > 0)
THEN
512 WRITE(iout,2200)ifunc(1),scalefac, nu
513 ELSEIF(itest == 2)
THEN
514 WRITE(iout,2300)ifunc(1),scalefac, nu
515 ELSEIF(itest == 3)
THEN
516 WRITE(iout,2400)ifunc(1),scalefac, nu
519 ELSEIF (flag_he == 3)
THEN
520 WRITE(iout,2001)c10,d1
521 ELSEIF (flag_he == 4)
THEN
522 WRITE(iout,2002)c10,c01,d1
523 ELSEIF (flag_he == 5)
THEN
524 WRITE(iout,2003)c10,c20,c30,d1
525 ELSEIF (flag_he == 13)
THEN
526 WRITE(iout,2005)ifunc(1),ifunc(2),scale1,scale2
528 IF (flag_pl == 1)
THEN
529 WRITE(iout,2004) facpl , tauy, exppl,ff,epshat
533 IF (flag_visc(n) == 1)
THEN
534 WRITE(iout,1300)stiffn(n),a(n),expc(n),expm(n),ksi(n) , tauref(n)
535 ELSEIF (flag_visc(n) == 2)
THEN
536 WRITE(iout,1400)stiffn(n),a(n),b0(n),expn(n)
537 ELSEIF (flag_visc(n) == 3)
THEN
538 WRITE(iout,1500)stiffn(n),a(n),expn(n),expm(n)
542 IF (flag_he /= 13)
THEN
543 WRITE(iout,1200)g,rbulk, nu
548 & 5x,
' PARALLEL RHEOLOGICAL FRAMEWORK : ',/,
549 & 5x,
' -------------------------------- ',/)
552 & 5x,
'MATERIAL NUMBER. . . . . . . . . . . . . =',i10/,
553 & 5x,
'MATERIAL LAW . . . . . . . . . . . . . . =',i10/)
555 & 5x,
'INITIAL DENSITY . . . . . . . . . . . . .=',1pg20.13/)
557 & 5x,
'NUMBER OF SECONDARY NETWORKS . . . . . .= ',i10/
558 & 5x,
'FLAG FOR HYPERELASTIC LAW. . . . . . . .= ',i10/
559 & 5x,
'FLAG FOR PLASTICITY. . . . . . . . . . .= ',i10)
561 & 5x,
'HYPERELASTIC MODEL = PPOLYNOMIAL ',/,
562 & 5x,
'C10 . . . . . . . . . . . . . . . . . . .=',1pg20.13/
563 & 5x,
'C01 . . . . . . . . . . . . . . . . . . .=',1pg20.13/
564 & 5x,
'C20 . . . . . . . . . . . . . . . . . . .=',1pg20.13/
565 & 5x,
'C11 . . . . . . . . . . . . . . . . . . .=',1pg20.13/
566 & 5x,
'C02 . . . . . . . . . . . . . . . . . . .=',1pg20.13/
567 & 5x,
'C30 . . . . . . . . . . . . . . . . . . .=',1pg20.13/
568 & 5x,
'C21 . . . . . . . . . . . . . . . . . . .=',1pg20.13/
569 & 5x,
'C12 . . . . . . . . . . . . . . . . . . .=',1pg20.13/
570 & 5x,
'C03 . . . . . . . . . . . . . . . . . . .=',1pg20.13/
571 & 5x,
'1/D1 . . . . . . . . . . . . . . . . . .=',1pg20.13/
572 & 5x,
'1/D2 . . . . . . . . . . . . . . . . . .=',1pg20.13/
573 & 5x,
'1/D3 . . . . . . . . . . . . . . . . . .=',1pg20.13/)
575 & 5x,
'HYPERELASTIC MODEL = ARRUDA-BOYCE ',/,
576 & 5x,
'MATERIAL CONSTANT MU . . . . . . . . . .=',1pg20.13/
577 & 5x,
'VOLUMETRIC MATERIAL PARAMETER. . . . . .=',1pg20.13/
578 & 5x,
'LOCKING STRETCH. . . . . . . . . . . . .=',1pg20.13//)
580 & 5x,
'UNIAXIAL DATA TEST CURVE . . . . . . .=',i10/
581 & 5x,
'SCALE FACTOR FOR STRESS IN FUNCTION. . .=',1pg20.13/
582 & 5x,
'POISSON RATIO. . . . . . . . . . . . . .=',1pg20.13//)
584 & 5x,
'EQUIBIAXIAL DATA TEST CURVE. . . . . . .=',i10/
585 & 5x,
'SCALE FACTOR FOR STRESS IN FUNCTION. . .=',1pg20.13/
586 & 5x,
'POISSON RATIO. . . . . . . . . . . . . .=',1pg20.13//)
588 & 5x,
'PLANAR DATA TEST CURVE . . . . . . . .=',i10/
589 & 5x,
'SCALE FACTOR FOR STRESS IN FUNCTION. . .=',1pg20.13/
590 & 5x,
'POISSON RATIO. . . . . . . . . . . . . .=',1pg20.13//)
592 & 5x,
'HYPERELASTIC MODEL = NEO-HOOKEAN ',/,
593 & 5x,
'C10 . . . . . . . . . . . . . . . . . . .=',1pg20.13/
594 & 5x,
'1/D1 . . . . . . . . . . . . . . . . . .=',1pg20.13//)
596 & 5x,
'HYPERELASTIC MODEL = MOONEY-RIVLIN ',/,
597 & 5x,
'C10 . . . . . . . . . . . . . . . . . . .=',1pg20.13/
598 & 5x,
'C01 . . . . . . . . . . . . . . . . . . .=',1pg20.13/
599 & 5x,
'1/D1 . . . . . . . . . . . . . . . . . .=',1pg20.13//)
601 & 5x,
'HYPERELASTIC MODEL = YEOH ',/,
602 & 5x,
'C10 . . . . . . . . . . . . . . . . . . .=',1pg20.13/
603 & 5x,
'C20 . . . . . . . . . . . . . . . . . . .=',1pg20.13/
604 & 5x,
'C30 . . . . . . . . . . . . . . . . . . .=',1pg20.13/
605 & 5x,
'1/D1 . . . . . . . . . . . . . . . . . .=',1pg20.13//)
607 & 5x,
'HYPERELASTIC MODEL = TEMPERATURE DEPENDENT NEO HOOK',/,
608 & 5x,
'FUNCTION ID FOR MU. . . . . . . . . . . .=',i10/
609 & 5x,
'FUNCTION ID FOR D . . . . . . . . . . . .=',i10/
610 & 5x,
'SCALE FACTOR FOR FUNCTION 1 . . . . . . .=',1pg20.13/
611 & 5x,
'SCALE FACTOR FOR FUNCTION 2 . . . . . . .=',1pg20.13//)
614 & 5x,
'PLASTICITY PARAMETERS IN EQUILIBRIUM NETWORK',/,
615 & 5x,
'A FACTOR. . . . . . . . . . . . . . . . .=',1pg20.13/
616 & 5x,
'FLOW RESISTANCE . . . . . . . . . . . . .=',1pg20.13/
617 & 5x,
'EXPONENT FOR FLOW RATE. . . . . . . . . .=',i10/
618 & 5x,
'FINAL FLOW RESISTANCE . . . . . . . . . .=',1pg20.13/
619 & 5x,
'CHARACTERISTIC STRAIN . . . . . . . . . .=',1pg20.13//)
621 & 5x,
'PARAMETERS FOR VISCOUS MODEL FOR NETWORK : ',i10)
623 & 5x,
'BERGSTROM BOYCE VISCOUS MODEL ',/,
624 & 5x,
'STIFFNESS SCALING COEFFICIENT. . . . . . =',1pg20.13/
625 & 5x,
'A. . . . . . . . . . . . . . . . . . . . =',1pg20.13/
626 & 5x,
'EXPONENT C . . . . . . . . . . . . . . . =',1pg20.13/
627 & 5x,
'EXPONENT M . . . . . . . . . . . . . . . =',1pg20.13/
628 & 5x,
'KSI. . . . . . . . . . . . . . . . . . . =',1pg20.13/
629 & 5x,
'REFERENCE STRESS . . . . . . . . . . . . =',1pg20.13)
631 & 5x,
'HYPERBOLIC SINE VISCOUS MODEL ',/,
632 & 5x,
'STIFFNESS SCALING COEFFICIENT. . . . . . =',1pg20.13/
633 & 5x,
'A. . . . . . . . . . . . . . . . . . . . =',1pg20.13/
634 & 5x,
'COEFFICIENT B0 . . . . . . . . . . . . . =',1pg20.13/
635 & 5x,
'EXPONENT N . . . . . . . . . . . . . . . =',1pg20.13/)
637 & 5x,
'POWER LAW VISCOUS MODEL ',/,
638 & 5x,
'STIFFNESS SCALING COEFFICIENT. . . . . . =',1pg20.13/
639 & 5x,
'A. . . . . . . . . . . . . . . . . . . . =',1pg20.13/
640 & 5x,
'EXPONENT N . . . . . . . . . . . . . . . =',1pg20.13/
641 & 5x,
'EXPONENT M . . . . . . . . . . . . . . . =',1pg20.13/)
643 & 5x,
'INITIAL SHEAR MODULUS . . . . . . . . . =',1pg20.13/
644 & 5x,
'INITIAL BULK MODULUS. . . . . . . . . . =',1pg20.13/
645 & 5x,
'POISSON RATIO . . . . . . . . . . . . . =',1pg20.13//)