C PROP(10,i)-- ratio of latent-hardening from other sets C of slip systems to self-hardening in the C ith set of slip systems Q1 C
C For Bassani's hardening law
C PROP(1,i) -- initial hardening modulus H0 in the ith C set of slip systems
C PROP(2,i) -- stage I stress TAUI in the ith set of
C slip systems (or the breakthrough stress C where large plastic flow initiates) C PROP(3,i) -- initial critical resolved shear stress C TAU0 in the ith set of slip systems
C PROP(4,i) -- hardening modulus during easy glide Hs in C the ith set of slip systems
C PROP(5,i) -- amount of slip Gamma0 after which a given C interaction between slip systems in the C ith set reaches peak strength
C PROP(6,i) -- amount of slip Gamma0 after which a given C interaction between slip systems in the C ith set and jth set (i not equal j) C reaches peak strength
C PROP(7,i) -- representing the magnitude of the strength C of interaction in the ith set of slip C system
C PROP(8,i) -- representing the magnitude of the strength C of interaction between the ith set and jth C set of system
C PROP(9,i) -- ratio of latent to self-hardening Q in the C ith set of slip systems
C PROP(10,i)-- ratio of latent-hardening from other sets C of slip systems to self-hardening in the C ith set of slip systems Q1 C
C----- Arrays for iteration: C
C DGAMOD (INPUT) C
C DHDGDG (OUTPUT) C
C----- Use single precision on cray C
IMPLICIT REAL*8 (A-H,O-Z) EXTERNAL DHSELF, DHLATN
CFIXA
DIMENSION GAMMA(NSLPTL), TAUSLP(NSLPTL), GMSLTL(NSLPTL), 2 GSLIP(NSLPTL), NSLIP(NSET), PROP(16,NSET), 3 DGAMOD(NSLPTL), DHDGDG(ND,NSLPTL) CFIXB
CHECK=0. DO I=1,NSET DO J=4,8
CHECK=CHECK+ABS(PROP(J,I)) END DO END DO
C----- CHECK=0 -- HYPER SECANT hardening law C otherwise -- Bassani's hardening law
ISELF=0
DO I=1,NSET ISET=I
DO J=1,NSLIP(I) ISELF=ISELF+1
DO KDERIV=1,NSLPTL
DHDGDG(ISELF,KDERIV)=0.
DO LATENT=1,NSLPTL
IF (LATENT.EQ.ISELF) THEN CFIXA
DHDG=DHSELF(GAMMA,GMSLTL,GAMTOL,NSLPTL,NSET, 2 NSLIP,PROP(1,I),CHECK,ISELF,ISET, 3 KDERIV) CFIXB
ELSE CFIXA
DHDG=DHLATN(GAMMA,GMSLTL,GAMTOL,NSLPTL,NSET, 2 NSLIP,PROP(1,I),CHECK,ISELF,ISET, 3 LATENT,KDERIV) CFIXB
END IF
DHDGDG(ISELF,KDERIV)=DHDGDG(ISELF,KDERIV)+ 2 DHDG*ABS(DGAMOD(LATENT)) END DO
END DO END DO END DO
RETURN END
C-----------------------------------
C----- Use single precision on cray CFIXA
REAL*8 FUNCTION DHSELF(GAMMA,GMSLTL,GAMTOL,NSLPTL,NSET, 2 NSLIP,PROP,CHECK,ISELF,ISET, 3 KDERIV) CFIXB
C----- User-supplied function of the derivative of self-hardening C moduli
C----- Use single precision on cray C
IMPLICIT REAL*8 (A-H,O-Z) CFIXA
DIMENSION GAMMA(NSLPTL), GMSLTL(NSLPTL), 2 NSLIP(NSET), PROP(16) CFIXB
IF (CHECK.EQ.0.) THEN
C----- HYPER SECANT hardening law by Asaro, Pierce et al
TERM1=PROP(1)*GAMTOL/(PROP(2)-PROP(3)) TERM2=2.*EXP(-TERM1)/(1.+EXP(-2.*TERM1))
TERM3=PROP(1)/(PROP(2)-PROP(3))*DSIGN(1.D0,GAMMA(KDERIV)) DHSELF=-2.*PROP(1)*TERM2**2*TANH(TERM1)*TERM3
ELSE
C----- Bassani's hardening law CFIXA
TERM1=(PROP(1)-PROP(4))*GMSLTL(ISELF)/(PROP(2)-PROP(3)) CFIXB
TERM2=2.*EXP(-TERM1)/(1.+EXP(-2.*TERM1))
TERM3=(PROP(1)-PROP(4))/(PROP(2)-PROP(3))
IF (KDERIV.EQ.ISELF) THEN
F=-2.*(PROP(1)-PROP(4))*TERM2**2*TANH(TERM1)*TERM3 ID=0 G=1.
DO I=1,NSET
IF (I.EQ.ISET) THEN GAMMA0=PROP(5) FAB=PROP(7) ELSE
GAMMA0=PROP(6) FAB=PROP(8) END IF
DO J=1,NSLIP(I) ID=ID+1 CFIXA
IF (ID.NE.ISELF) G=G+FAB*TANH(GMSLTL(ID)/GAMMA0) CFIXB
END DO END DO
ELSE
F=(PROP(1)-PROP(4))*TERM2**2+PROP(4) ILOWER=0
IUPPER=NSLIP(1) IF (ISET.GT.1) THEN DO K=2,ISET
ILOWER=ILOWER+NSLIP(K-1) IUPPER=IUPPER+NSLIP(K) END DO END IF
IF (KDERIV.GT.ILOWER.AND.KDERIV.LE.IUPPER) THEN GAMMA0=PROP(5) FAB=PROP(7) ELSE
GAMMA0=PROP(6) FAB=PROP(8) END IF
CFIXA
TERM4=GMSLTL(KDERIV)/GAMMA0