C NSLIP -- number of slip systems in each set (INPUT)
C NSLPTL -- total number of slip systems in all the sets (INPUT) C NSET -- number of sets of slip systems (INPUT) C
C PROP -- material constants characterizing the initial value of C current strength (INPUT) C
C For Asaro, Pierce et al's law
C PROP(1,i) -- initial hardening modulus H0 in the ith C set of slip systems
C PROP(2,i) -- saturation stress TAUs in the ith set of C slip systems
C PROP(3,i) -- initial critical resolved shear stress C TAU0 in the ith set of slip systems C
C For Bassani's 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
ID=0
DO I=1,NSET ISET=I
DO J=1,NSLIP(I) ID=ID+1
GSLIP0(ID)=GSLP0(NSLPTL,NSET,NSLIP,PROP(1,I),ID,ISET) END DO END DO
RETURN END
C----------------------------------
C----- Use single precision on cray C
REAL*8 FUNCTION GSLP0(NSLPTL,NSET,NSLIP,PROP,ISLIP,ISET)
C----- User-supplied function subprogram given the initial value of C current strength at initial state
C----- Use single precision on cray C
IMPLICIT REAL*8 (A-H,O-Z)
DIMENSION NSLIP(NSET), PROP(16)
GSLP0=PROP(3)
RETURN END
C----------------------------------------------------------------------
SUBROUTINE STRAINRATE (GAMMA, TAUSLP, GSLIP, NSLIP, FSLIP, 2 DFDXSP, PROP)
C----- This subroutine calculates the shear strain-rate in each slip
C system for a rate-dependent single crystal. The POWER LAW C relation between shear strain-rate and resolved shear stress C proposed by Hutchinson, Pan and Rice, is used here.
C----- The power law exponents are assumed the same for all slip C systems in each set, though they could be different from set to C set, e.g. <110>{111} and <110>{100}. The strain-rate coefficient C in front of the power law form are also assumed the same for all C slip systems in each set.
C----- Users who want to use their own constitutive relation may C change the function subprograms F and its derivative DFDX, C where F is the strain hardening law, dGAMMA/dt = F(X),
C X=TAUSLP/GSLIP. The parameters characterizing F are passed into C F and DFDX through array PROP.
C----- Function subprograms: C
C F -- User-supplied function subprogram which gives shear C strain-rate for each slip system based on current C values of resolved shear stress and current strength C
C DFDX -- User-supplied function subprogram dF/dX, where x is the C ratio of resolved shear stress over current strength
C----- Variables: C
C GAMMA -- shear strain in each slip system at the start of time C step (INPUT)
C TAUSLP -- resolved shear stress in each slip system (INPUT) C GSLIP -- current strength (INPUT)
C NSLIP -- number of slip systems in this set (INPUT) C
C FSLIP -- current value of F for each slip system (OUTPUT)
C DFDXSP -- current value of DFDX for each slip system (OUTPUT) C
C PROP -- material constants characterizing the strain hardening C law (INPUT) C
C For the current power law strain hardening law C PROP(1) -- power law hardening exponent
C PROP(1) = infinity corresponds to a rate-independent C material
C PROP(2) -- coefficient in front of power law hardening
C----- Use single precision on cray C
IMPLICIT REAL*8 (A-H,O-Z) EXTERNAL F, DFDX
DIMENSION GAMMA(NSLIP), TAUSLP(NSLIP), GSLIP(NSLIP), 2 FSLIP(NSLIP), DFDXSP(NSLIP), PROP(8)
DO I=1,NSLIP
X=TAUSLP(I)/GSLIP(I) FSLIP(I)=F(X,PROP)
DFDXSP(I)=DFDX(X,PROP) END DO
RETURN END
C-----------------------------------
C----- Use single precision on cray C
REAL*8 FUNCTION F(X,PROP)
C----- User-supplied function subprogram which gives shear C strain-rate for each slip system based on current values of C resolved shear stress and current strength C
C----- Use single precision on cray C
IMPLICIT REAL*8 (A-H,O-Z) DIMENSION PROP(8)
F=PROP(2)*(ABS(X))**PROP(1)*DSIGN(1.D0,X)
RETURN END
C-----------------------------------
C----- Use single precision on cray C
REAL*8 FUNCTION DFDX(X,PROP)
C----- User-supplied function subprogram dF/dX, where x is the C ratio of resolved shear stress over current strength
C----- Use single precision on cray C
IMPLICIT REAL*8 (A-H,O-Z) DIMENSION PROP(8)
DFDX=PROP(1)*PROP(2)*(ABS(X))**(PROP(1)-1.)
RETURN END
C----------------------------------------------------------------------
CFIXA
SUBROUTINE LATENTHARDEN (GAMMA, TAUSLP, GSLIP, GMSLTL, GAMTOL,