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