2197 lines
68 KiB
Text
2197 lines
68 KiB
Text
|
SUBROUTINE VUMAT(NBLOCK, NDIR, NSHR, NSTATEV, NFIELDV, NPROPS,
|
||
|
* LANNEAL, STEPTIME, TOTALTIME, DT, CMNAME, COORDMP, CHARLENGTH,
|
||
|
* PROPS, DENSITY, STRAININC, RELSPININC, TEMPOLD, STRETCHOLD,
|
||
|
* DEFGRADOLD, FIELDOLD, STRESSOLD, STATEOLD, ENERINTERNOLD,
|
||
|
* ENERINELASOLD, TEMPNEW, STRETCHNEW, DEFGRADNEW, FIELDNEW,
|
||
|
C Write only variables -
|
||
|
* STRESSNEW, STATENEW, ENERINTERNNEW, ENERINELASNEW)
|
||
|
c
|
||
|
c
|
||
|
include 'vaba_param.inc'
|
||
|
|
||
|
|
||
|
C----- Use single precision on Cray by
|
||
|
C (1) deleting the statement "IMPLICIT*8 (A-H,O-Z)";
|
||
|
C (2) changing "REAL*8 FUNCTION" to "FUNCTION";
|
||
|
C (3) changing double precision functions DSIGN to SIGN.
|
||
|
|
||
|
C----- Subroutines:
|
||
|
C
|
||
|
C ROTATION -- forming rotation matrix, i.e. the direction
|
||
|
C cosines of cubic crystal [100], [010] and [001]
|
||
|
C directions in global system at the initial
|
||
|
C state
|
||
|
C
|
||
|
C SLIPSYS -- calculating number of slip systems, unit
|
||
|
C vectors in slip directions and unit normals to
|
||
|
C slip planes in a cubic crystal at the initial
|
||
|
C state
|
||
|
C
|
||
|
C GSLPINIT -- calculating initial value of current strengths
|
||
|
C at initial state
|
||
|
C
|
||
|
C STRAINRATE -- based on current values of resolved shear
|
||
|
C stresses and current strength, calculating
|
||
|
C shear strain-rates in slip systems
|
||
|
C
|
||
|
C LATENTHARDEN -- forming self- and latent-hardening matrix
|
||
|
C
|
||
|
C LUDCMP -- LU decomposition
|
||
|
C
|
||
|
C LUBKSB -- linear equation solver based on LU
|
||
|
C decomposition method (must call LUDCMP first)
|
||
|
|
||
|
|
||
|
C----- Function subprogram:
|
||
|
|
||
|
C F -- shear strain-rates in slip systems
|
||
|
|
||
|
|
||
|
C----- Variables:
|
||
|
C
|
||
|
C STRESSOLD -- stresses (INPUT)
|
||
|
C STRESSNEW -- stresses (OUTPUT)
|
||
|
C Cauchy stresses for finite deformation
|
||
|
C STATEOLD
|
||
|
C STATENEW -- solution dependent state variables (INPUT & OUTPUT)
|
||
|
|
||
|
C----- Variables passed in for information:
|
||
|
C
|
||
|
C STRAININC -- increments of strains
|
||
|
C CMNAME -- name given in the *MATERIAL option
|
||
|
C NDIR -- number of direct stress components
|
||
|
C NSHR -- number of engineering shear stress components
|
||
|
C NSTATEV -- number of solution dependent state variables (as
|
||
|
C defined in the *DEPVAR option)
|
||
|
C PROPS -- material constants entered in the *USER MATERIAL
|
||
|
C option
|
||
|
C NPROPS -- number of material constants
|
||
|
C
|
||
|
|
||
|
C----- This subroutine provides the plastic constitutive relation of
|
||
|
C single crystals for finite element code ABAQUS. The plastic slip
|
||
|
C of single crystal obeys the Schmid law. The program gives the
|
||
|
C choice of small deformation theory and theory of finite rotation
|
||
|
C and finite strain.
|
||
|
C The strain increment is composed of elastic part and plastic
|
||
|
C part. The elastic strain increment corresponds to lattice
|
||
|
C stretching, the plastic part is the sum over all slip systems of
|
||
|
C plastic slip. The shear strain increment for each slip system is
|
||
|
C assumed a function of the ratio of corresponding resolved shear
|
||
|
C stress over current strength, and of the time step. The resolved
|
||
|
C shear stress is the double product of stress tensor with the slip
|
||
|
C deformation tensor (Schmid factor), and the increment of current
|
||
|
C strength is related to shear strain increments over all slip
|
||
|
C systems through self- and latent-hardening functions.
|
||
|
|
||
|
C----- The present program is for a single CUBIC crystal. However,
|
||
|
C this code can be generalized for other crystals (e.g. HCP,
|
||
|
C Tetragonal, Orthotropic, etc.). Only subroutines ROTATION and
|
||
|
C SLIPSYS need to be modified to include the effect of crystal
|
||
|
C aspect ratio.
|
||
|
C
|
||
|
|
||
|
C----- Important notice:
|
||
|
C
|
||
|
C (1) The number of state variables NSTATEV must be larger than (or
|
||
|
C equal to) NINE (9) times the total number of slip systems in
|
||
|
C all sets, NSLPTL, plus FIVE (5)
|
||
|
C NSTATEV >= 9 * NSLPTL + 5
|
||
|
C Denote s as a slip direction and m as normal to a slip plane.
|
||
|
C Here (s,-m), (-s,m) and (-s,-m) are NOT considered
|
||
|
C independent of (s,m). The number of slip systems in each set
|
||
|
C could be either 6, 12, 24 or 48 for a cubic crystal, e.g. 12
|
||
|
C for {110}<111>.
|
||
|
C
|
||
|
C Users who need more parameters to characterize the
|
||
|
C constitutive law of single crystal, e.g. the framework
|
||
|
C proposed by Zarka, should make NSTATEV larger than (or equal
|
||
|
C to) the number of those parameters NPARMT plus nine times
|
||
|
C the total number of slip systems, NSLPTL, plus five
|
||
|
C NSTATEV >= NPARMT + 9 * NSLPTL + 5
|
||
|
C
|
||
|
C (2) The tangent stiffness matrix in general is not symmetric if
|
||
|
C latent hardening is considered. Users must declare "UNSYMM"
|
||
|
C in the input file, at the *USER MATERIAL card.
|
||
|
C
|
||
|
|
||
|
|
||
|
C----- Use single precision on cray
|
||
|
C
|
||
|
PARAMETER (ND=12)
|
||
|
C----- The parameter ND determines the dimensions of the arrays in
|
||
|
C this subroutine. The current choice 150 is a upper bound for a
|
||
|
C cubic crystal with up to three sets of slip systems activated.
|
||
|
C Users may reduce the parameter ND to any number as long as larger
|
||
|
C than or equal to the total number of slip systems in all sets.
|
||
|
C For example, if {110}<111> is the only set of slip system
|
||
|
C potentially activated, ND could be taken as twelve (12).
|
||
|
|
||
|
CHARACTER*80 CMNAME
|
||
|
EXTERNAL F
|
||
|
DIMENSION STRESSOLD(NBLOCK,NDIR+NSHR),
|
||
|
1 STRESSNEW(NBLOCK,NDIR+NSHR),
|
||
|
2 STATEOLD(NBLOCK,NSTATEV), STATENEW(NBLOCK,NSTATEV),
|
||
|
3 STRAININC(NBLOCK, NDIR+NSHR), ENERINTERNNEW(NBLOCK),
|
||
|
4 ENERINELASNEW(NBLOCK), COORDMP(NBLOCK,*),
|
||
|
5 CHARLENGTH(NBLOCK), PROPS(NPROPS), DENSITY(NBLOCK),
|
||
|
6 RELSPININC(NBLOCK,NSHR), TEMPOLD(NBLOCK),
|
||
|
7 STRETCHOLD(NBLOCK,NDIR+NSHR), DEFGRADOLD(NBLOCK,
|
||
|
8 NDIR+2*NSHR), FIELDOLD(NBLOCK,NFIELDV),
|
||
|
9 ENERINTERNOLD(NBLOCK), ENERINELASOLD(NBLOCK),
|
||
|
2 TEMPNEW(NBLOCK), STRETCHNEW(NBLOCK,NDIR+NSHR),
|
||
|
3 DEFGRADNEW(NBLOCK,NDIR+2*NSHR),FIELDNEW(NBLOCK,NFIELDV)
|
||
|
|
||
|
DIMENSION ISPDIR(3), ISPNOR(3), NSLIP(3), DROT(3,3),
|
||
|
2 SLPDIR(3,ND), SLPNOR(3,ND), SLPDEF(6,ND),
|
||
|
3 SLPSPN(3,ND), DSPDIR(3,ND), DSPNOR(3,ND),
|
||
|
4 DLOCAL(6,6), D(6,6), ROTD(6,6), ROTATE(3,3),
|
||
|
5 FSLIP(ND), DFDXSP(ND), DDEMSD(6,ND), STRAN(NDIR+NSHR),
|
||
|
6 H(ND,ND), DGAMMA(ND), DTAUSP(ND), DGSLIP(ND),
|
||
|
7 DSTRES(6), DELATS(6), DVGRAD(3,3), DSPIN(3),
|
||
|
8 WORKST(ND,ND), INDX(ND), TERM(3,3), TRM0(3,3), ITRM(3),
|
||
|
9 ASTRESS(NDIR+NSHR), ASTATEV(NSTATEV)
|
||
|
|
||
|
C----- NSLIP -- number of slip systems in each set
|
||
|
C----- SLPDIR -- slip directions (unit vectors in the initial state)
|
||
|
C----- SLPNOR -- normals to slip planes (unit normals in the initial
|
||
|
C state)
|
||
|
C----- SLPDEF -- slip deformation tensors (Schmid factors)
|
||
|
C SLPDEF(1,i) -- SLPDIR(1,i)*SLPNOR(1,i)
|
||
|
C SLPDEF(2,i) -- SLPDIR(2,i)*SLPNOR(2,i)
|
||
|
C SLPDEF(3,i) -- SLPDIR(3,i)*SLPNOR(3,i)
|
||
|
C SLPDEF(4,i) -- SLPDIR(1,i)*SLPNOR(2,i)+
|
||
|
C SLPDIR(2,i)*SLPNOR(1,i)
|
||
|
C SLPDEF(5,i) -- SLPDIR(1,i)*SLPNOR(3,i)+
|
||
|
C SLPDIR(3,i)*SLPNOR(1,i)
|
||
|
C SLPDEF(6,i) -- SLPDIR(2,i)*SLPNOR(3,i)+
|
||
|
C SLPDIR(3,i)*SLPNOR(2,i)
|
||
|
C where index i corresponds to the ith slip system
|
||
|
C----- SLPSPN -- slip spin tensors (only needed for finite rotation)
|
||
|
C SLPSPN(1,i) -- [SLPDIR(1,i)*SLPNOR(2,i)-
|
||
|
C SLPDIR(2,i)*SLPNOR(1,i)]/2
|
||
|
C SLPSPN(2,i) -- [SLPDIR(3,i)*SLPNOR(1,i)-
|
||
|
C SLPDIR(1,i)*SLPNOR(3,i)]/2
|
||
|
C SLPSPN(3,i) -- [SLPDIR(2,i)*SLPNOR(3,i)-
|
||
|
C SLPDIR(3,i)*SLPNOR(2,i)]/2
|
||
|
C where index i corresponds to the ith slip system
|
||
|
C----- DSPDIR -- increments of slip directions
|
||
|
C----- DSPNOR -- increments of normals to slip planes
|
||
|
C
|
||
|
C----- DLOCAL -- elastic matrix in local cubic crystal system
|
||
|
C----- D -- elastic matrix in global system
|
||
|
C----- ROTD -- rotation matrix transforming DLOCAL to D
|
||
|
C
|
||
|
C----- ROTATE -- rotation matrix, direction cosines of [100], [010]
|
||
|
C and [001] of cubic crystal in global system
|
||
|
C
|
||
|
C----- FSLIP -- shear strain-rates in slip systems
|
||
|
C----- DFDXSP -- derivatives of FSLIP w.r.t x=TAUSLP/GSLIP, where
|
||
|
C TAUSLP is the resolved shear stress and GSLIP is the
|
||
|
C current strength
|
||
|
C
|
||
|
C----- DDEMSD -- double dot product of the elastic moduli tensor with
|
||
|
C the slip deformation tensor plus, only for finite
|
||
|
C rotation, the dot product of slip spin tensor with
|
||
|
C the stress
|
||
|
C
|
||
|
C----- H -- self- and latent-hardening matrix
|
||
|
C H(i,i) -- self hardening modulus of the ith slip
|
||
|
C system (no sum over i)
|
||
|
C H(i,j) -- latent hardening molulus of the ith slip
|
||
|
C system due to a slip in the jth slip system
|
||
|
C (i not equal j)
|
||
|
C
|
||
|
C----- DSTRES -- Jaumann increments of stresses, i.e. corotational
|
||
|
C stress-increments formed on axes spinning with the
|
||
|
C material
|
||
|
C----- DELATS -- strain-increments associated with lattice stretching
|
||
|
C DELATS(1) - DELATS(3) -- normal strain increments
|
||
|
C DELATS(4) - DELATS(6) -- engineering shear strain
|
||
|
C increments
|
||
|
C----- DVGRAD -- increments of deformation gradient in the current
|
||
|
C state, i.e. velocity gradient times the increment of
|
||
|
C time
|
||
|
C
|
||
|
C----- DGAMMA -- increment of shear strains in slip systems
|
||
|
C----- DTAUSP -- increment of resolved shear stresses in slip systems
|
||
|
C----- DGSLIP -- increment of current strengths in slip systems
|
||
|
C
|
||
|
C
|
||
|
C----- Solution dependent state variable STATEOLD
|
||
|
C Denote the number of total slip systems by NSLPTL, which
|
||
|
C will be calculated in this code.
|
||
|
C
|
||
|
C Array STATEOLD
|
||
|
C 1 - NSLPTL : current strength in slip systems
|
||
|
C NSLPTL+1 - 2*NSLPTL : shear strain in slip systems
|
||
|
C 2*NSLPTL+1 - 3*NSLPTL : resolved shear stress in slip systems
|
||
|
C
|
||
|
C 3*NSLPTL+1 - 6*NSLPTL : current components of normals to slip
|
||
|
C slip planes
|
||
|
C 6*NSLPTL+1 - 9*NSLPTL : current components of slip directions
|
||
|
C
|
||
|
C 9*NSLPTL+1 : total cumulative shear strain on all
|
||
|
C slip systems (sum of the absolute
|
||
|
C values of shear strains in all slip
|
||
|
C systems)
|
||
|
C
|
||
|
C 9*NSLPTL+2 - NSTATEV-4 : additional parameters users may need
|
||
|
C to characterize the constitutive law
|
||
|
C of a single crystal (if there are
|
||
|
C any).
|
||
|
C
|
||
|
C NSTATEV-3 : number of slip systems in the 1st set
|
||
|
C NSTATEV-2 : number of slip systems in the 2nd set
|
||
|
C NSTATEV-1 : number of slip systems in the 3rd set
|
||
|
C NSTATEV : total number of slip systems in all
|
||
|
C sets
|
||
|
C
|
||
|
C
|
||
|
C----- Material constants PROPS:
|
||
|
C
|
||
|
C PROPS(1) - PROPS(21) -- elastic constants for a general elastic
|
||
|
C anisotropic material
|
||
|
C
|
||
|
C isotropic : PROPS(i)=0 for i>2
|
||
|
C PROPS(1) -- Young's modulus
|
||
|
C PROPS(2) -- Poisson's ratio
|
||
|
C
|
||
|
C cubic : PROPS(i)=0 for i>3
|
||
|
C PROPS(1) -- c11
|
||
|
C PROPS(2) -- c12
|
||
|
C PROPS(3) -- c44
|
||
|
C
|
||
|
C orthotropic : PORPS(i)=0 for i>9
|
||
|
C PROPS(1) - PROPS(9) are D1111, D1122, D2222,
|
||
|
C D1133, D2233, D3333, D1212, D1313, D2323,
|
||
|
C respectively, which has the same definition
|
||
|
C as ABAQUS for orthotropic materials
|
||
|
C (see *ELASTIC card)
|
||
|
C
|
||
|
C anisotropic : PROPS(1) - PROPS(21) are D1111, D1122,
|
||
|
C D2222, D1133, D2233, D3333, D1112, D2212,
|
||
|
C D3312, D1212, D1113, D2213, D3313, D1213,
|
||
|
C D1313, D1123, D2223, D3323, D1223, D1323,
|
||
|
C D2323, respectively, which has the same
|
||
|
C definition as ABAQUS for anisotropic
|
||
|
C materials (see *ELASTIC card)
|
||
|
C
|
||
|
C
|
||
|
C PROPS(25) - PROPS(56) -- parameters characterizing all slip
|
||
|
C systems to be activated in a cubic
|
||
|
C crystal
|
||
|
C
|
||
|
C PROPS(25) -- number of sets of slip systems (maximum 3),
|
||
|
C e.g. (110)[1-11] and (101)[11-1] are in the
|
||
|
C same set of slip systems, (110)[1-11] and
|
||
|
C (121)[1-11] belong to different sets of slip
|
||
|
C systems
|
||
|
C (It must be a real number, e.g. 3., not 3 !)
|
||
|
C
|
||
|
C PROPS(33) - PROPS(35) -- normal to a typical slip plane in
|
||
|
C the first set of slip systems,
|
||
|
C e.g. (1 1 0)
|
||
|
C (They must be real numbers, e.g.
|
||
|
C 1. 1. 0., not 1 1 0 !)
|
||
|
C PROPS(36) - PROPS(38) -- a typical slip direction in the
|
||
|
C first set of slip systems, e.g.
|
||
|
C [1 1 1]
|
||
|
C (They must be real numbers, e.g.
|
||
|
C 1. 1. 1., not 1 1 1 !)
|
||
|
C
|
||
|
C PROPS(41) - PROPS(43) -- normal to a typical slip plane in
|
||
|
C the second set of slip systems
|
||
|
C (real numbers)
|
||
|
C PROPS(44) - PROPS(46) -- a typical slip direction in the
|
||
|
C second set of slip systems
|
||
|
C (real numbers)
|
||
|
C
|
||
|
C PROPS(49) - PROPS(51) -- normal to a typical slip plane in
|
||
|
C the third set of slip systems
|
||
|
C (real numbers)
|
||
|
C PROPS(52) - PROPS(54) -- a typical slip direction in the
|
||
|
C third set of slip systems
|
||
|
C (real numbers)
|
||
|
C
|
||
|
C
|
||
|
C PROPS(57) - PROPS(72) -- parameters characterizing the initial
|
||
|
C orientation of a single crystal in
|
||
|
C global system
|
||
|
C The directions in global system and directions in local
|
||
|
C cubic crystal system of two nonparallel vectors are needed
|
||
|
C to determine the crystal orientation.
|
||
|
C
|
||
|
C PROPS(57) - PROPS(59) -- [p1 p2 p3], direction of first
|
||
|
C vector in local cubic crystal
|
||
|
C system, e.g. [1 1 0]
|
||
|
C (They must be real numbers, e.g.
|
||
|
C 1. 1. 0., not 1 1 0 !)
|
||
|
C PROPS(60) - PROPS(62) -- [P1 P2 P3], direction of first
|
||
|
C vector in global system, e.g.
|
||
|
C [2. 1. 0.]
|
||
|
C (It does not have to be a unit
|
||
|
C vector)
|
||
|
C
|
||
|
C PROPS(65) - PROPS(67) -- direction of second vector in
|
||
|
C local cubic crystal system (real
|
||
|
C numbers)
|
||
|
C PROPS(68) - PROPS(70) -- direction of second vector in
|
||
|
C global system
|
||
|
C
|
||
|
C
|
||
|
C PROPS(73) - PROPS(96) -- parameters characterizing the visco-
|
||
|
C plastic constitutive law (shear
|
||
|
C strain-rate vs. resolved shear
|
||
|
C stress), e.g. a power-law relation
|
||
|
C
|
||
|
C PROPS(73) - PROPS(80) -- parameters for the first set of
|
||
|
C slip systems
|
||
|
C PROPS(81) - PROPS(88) -- parameters for the second set of
|
||
|
C slip systems
|
||
|
C PROPS(89) - PROPS(96) -- parameters for the third set of
|
||
|
C slip systems
|
||
|
C
|
||
|
C
|
||
|
C PROPS(97) - PROPS(144)-- parameters characterizing the self-
|
||
|
C and latent-hardening laws of slip
|
||
|
C systems
|
||
|
C
|
||
|
C PROPS(97) - PROPS(104)-- self-hardening parameters for the
|
||
|
C first set of slip systems
|
||
|
C PROPS(105)- PROPS(112)-- latent-hardening parameters for
|
||
|
C the first set of slip systems and
|
||
|
C interaction with other sets of
|
||
|
C slip systems
|
||
|
C
|
||
|
C PROPS(113)- PROPS(120)-- self-hardening parameters for the
|
||
|
C second set of slip systems
|
||
|
C PROPS(121)- PROPS(128)-- latent-hardening parameters for
|
||
|
C the second set of slip systems
|
||
|
C and interaction with other sets
|
||
|
C of slip systems
|
||
|
C
|
||
|
C PROPS(129)- PROPS(136)-- self-hardening parameters for the
|
||
|
C third set of slip systems
|
||
|
C PROPS(137)- PROPS(144)-- latent-hardening parameters for
|
||
|
C the third set of slip systems and
|
||
|
C interaction with other sets of
|
||
|
C slip systems
|
||
|
C
|
||
|
C
|
||
|
C PROPS(145)- PROPS(152)-- parameters characterizing forward time
|
||
|
C integration scheme and finite
|
||
|
C deformation
|
||
|
C
|
||
|
C PROPS(145) -- parameter theta controlling the implicit
|
||
|
C integration, which is between 0 and 1
|
||
|
C 0. : explicit integration
|
||
|
C 0.5 : recommended value
|
||
|
C 1. : fully implicit integration
|
||
|
C
|
||
|
C PROPS(146) -- parameter NLGEOM controlling whether the
|
||
|
C effect of finite rotation and finite strain
|
||
|
C of crystal is considered,
|
||
|
C 0. : small deformation theory
|
||
|
C otherwise : theory of finite rotation and
|
||
|
C finite strain
|
||
|
C
|
||
|
C
|
||
|
IF (STEPTIME.EQ.0.) THEN
|
||
|
|
||
|
DO 2000 KM=1,NBLOCK
|
||
|
|
||
|
C Elastic Matrix {D}
|
||
|
DO J=1,6
|
||
|
DO I=1,6
|
||
|
D(I,J)=0.
|
||
|
END DO
|
||
|
END DO
|
||
|
GSHEAR=PROPS(1)/(2.*(1.+PROPS(2)))
|
||
|
E11=2.*GSHEAR*(1.-PROPS(2))/(1.-2.*PROPS(2))
|
||
|
E12=2.*GSHEAR*PROPS(2)/(1.-2.*PROPS(2))
|
||
|
|
||
|
DO J=1,3
|
||
|
D(J,J)=E11
|
||
|
|
||
|
DO I=1,3
|
||
|
IF (I.NE.J) D(I,J)=E12
|
||
|
END DO
|
||
|
|
||
|
D(J+3,J+3)=GSHEAR
|
||
|
END DO
|
||
|
|
||
|
C Calculation of Stress Inc
|
||
|
DO I=1,NDIR+NSHR
|
||
|
DSTRES(I)=0
|
||
|
END DO
|
||
|
|
||
|
DO I=1,NDIR+NSHR
|
||
|
DO J=1,NDIR+NSHR
|
||
|
DSTRES(I)=DSTRES(I)+D(I,J)*STRAININC(KM,J)
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
C Calculation of Stress New
|
||
|
DO I=1,NDIR+NSHR
|
||
|
STRESSNEW(KM,I)=STRESSOLD(KM,I)+DSTRES(I)
|
||
|
END DO
|
||
|
|
||
|
2000 CONTINUE
|
||
|
|
||
|
ELSE
|
||
|
|
||
|
DO 3000 KM=1,NBLOCK
|
||
|
|
||
|
C----- If the element has failed then there is no need to carry
|
||
|
C----- out the stress updating.
|
||
|
|
||
|
C IF(STATEOLD(KM,NSTATEV-32).EQ.0.AND.
|
||
|
C *STATEOLD(KM,9*NSLPTL+1).NE.0.) GO TO 4000
|
||
|
|
||
|
|
||
|
C----- As the VUMAT passes in tensor shear strain and this subroutine
|
||
|
C----- uses engineering strain --> STRAININC(shr) x 2
|
||
|
|
||
|
DO I=1,NSHR
|
||
|
STRAININC(KM,I+3)=STRAININC(KM,I+3)*2.
|
||
|
END DO
|
||
|
|
||
|
C----- The order of tensor components in the vumat is different from
|
||
|
C----- in the umat. In the umat component 5 is F13 and 6 is F23
|
||
|
C----- In the vumat component 5 is F23 and 6 is F31
|
||
|
|
||
|
IF (NSHR.GT.1) THEN
|
||
|
SAVE=STRAININC(KM,5)
|
||
|
STRAININC(KM,5)=STRAININC(KM,6)
|
||
|
STRAININC(KM,6)=SAVE
|
||
|
|
||
|
SAVE=STRESSOLD(KM,5)
|
||
|
STRESSOLD(KM,5)=STRESSOLD(KM,6)
|
||
|
STRESSOLD(KM,6)=SAVE
|
||
|
END IF
|
||
|
|
||
|
C----- STATEOLD(KM, NSTATEV-14) - STATEOLD(KM, NSTATEV-11) is the total strain
|
||
|
C----- at the current point in time
|
||
|
C ***NEED TO CHANGE FOR 3D***
|
||
|
|
||
|
DO I=1, NDIR+NSHR
|
||
|
STATEOLD(KM,NSTATEV-15+I)=STATEOLD(KM,NSTATEV-15+I)+STRAININC(KM,I)
|
||
|
STRAN(I)=STATEOLD(KM,NSTATEV-15+I)
|
||
|
END DO
|
||
|
|
||
|
|
||
|
C----- Elastic matrix in local cubic crystal system: DLOCAL
|
||
|
DO J=1,6
|
||
|
DO I=1,6
|
||
|
DLOCAL(I,J)=0.
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
CHECK=0.
|
||
|
DO J=10,21
|
||
|
CHECK=CHECK+ABS(PROPS(J))
|
||
|
END DO
|
||
|
|
||
|
IF (CHECK.EQ.0.) THEN
|
||
|
DO J=4,9
|
||
|
CHECK=CHECK+ABS(PROPS(J))
|
||
|
END DO
|
||
|
|
||
|
IF (CHECK.EQ.0.) THEN
|
||
|
|
||
|
IF (PROPS(3).EQ.0.) THEN
|
||
|
|
||
|
C----- Isotropic material
|
||
|
GSHEAR=PROPS(1)/2./(1.+PROPS(2))
|
||
|
E11=2.*GSHEAR*(1.-PROPS(2))/(1.-2.*PROPS(2))
|
||
|
E12=2.*GSHEAR*PROPS(2)/(1.-2.*PROPS(2))
|
||
|
|
||
|
DO J=1,3
|
||
|
DLOCAL(J,J)=E11
|
||
|
|
||
|
DO I=1,3
|
||
|
IF (I.NE.J) DLOCAL(I,J)=E12
|
||
|
END DO
|
||
|
|
||
|
DLOCAL(J+3,J+3)=GSHEAR
|
||
|
END DO
|
||
|
|
||
|
END IF
|
||
|
|
||
|
END IF
|
||
|
END IF
|
||
|
|
||
|
C----- Rotation matrix: ROTATE, i.e. direction cosines of [100], [010]
|
||
|
C and [001] of a cubic crystal in global system
|
||
|
C
|
||
|
|
||
|
CALL ROTATION (PROPS(57), ROTATE)
|
||
|
|
||
|
C----- Rotation matrix: ROTD to transform local elastic matrix DLOCAL
|
||
|
C to global elastic matrix D
|
||
|
C
|
||
|
DO J=1,3
|
||
|
J1=1+J/3
|
||
|
J2=2+J/2
|
||
|
|
||
|
DO I=1,3
|
||
|
I1=1+I/3
|
||
|
I2=2+I/2
|
||
|
|
||
|
ROTD(I,J)=ROTATE(I,J)**2
|
||
|
ROTD(I,J+3)=2.*ROTATE(I,J1)*ROTATE(I,J2)
|
||
|
ROTD(I+3,J)=ROTATE(I1,J)*ROTATE(I2,J)
|
||
|
ROTD(I+3,J+3)=ROTATE(I1,J1)*ROTATE(I2,J2)+
|
||
|
2 ROTATE(I1,J2)*ROTATE(I2,J1)
|
||
|
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
C----- Elastic matrix in global system: D
|
||
|
C {D} = {ROTD} * {DLOCAL} * {ROTD}transpose
|
||
|
C
|
||
|
DO J=1,6
|
||
|
DO I=1,6
|
||
|
D(I,J)=0.
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
DO J=1,6
|
||
|
DO I=1,J
|
||
|
|
||
|
DO K=1,6
|
||
|
DO L=1,6
|
||
|
D(I,J)=D(I,J)+DLOCAL(K,L)*ROTD(I,K)*ROTD(J,L)
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
D(J,I)=D(I,J)
|
||
|
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
C----- Total number of sets of slip systems: NSET
|
||
|
NSET=NINT(PROPS(25))
|
||
|
IF (NSET.LT.1) THEN
|
||
|
WRITE (6,*) '***ERROR - zero sets of slip systems'
|
||
|
STOP
|
||
|
ELSE IF (NSET.GT.3) THEN
|
||
|
WRITE (6,*)
|
||
|
2 '***ERROR - more than three sets of slip systems'
|
||
|
STOP
|
||
|
END IF
|
||
|
|
||
|
C----- Implicit integration parameter: THETA
|
||
|
THETA=PROPS(145)
|
||
|
|
||
|
C----- Finite deformation ?
|
||
|
C----- NLGEOM = 0, small deformation theory
|
||
|
C otherwise, theory of finite rotation and finite strain, Users
|
||
|
C must declare "NLGEOM" in the input file, at the *STEP card
|
||
|
C
|
||
|
C IF (PROPS(146).EQ.0.) THEN
|
||
|
C NLGEOM=0
|
||
|
C ELSE
|
||
|
NLGEOM=1
|
||
|
C END IF
|
||
|
|
||
|
C As the VUMAT uses stress and strain components based in a
|
||
|
C corotational coordinate system that rotates with the material,
|
||
|
C we set DROT=I, the identity matrix, as there is no relative
|
||
|
C rigid body rotation.
|
||
|
|
||
|
DO I=1,3
|
||
|
DO J=1,3
|
||
|
IF (I.EQ.J) THEN
|
||
|
DROT(I,I)=1.
|
||
|
ELSE
|
||
|
DROT(I,J)=0.
|
||
|
END IF
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
IF (NLGEOM.NE.0) THEN
|
||
|
DO J=1,3
|
||
|
DO I=1,3
|
||
|
TERM(I,J)=DROT(J,I)
|
||
|
TRM0(I,J)=DROT(J,I)
|
||
|
END DO
|
||
|
|
||
|
TERM(J,J)=TERM(J,J)+1.D0
|
||
|
TRM0(J,J)=TRM0(J,J)-1.D0
|
||
|
END DO
|
||
|
|
||
|
CALL LUDCMP (TERM, 3, 3, ITRM, DDCMP)
|
||
|
|
||
|
DO J=1,3
|
||
|
CALL LUBKSB (TERM, 3, 3, ITRM, TRM0(1,J))
|
||
|
END DO
|
||
|
|
||
|
DSPIN(1)=TRM0(2,1)-TRM0(1,2)
|
||
|
DSPIN(2)=TRM0(1,3)-TRM0(3,1)
|
||
|
DSPIN(3)=TRM0(3,2)-TRM0(2,3)
|
||
|
|
||
|
END IF
|
||
|
|
||
|
INC=(TOTALTIME-STEPTIME)/DT
|
||
|
|
||
|
C----- Increment of dilatational strain: DEV
|
||
|
DEV=0.D0
|
||
|
DO I=1,NDIR
|
||
|
DEV=DEV+STRAININC(KM,I)
|
||
|
END DO
|
||
|
C
|
||
|
C----- Check whether the current stress state is the initial state
|
||
|
IF (STATEOLD(KM,1).EQ.0.) THEN
|
||
|
C----- Initial state
|
||
|
C
|
||
|
C----- Generating the following parameters and variables at initial
|
||
|
C state:
|
||
|
C Total number of slip systems in all the sets NSLPTL
|
||
|
C Number of slip systems in each set NSLIP
|
||
|
C Unit vectors in initial slip directions SLPDIR
|
||
|
C Unit normals to initial slip planes SLPNOR
|
||
|
C
|
||
|
NSLPTL=0
|
||
|
DO I=1,NSET
|
||
|
ISPNOR(1)=NINT(PROPS(25+8*I))
|
||
|
ISPNOR(2)=NINT(PROPS(26+8*I))
|
||
|
ISPNOR(3)=NINT(PROPS(27+8*I))
|
||
|
|
||
|
ISPDIR(1)=NINT(PROPS(28+8*I))
|
||
|
ISPDIR(2)=NINT(PROPS(29+8*I))
|
||
|
ISPDIR(3)=NINT(PROPS(30+8*I))
|
||
|
|
||
|
CALL SLIPSYS (ISPDIR, ISPNOR, NSLIP(I), SLPDIR(1,NSLPTL+1),
|
||
|
2 SLPNOR(1,NSLPTL+1), ROTATE)
|
||
|
|
||
|
NSLPTL=NSLPTL+NSLIP(I)
|
||
|
END DO
|
||
|
|
||
|
IF (ND.LT.NSLPTL) THEN
|
||
|
WRITE (6,*)
|
||
|
2 '***ERROR - parameter ND chosen by the present user
|
||
|
3 is less than
|
||
|
4 the total number of slip systems NSLPTL'
|
||
|
STOP
|
||
|
END IF
|
||
|
|
||
|
C----- Slip deformation tensor: SLPDEF (Schmid factors)
|
||
|
|
||
|
DO J=1,NSLPTL
|
||
|
SLPDEF(1,J)=SLPDIR(1,J)*SLPNOR(1,J)
|
||
|
SLPDEF(2,J)=SLPDIR(2,J)*SLPNOR(2,J)
|
||
|
SLPDEF(3,J)=SLPDIR(3,J)*SLPNOR(3,J)
|
||
|
SLPDEF(4,J)=SLPDIR(1,J)*SLPNOR(2,J)+SLPDIR(2,J)*SLPNOR(1,J)
|
||
|
SLPDEF(5,J)=SLPDIR(1,J)*SLPNOR(3,J)+SLPDIR(3,J)*SLPNOR(1,J)
|
||
|
SLPDEF(6,J)=SLPDIR(2,J)*SLPNOR(3,J)+SLPDIR(3,J)*SLPNOR(2,J)
|
||
|
END DO
|
||
|
|
||
|
C----- Initial value of state variables: unit normal to a slip plane
|
||
|
C and unit vector in a slip direction
|
||
|
C
|
||
|
STATEOLD(KM,NSTATEV)=FLOAT(NSLPTL)
|
||
|
DO I=1,NSET
|
||
|
STATEOLD(KM,NSTATEV-4+I)=FLOAT(NSLIP(I))
|
||
|
END DO
|
||
|
IDNOR=3*NSLPTL
|
||
|
IDDIR=6*NSLPTL
|
||
|
DO J=1,NSLPTL
|
||
|
DO I=1,3
|
||
|
IDNOR=IDNOR+1
|
||
|
STATEOLD(KM,IDNOR)=SLPNOR(I,J)
|
||
|
|
||
|
IDDIR=IDDIR+1
|
||
|
STATEOLD(KM,IDDIR)=SLPDIR(I,J)
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
C----- Initial value of the current strength for all slip systems
|
||
|
C
|
||
|
CALL GSLPINIT(STATEOLD(KM,1),NSLIP,NSLPTL,NSET,PROPS(97),
|
||
|
4 NBLOCK)
|
||
|
|
||
|
C----- Initial value of shear strain in slip systems
|
||
|
DO I=1,NSLPTL
|
||
|
STATEOLD(KM,NSLPTL+I)=0.
|
||
|
END DO
|
||
|
|
||
|
STATEOLD(KM,9*NSLPTL+1)=0.
|
||
|
|
||
|
C----- Initial value of the resolved shear stress in slip systems
|
||
|
|
||
|
DO I=1,NSLPTL
|
||
|
TERM1=0.
|
||
|
|
||
|
DO J=1,NDIR+NSHR
|
||
|
IF (J.LE.NDIR) THEN
|
||
|
TERM1=TERM1+SLPDEF(J,I)*STRESSOLD(KM,J)
|
||
|
ELSE
|
||
|
TERM1=TERM1+SLPDEF(J-NDIR+3,I)*STRESSOLD(KM,J)
|
||
|
END IF
|
||
|
END DO
|
||
|
|
||
|
STATEOLD(KM,2*NSLPTL+I)=TERM1
|
||
|
END DO
|
||
|
|
||
|
ELSE
|
||
|
|
||
|
C----- C U R R E N T S T R E S S S T A T E ! ! !
|
||
|
C
|
||
|
C----- Copying from the array of state variables STATEOLD the following
|
||
|
C parameters and variables at current stress state:
|
||
|
C Total number of slip systems in all the sets NSLPTL
|
||
|
C Number of slip systems in each set NSLIP
|
||
|
C Current slip directions SLPDIR
|
||
|
C Normals to current slip planes SLPNOR
|
||
|
C
|
||
|
|
||
|
NSLPTL=NINT(STATEOLD(KM,NSTATEV))
|
||
|
DO I=1,NSET
|
||
|
NSLIP(I)=NINT(STATEOLD(KM,NSTATEV-4+I))
|
||
|
END DO
|
||
|
|
||
|
IDNOR=3*NSLPTL
|
||
|
IDDIR=6*NSLPTL
|
||
|
DO J=1,NSLPTL
|
||
|
DO I=1,3
|
||
|
IDNOR=IDNOR+1
|
||
|
SLPNOR(I,J)=STATEOLD(KM,IDNOR)
|
||
|
|
||
|
IDDIR=IDDIR+1
|
||
|
SLPDIR(I,J)=STATEOLD(KM,IDDIR)
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
C----- Slip deformation tensor: SLPDEF (Schmid factors)
|
||
|
|
||
|
DO J=1,NSLPTL
|
||
|
SLPDEF(1,J)=SLPDIR(1,J)*SLPNOR(1,J)
|
||
|
SLPDEF(2,J)=SLPDIR(2,J)*SLPNOR(2,J)
|
||
|
SLPDEF(3,J)=SLPDIR(3,J)*SLPNOR(3,J)
|
||
|
SLPDEF(4,J)=SLPDIR(1,J)*SLPNOR(2,J)+SLPDIR(2,J)*SLPNOR(1,J)
|
||
|
SLPDEF(5,J)=SLPDIR(1,J)*SLPNOR(3,J)+SLPDIR(3,J)*SLPNOR(1,J)
|
||
|
SLPDEF(6,J)=SLPDIR(2,J)*SLPNOR(3,J)+SLPDIR(3,J)*SLPNOR(2,J)
|
||
|
END DO
|
||
|
|
||
|
END IF
|
||
|
|
||
|
C----- Slip spin tensor: SLPSPN (only needed for finite rotation)
|
||
|
|
||
|
IF (NLGEOM.NE.0) THEN
|
||
|
DO J=1,NSLPTL
|
||
|
SLPSPN(1,J)=0.5*(SLPDIR(1,J)*SLPNOR(2,J)-
|
||
|
2 SLPDIR(2,J)*SLPNOR(1,J))
|
||
|
SLPSPN(2,J)=0.5*(SLPDIR(3,J)*SLPNOR(1,J)-
|
||
|
2 SLPDIR(1,J)*SLPNOR(3,J))
|
||
|
SLPSPN(3,J)=0.5*(SLPDIR(2,J)*SLPNOR(3,J)-
|
||
|
2 SLPDIR(3,J)*SLPNOR(2,J))
|
||
|
END DO
|
||
|
END IF
|
||
|
|
||
|
C----- Double dot product of elastic moduli tensor with the slip
|
||
|
C deformation tensor (Schmid factors) plus, only for finite
|
||
|
C rotation, the dot product of slip spin tensor with the stress:
|
||
|
C DDEMSD
|
||
|
C
|
||
|
|
||
|
DO J=1,NSLPTL
|
||
|
DO I=1,6
|
||
|
DDEMSD(I,J)=0.
|
||
|
DO K=1,6
|
||
|
DDEMSD(I,J)=DDEMSD(I,J)+D(K,I)*SLPDEF(K,J)
|
||
|
END DO
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
IF (NLGEOM.NE.0) THEN
|
||
|
DO J=1,NSLPTL
|
||
|
|
||
|
DDEMSD(4,J)=DDEMSD(4,J)-SLPSPN(1,J)*STRESSOLD(KM,1)
|
||
|
DDEMSD(5,J)=DDEMSD(5,J)+SLPSPN(2,J)*STRESSOLD(KM,1)
|
||
|
|
||
|
IF (NDIR.GT.1) THEN
|
||
|
DDEMSD(4,J)=DDEMSD(4,J)+SLPSPN(1,J)*STRESSOLD(KM,2)
|
||
|
DDEMSD(6,J)=DDEMSD(6,J)-SLPSPN(3,J)*STRESSOLD(KM,2)
|
||
|
END IF
|
||
|
|
||
|
IF (NDIR.GT.2) THEN
|
||
|
DDEMSD(5,J)=DDEMSD(5,J)-SLPSPN(2,J)*STRESSOLD(KM,3)
|
||
|
DDEMSD(6,J)=DDEMSD(6,J)+SLPSPN(3,J)*STRESSOLD(KM,3)
|
||
|
END IF
|
||
|
|
||
|
IF (NSHR.GE.1) THEN
|
||
|
DDEMSD(1,J)=DDEMSD(1,J)+SLPSPN(1,J)*STRESSOLD(KM,NDIR+1)
|
||
|
DDEMSD(2,J)=DDEMSD(2,J)-SLPSPN(1,J)*STRESSOLD(KM,NDIR+1)
|
||
|
DDEMSD(5,J)=DDEMSD(5,J)-SLPSPN(3,J)*STRESSOLD(KM,NDIR+1)
|
||
|
DDEMSD(6,J)=DDEMSD(6,J)+SLPSPN(2,J)*STRESSOLD(KM,NDIR+1)
|
||
|
END IF
|
||
|
|
||
|
IF (NSHR.GE.2) THEN
|
||
|
DDEMSD(1,J)=DDEMSD(1,J)-SLPSPN(2,J)*STRESSOLD(KM,NDIR+2)
|
||
|
DDEMSD(3,J)=DDEMSD(3,J)+SLPSPN(2,J)*STRESSOLD(KM,NDIR+2)
|
||
|
DDEMSD(4,J)=DDEMSD(4,J)+SLPSPN(3,J)*STRESSOLD(KM,NDIR+2)
|
||
|
DDEMSD(6,J)=DDEMSD(6,J)-SLPSPN(1,J)*STRESSOLD(KM,NDIR+2)
|
||
|
END IF
|
||
|
|
||
|
IF (NSHR.EQ.3) THEN
|
||
|
DDEMSD(2,J)=DDEMSD(2,J)+SLPSPN(3,J)*STRESSOLD(KM,NDIR+3)
|
||
|
DDEMSD(3,J)=DDEMSD(3,J)-SLPSPN(3,J)*STRESSOLD(KM,NDIR+3)
|
||
|
DDEMSD(4,J)=DDEMSD(4,J)-SLPSPN(2,J)*STRESSOLD(KM,NDIR+3)
|
||
|
DDEMSD(5,J)=DDEMSD(5,J)+SLPSPN(1,J)*STRESSOLD(KM,NDIR+3)
|
||
|
END IF
|
||
|
|
||
|
END DO
|
||
|
END IF
|
||
|
|
||
|
C----- Shear strain-rate in a slip system at the start of increment:
|
||
|
C FSLIP, and its derivative: DFDXSP
|
||
|
C
|
||
|
|
||
|
ID=1
|
||
|
DO I=1,NSET
|
||
|
IF (I.GT.1) ID=ID+NSLIP(I-1)
|
||
|
|
||
|
CALL STRAINRATE(STATEOLD(KM,NSLPTL+ID),
|
||
|
2 STATEOLD(KM,2*NSLPTL+ID),STATEOLD(KM,ID), NSLIP(I),
|
||
|
3 FSLIP(ID), DFDXSP(ID),PROPS(65+8*I), NBLOCK)
|
||
|
|
||
|
END DO
|
||
|
|
||
|
C----- Self- and latent-hardening laws
|
||
|
CALL LATENTHARDEN(STATEOLD(KM,NSLPTL+1),STATEOLD(KM,2*NSLPTL+1),
|
||
|
2 STATEOLD(KM,1),STATEOLD(KM,9*NSLPTL+1),NSLIP, NSLPTL,
|
||
|
3 NSET, H(1,1), PROPS(97), ND, NBLOCK)
|
||
|
|
||
|
|
||
|
C----- LU decomposition to solve the increment of shear strain in a
|
||
|
C slip system
|
||
|
C
|
||
|
TERM1=THETA*DT
|
||
|
|
||
|
DO I=1,NSLPTL
|
||
|
TAUSLP=STATEOLD(KM,2*NSLPTL+I)
|
||
|
GSLIP=STATEOLD(KM,I)
|
||
|
X=TAUSLP/GSLIP
|
||
|
TERM2=TERM1*DFDXSP(I)/GSLIP
|
||
|
TERM3=TERM1*X*DFDXSP(I)/GSLIP
|
||
|
|
||
|
DO J=1,NSLPTL
|
||
|
TERM4=0.
|
||
|
DO K=1,6
|
||
|
TERM4=TERM4+DDEMSD(K,I)*SLPDEF(K,J)
|
||
|
END DO
|
||
|
|
||
|
WORKST(I,J)=TERM2*TERM4+H(I,J)*TERM3*DSIGN(1.D0,FSLIP(J))
|
||
|
|
||
|
END DO
|
||
|
|
||
|
WORKST(I,I)=WORKST(I,I)+1.
|
||
|
|
||
|
END DO
|
||
|
|
||
|
CALL LUDCMP (WORKST, NSLPTL, ND, INDX, DDCMP)
|
||
|
|
||
|
|
||
|
C----- Increment of shear strain in a slip system: DGAMMA
|
||
|
TERM1=THETA*DT
|
||
|
DO I=1,NSLPTL
|
||
|
|
||
|
TAUSLP=STATEOLD(KM,2*NSLPTL+I)
|
||
|
GSLIP=STATEOLD(KM,I)
|
||
|
X=TAUSLP/GSLIP
|
||
|
TERM2=TERM1*DFDXSP(I)/GSLIP
|
||
|
|
||
|
DGAMMA(I)=0.
|
||
|
DO J=1,NDIR
|
||
|
DGAMMA(I)=DGAMMA(I)+DDEMSD(J,I)*STRAININC(KM,J)
|
||
|
END DO
|
||
|
|
||
|
IF (NSHR.GT.0) THEN
|
||
|
DO J=1,NSHR
|
||
|
|
||
|
IF (J.EQ.1) THEN
|
||
|
DGAMMA(I)=DGAMMA(I)+DDEMSD(4,I)*STRAININC(KM,4)
|
||
|
ELSEIF (J.EQ.2) THEN
|
||
|
DGAMMA(I)=DGAMMA(I)+DDEMSD(6,I)*STRAININC(KM,5)
|
||
|
ELSEIF (J.EQ.3) THEN
|
||
|
DGAMMA(I)=DGAMMA(I)+DDEMSD(5,I)*STRAININC(KM,6)
|
||
|
END IF
|
||
|
|
||
|
END DO
|
||
|
END IF
|
||
|
|
||
|
DGAMMA(I)=DGAMMA(I)*TERM2+FSLIP(I)*DT
|
||
|
|
||
|
END DO
|
||
|
|
||
|
CALL LUBKSB (WORKST, NSLPTL, ND, INDX, DGAMMA)
|
||
|
|
||
|
C----- Update the shear strain in a slip system: STATEOLD(NSLPTL+1) -
|
||
|
C STATEOLD(2*NSLPTL)
|
||
|
C
|
||
|
DO I=1,NSLPTL
|
||
|
STATEOLD(KM,NSLPTL+I)=STATEOLD(KM,NSLPTL+I)+DGAMMA(I)
|
||
|
END DO
|
||
|
|
||
|
C----- Increment of current strength in a slip system: DGSLIP
|
||
|
DO I=1,NSLPTL
|
||
|
DGSLIP(I)=0.
|
||
|
DO J=1,NSLPTL
|
||
|
DGSLIP(I)=DGSLIP(I)+H(I,J)*ABS(DGAMMA(J))
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
C----- Update the current strength in a slip system: STATEOLD(1) -
|
||
|
C STATEOLD(NSLPTL)
|
||
|
C
|
||
|
DO I=1,NSLPTL
|
||
|
STATEOLD(KM,I)=STATEOLD(KM,I)+DGSLIP(I)
|
||
|
END DO
|
||
|
|
||
|
C----- Increment of strain associated with lattice stretching: DELATS
|
||
|
DO J=1,6
|
||
|
DELATS(J)=0.
|
||
|
END DO
|
||
|
|
||
|
DO J=1,3
|
||
|
IF (J.LE.NDIR) DELATS(J)=STRAININC(KM,J)
|
||
|
DO I=1,NSLPTL
|
||
|
DELATS(J)=DELATS(J)-SLPDEF(J,I)*DGAMMA(I)
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
DO J=1,3
|
||
|
IF (J.LE.NSHR) DELATS(J+3)=STRAININC(KM,J+NDIR)
|
||
|
DO I=1,NSLPTL
|
||
|
DELATS(J+3)=DELATS(J+3)-SLPDEF(J+3,I)*DGAMMA(I)
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
C----- Increment of deformation gradient associated with lattice
|
||
|
C stretching in the current state, i.e. the velocity gradient
|
||
|
C (associated with lattice stretching) times the increment of time:
|
||
|
C DVGRAD (only needed for finite rotation)
|
||
|
C
|
||
|
IF (NLGEOM.NE.0) THEN
|
||
|
DO J=1,3
|
||
|
DO I=1,3
|
||
|
IF (I.EQ.J) THEN
|
||
|
DVGRAD(I,J)=DELATS(I)
|
||
|
ELSE
|
||
|
DVGRAD(I,J)=DELATS(I+J+1)
|
||
|
END IF
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
DO J=1,3
|
||
|
DO I=1,J
|
||
|
IF (J.GT.I) THEN
|
||
|
IJ2=I+J-2
|
||
|
IF (MOD(IJ2,2).EQ.1) THEN
|
||
|
TERM1=1.
|
||
|
ELSE
|
||
|
TERM1=-1.
|
||
|
END IF
|
||
|
|
||
|
DO K=1,NSLPTL
|
||
|
DVGRAD(I,J)=DVGRAD(I,J)-TERM1*DGAMMA(K)*
|
||
|
2 SLPSPN(IJ2,K)
|
||
|
DVGRAD(J,I)=DVGRAD(J,I)+TERM1*DGAMMA(K)*
|
||
|
2 SLPSPN(IJ2,K)
|
||
|
END DO
|
||
|
END IF
|
||
|
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
END IF
|
||
|
|
||
|
C
|
||
|
C----- Increment of resolved shear stress in a slip system: DTAUSP
|
||
|
DO I=1,NSLPTL
|
||
|
DTAUSP(I)=0.
|
||
|
DO J=1,6
|
||
|
DTAUSP(I)=DTAUSP(I)+DDEMSD(J,I)*DELATS(J)
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
C----- Update the resolved shear stress in a slip system:
|
||
|
C STATEOLD(2*NSLPTL+1) - STATEOLD(3*NSLPTL)
|
||
|
C
|
||
|
DO I=1,NSLPTL
|
||
|
STATEOLD(KM,2*NSLPTL+I)=STATEOLD(KM,2*NSLPTL+I)+DTAUSP(I)
|
||
|
END DO
|
||
|
|
||
|
C----- Increment of stress: DSTRES
|
||
|
IF (NLGEOM.EQ.0) THEN
|
||
|
DO I=1,NDIR+NSHR
|
||
|
DSTRES(I)=0.
|
||
|
END DO
|
||
|
ELSE
|
||
|
DO I=1,NDIR+NSHR
|
||
|
DSTRES(I)=-STRESSOLD(KM,I)*DEV
|
||
|
END DO
|
||
|
END IF
|
||
|
|
||
|
DO I=1,NDIR
|
||
|
DO J=1,NDIR
|
||
|
DSTRES(I)=DSTRES(I)+D(I,J)*STRAININC(KM,J)
|
||
|
END DO
|
||
|
|
||
|
IF (NSHR.GT.0)THEN
|
||
|
DO J=1,NSHR
|
||
|
DSTRES(I)=DSTRES(I)+D(I,J+3)*STRAININC(KM,J+NDIR)
|
||
|
END DO
|
||
|
END IF
|
||
|
|
||
|
DO J=1,NSLPTL
|
||
|
DSTRES(I)=DSTRES(I)-DDEMSD(I,J)*DGAMMA(J)
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
IF (NSHR.GT.0) THEN
|
||
|
DO I=1,NSHR
|
||
|
|
||
|
DO J=1,NDIR
|
||
|
DSTRES(I+NDIR)=DSTRES(I+NDIR)+D(I+3,J)*STRAININC(KM,J)
|
||
|
END DO
|
||
|
|
||
|
DO J=1,NSHR
|
||
|
DSTRES(I+NDIR)=DSTRES(I+NDIR)+D(I+3,J+3)*
|
||
|
2 STRAININC(KM,J+NDIR)
|
||
|
|
||
|
END DO
|
||
|
|
||
|
DO J=1,NSLPTL
|
||
|
DSTRES(I+NDIR)=DSTRES(I+NDIR)-DDEMSD(I+3,J)*DGAMMA(J)
|
||
|
END DO
|
||
|
|
||
|
END DO
|
||
|
END IF
|
||
|
|
||
|
C----- Update the stress: STRESSOLD
|
||
|
DO I=1,NDIR+NSHR
|
||
|
STRESSOLD(KM,I)=STRESSOLD(KM,I)+DSTRES(I)
|
||
|
END DO
|
||
|
|
||
|
C----- Increment of normal to a slip plane and a slip direction (only
|
||
|
C needed for finite rotation)
|
||
|
C
|
||
|
IF (NLGEOM.NE.0) THEN
|
||
|
DO J=1,NSLPTL
|
||
|
DO I=1,3
|
||
|
DSPNOR(I,J)=0.
|
||
|
DSPDIR(I,J)=0.
|
||
|
|
||
|
DO K=1,3
|
||
|
DSPNOR(I,J)=DSPNOR(I,J)-SLPNOR(K,J)*DVGRAD(K,I)
|
||
|
DSPDIR(I,J)=DSPDIR(I,J)+SLPDIR(K,J)*DVGRAD(I,K)
|
||
|
END DO
|
||
|
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
C----- Update the normal to a slip plane and a slip direction (only
|
||
|
C needed for finite rotation)
|
||
|
C
|
||
|
IDNOR=3*NSLPTL
|
||
|
IDDIR=6*NSLPTL
|
||
|
DO J=1,NSLPTL
|
||
|
DO I=1,3
|
||
|
IDNOR=IDNOR+1
|
||
|
STATEOLD(KM,IDNOR)=STATEOLD(KM,IDNOR)+DSPNOR(I,J)
|
||
|
|
||
|
IDDIR=IDDIR+1
|
||
|
STATEOLD(KM,IDDIR)=STATEOLD(KM,IDDIR)+DSPDIR(I,J)
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
END IF
|
||
|
|
||
|
C----- Jacobian stuff taken out
|
||
|
|
||
|
C----- Iteration stuff taken out
|
||
|
|
||
|
C----- Total cumulative shear strains on all slip systems (sum of the
|
||
|
C absolute values of shear strains in all slip systems)
|
||
|
C
|
||
|
DO I=1,NSLPTL
|
||
|
STATEOLD(KM,9*NSLPTL+1)=STATEOLD(KM,9*NSLPTL+1)+ABS(DGAMMA(I))
|
||
|
END DO
|
||
|
C
|
||
|
C---- Construct alternative stress and state variable arrays, so that
|
||
|
C---- they are one-dimensional before calling damage
|
||
|
C
|
||
|
DO I=1,NSTATEV
|
||
|
ASTATEV(I)=STATEOLD(KM,I)
|
||
|
END DO
|
||
|
|
||
|
DO I=1,NDIR+NSHR
|
||
|
ASTRESS(I)=STRESSOLD(KM,I)
|
||
|
END DO
|
||
|
|
||
|
c CALL DAMAGE(NDIR,NSHR,NPROPS,NSTATEV,ASTRESS,STRAN,
|
||
|
c * PROPS,ASTATEV,TOTALTIME,
|
||
|
c * DELATS)
|
||
|
|
||
|
DO I=1,NSTATEV
|
||
|
STATEOLD(KM,I)=ASTATEV(I)
|
||
|
END DO
|
||
|
C
|
||
|
C----- Update STRESSOLD to STRESSNEW
|
||
|
C
|
||
|
DO I=1,NDIR+NSHR
|
||
|
STRESSNEW(KM,I)=STRESSOLD(KM,I)
|
||
|
END DO
|
||
|
|
||
|
C----- Update STATEOLD to STATENEW for 1 - NSTATEV
|
||
|
C
|
||
|
DO I=1,NSTATEV
|
||
|
STATENEW(KM,I)=STATEOLD(KM,I)
|
||
|
END DO
|
||
|
|
||
|
IF (NSHR.GT.1) THEN
|
||
|
SAVE=STRAININC(KM,5)
|
||
|
STRAININC(KM,5)=STRAININC(KM,6)
|
||
|
STRAININC(KM,6)=SAVE
|
||
|
|
||
|
SAVE=STRESSNEW(KM,5)
|
||
|
STRESSNEW(KM,5)=STRESSNEW(KM,6)
|
||
|
STRESSNEW(KM,6)=SAVE
|
||
|
END IF
|
||
|
|
||
|
4000 CONTINUE
|
||
|
|
||
|
3000 CONTINUE
|
||
|
|
||
|
END IF
|
||
|
|
||
|
RETURN
|
||
|
END
|
||
|
|
||
|
C----------------------------------------------------------------------
|
||
|
|
||
|
|
||
|
SUBROUTINE ROTATION (PROP, ROTATE)
|
||
|
|
||
|
|
||
|
C----- This subroutine calculates the rotation matrix, i.e. the
|
||
|
C direction cosines of cubic crystal [100], [010] and [001]
|
||
|
C directions in global system
|
||
|
|
||
|
C----- The rotation matrix is stored in the array ROTATE.
|
||
|
|
||
|
C----- Use single precision on cray
|
||
|
C
|
||
|
include 'vaba_param.inc'
|
||
|
|
||
|
|
||
|
DIMENSION PROP(16),ROTATE(3,3),TERM1(3,3),TERM2(3,3),INDX(3)
|
||
|
|
||
|
C----- Subroutines:
|
||
|
C
|
||
|
C CROSS -- cross product of two vectors
|
||
|
C
|
||
|
C LUDCMP -- LU decomposition
|
||
|
C
|
||
|
C LUBKSB -- linear equation solver based on LU decomposition
|
||
|
C method (must call LUDCMP first)
|
||
|
|
||
|
|
||
|
C----- PROP -- constants characterizing the crystal orientation
|
||
|
C (INPUT)
|
||
|
C
|
||
|
C PROP(1) - PROP(3) -- direction of the first vector in
|
||
|
C local cubic crystal system
|
||
|
C PROP(4) - PROP(6) -- direction of the first vector in
|
||
|
C global system
|
||
|
C
|
||
|
C PROP(9) - PROP(11)-- direction of the second vector in
|
||
|
C local cubic crystal system
|
||
|
C PROP(12)- PROP(14)-- direction of the second vector in
|
||
|
C global system
|
||
|
C
|
||
|
C----- ROTATE -- rotation matrix (OUTPUT):
|
||
|
C
|
||
|
C ROTATE(i,1) -- direction cosines of direction [1 0 0] in
|
||
|
C local cubic crystal system
|
||
|
C ROTATE(i,2) -- direction cosines of direction [0 1 0] in
|
||
|
C local cubic crystal system
|
||
|
C ROTATE(i,3) -- direction cosines of direction [0 0 1] in
|
||
|
C local cubic crystal system
|
||
|
|
||
|
C----- local matrix: TERM1
|
||
|
CALL CROSS (PROP(1), PROP(9), TERM1, ANGLE1)
|
||
|
|
||
|
C----- LU decomposition of TERM1
|
||
|
CALL LUDCMP (TERM1, 3, 3, INDX, DCMP)
|
||
|
|
||
|
C----- inverse matrix of TERM1: TERM2
|
||
|
DO J=1,3
|
||
|
DO I=1,3
|
||
|
IF (I.EQ.J) THEN
|
||
|
TERM2(I,J)=1.
|
||
|
ELSE
|
||
|
TERM2(I,J)=0.
|
||
|
END IF
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
DO J=1,3
|
||
|
|
||
|
CALL LUBKSB (TERM1, 3, 3, INDX, TERM2(1,J))
|
||
|
|
||
|
END DO
|
||
|
|
||
|
C----- global matrix: TERM1
|
||
|
CALL CROSS (PROP(4), PROP(12), TERM1, ANGLE2)
|
||
|
|
||
|
C----- Check: the angle between first and second vector in local and
|
||
|
C global systems must be the same. The relative difference must be
|
||
|
C less than 0.1%.
|
||
|
C
|
||
|
IF (ABS(ANGLE1/ANGLE2-1.).GT.0.001) THEN
|
||
|
WRITE (6,*)
|
||
|
2 '***ERROR - angles between two vectors are not the same'
|
||
|
STOP
|
||
|
END IF
|
||
|
|
||
|
C----- rotation matrix: ROTATE
|
||
|
DO J=1,3
|
||
|
DO I=1,3
|
||
|
ROTATE(I,J)=0.
|
||
|
DO K=1,3
|
||
|
ROTATE(I,J)=ROTATE(I,J)+TERM1(I,K)*TERM2(K,J)
|
||
|
END DO
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
RETURN
|
||
|
END
|
||
|
|
||
|
|
||
|
C-----------------------------------
|
||
|
|
||
|
|
||
|
SUBROUTINE CROSS (A, B, C, ANGLE)
|
||
|
|
||
|
|
||
|
C----- (1) normalize vectors A and B to unit vectors
|
||
|
C (2) store A, B and A*B (cross product) in C
|
||
|
|
||
|
C----- Use single precision on cray
|
||
|
C
|
||
|
include 'vaba_param.inc'
|
||
|
|
||
|
DIMENSION A(3), B(3), C(3,3)
|
||
|
|
||
|
|
||
|
SUM1=SQRT(A(1)**2+A(2)**2+A(3)**2)
|
||
|
SUM2=SQRT(B(1)**2+B(2)**2+B(3)**2)
|
||
|
|
||
|
IF (SUM1.EQ.0.) THEN
|
||
|
WRITE (6,*) '***ERROR - first vector is zero'
|
||
|
STOP
|
||
|
ELSE
|
||
|
DO I=1,3
|
||
|
C(I,1)=A(I)/SUM1
|
||
|
END DO
|
||
|
END IF
|
||
|
|
||
|
IF (SUM2.EQ.0.) THEN
|
||
|
WRITE (6,*) '***ERROR - second vector is zero'
|
||
|
STOP
|
||
|
ELSE
|
||
|
DO I=1,3
|
||
|
C(I,2)=B(I)/SUM2
|
||
|
END DO
|
||
|
END IF
|
||
|
|
||
|
ANGLE=0.
|
||
|
DO I=1,3
|
||
|
ANGLE=ANGLE+C(I,1)*C(I,2)
|
||
|
END DO
|
||
|
ANGLE=ACOS(ANGLE)
|
||
|
|
||
|
C(1,3)=C(2,1)*C(3,2)-C(3,1)*C(2,2)
|
||
|
C(2,3)=C(3,1)*C(1,2)-C(1,1)*C(3,2)
|
||
|
C(3,3)=C(1,1)*C(2,2)-C(2,1)*C(1,2)
|
||
|
SUM3=SQRT(C(1,3)**2+C(2,3)**2+C(3,3)**2)
|
||
|
IF (SUM3.LT.1.E-8) THEN
|
||
|
WRITE (6,*)
|
||
|
2 '***ERROR - first and second vectors are parallel'
|
||
|
STOP
|
||
|
END IF
|
||
|
|
||
|
RETURN
|
||
|
END
|
||
|
|
||
|
C----------------------------------------------------------------------
|
||
|
|
||
|
SUBROUTINE SLIPSYS (ISPDIR, ISPNOR, NSLIP, SLPDIR, SLPNOR,
|
||
|
2 ROTATE)
|
||
|
|
||
|
C----- This subroutine generates all slip systems in the same set for
|
||
|
C a CUBIC crystal. For other crystals (e.g., HCP, Tetragonal,
|
||
|
C Orthotropic, ...), it has to be modified to include the effect of
|
||
|
C crystal aspect ratio.
|
||
|
|
||
|
C----- Denote s as a slip direction and m as normal to a slip plane.
|
||
|
C In a cubic crystal, (s,-m), (-s,m) and (-s,-m) are NOT considered
|
||
|
C independent of (s,m).
|
||
|
|
||
|
C----- Subroutines: LINE
|
||
|
|
||
|
C----- Variables:
|
||
|
C
|
||
|
C ISPDIR -- a typical slip direction in this set of slip systems
|
||
|
C (integer) (INPUT)
|
||
|
C ISPNOR -- a typical normal to slip plane in this set of slip
|
||
|
C systems (integer) (INPUT)
|
||
|
C NSLIP -- number of independent slip systems in this set
|
||
|
C (OUTPUT)
|
||
|
C SLPDIR -- unit vectors of all slip directions (OUTPUT)
|
||
|
C SLPNOR -- unit normals to all slip planes (OUTPUT)
|
||
|
C ROTATE -- rotation matrix (INPUT)
|
||
|
C ROTATE(i,1) -- direction cosines of [100] in global system
|
||
|
C ROTATE(i,2) -- direction cosines of [010] in global system
|
||
|
C ROTATE(i,3) -- direction cosines of [001] in global system
|
||
|
C
|
||
|
C NSPDIR -- number of all possible slip directions in this set
|
||
|
C NSPNOR -- number of all possible slip planes in this set
|
||
|
C IWKDIR -- all possible slip directions (integer)
|
||
|
C IWKNOR -- all possible slip planes (integer)
|
||
|
|
||
|
|
||
|
C----- Use single precision on cray
|
||
|
C
|
||
|
include 'vaba_param.inc'
|
||
|
DIMENSION ISPDIR(3), ISPNOR(3), SLPDIR(3,50), SLPNOR(3,50),
|
||
|
* ROTATE(3,3), IWKDIR(3,24), IWKNOR(3,24), TERM(3)
|
||
|
|
||
|
NSLIP=0
|
||
|
NSPDIR=0
|
||
|
NSPNOR=0
|
||
|
|
||
|
C----- Generating all possible slip directions in this set
|
||
|
C
|
||
|
C Denote the slip direction by [lmn]. I1 is the minimum of the
|
||
|
C absolute value of l, m and n, I3 is the maximum and I2 is the
|
||
|
C mode, e.g. (1 -3 2), I1=1, I2=2 and I3=3. I1<=I2<=I3.
|
||
|
|
||
|
I1=MIN(IABS(ISPDIR(1)),IABS(ISPDIR(2)),IABS(ISPDIR(3)))
|
||
|
I3=MAX(IABS(ISPDIR(1)),IABS(ISPDIR(2)),IABS(ISPDIR(3)))
|
||
|
I2=IABS(ISPDIR(1))+IABS(ISPDIR(2))+IABS(ISPDIR(3))-I1-I3
|
||
|
|
||
|
RMODIR=SQRT(FLOAT(I1*I1+I2*I2+I3*I3))
|
||
|
|
||
|
C I1=I2=I3=0
|
||
|
IF (I3.EQ.0) THEN
|
||
|
WRITE (6,*) '***ERROR - slip direction is [000]'
|
||
|
STOP
|
||
|
|
||
|
C I1=0, I3>=I2>0
|
||
|
ELSE IF (I1.EQ.0) THEN
|
||
|
|
||
|
C I1=0, I3=I2>0 --- [011] type
|
||
|
IF (I2.EQ.I3) THEN
|
||
|
NSPDIR=6
|
||
|
DO J=1,6
|
||
|
DO I=1,3
|
||
|
IWKDIR(I,J)=I2
|
||
|
IF (I.EQ.J.OR.J-I.EQ.3) IWKDIR(I,J)=0
|
||
|
IWKDIR(1,6)=-I2
|
||
|
IWKDIR(2,4)=-I2
|
||
|
IWKDIR(3,5)=-I2
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
ELSE
|
||
|
WRITE(6,*)'***ERROR - slip direction is not [011]'
|
||
|
STOP
|
||
|
|
||
|
END IF
|
||
|
|
||
|
END IF
|
||
|
|
||
|
C----- Generating all possible slip planes in this set
|
||
|
C
|
||
|
C Denote the normal to slip plane by (pqr). J1 is the minimum of
|
||
|
C the absolute value of p, q and r, J3 is the maximum and J2 is the
|
||
|
C mode, e.g. (1 -2 1), J1=1, J2=1 and J3=2. J1<=J2<=J3.
|
||
|
|
||
|
J1=MIN(IABS(ISPNOR(1)),IABS(ISPNOR(2)),IABS(ISPNOR(3)))
|
||
|
J3=MAX(IABS(ISPNOR(1)),IABS(ISPNOR(2)),IABS(ISPNOR(3)))
|
||
|
J2=IABS(ISPNOR(1))+IABS(ISPNOR(2))+IABS(ISPNOR(3))-J1-J3
|
||
|
|
||
|
RMONOR=SQRT(FLOAT(J1*J1+J2*J2+J3*J3))
|
||
|
|
||
|
IF (J3.EQ.0) THEN
|
||
|
WRITE (6,*) '***ERROR - slip plane is [000]'
|
||
|
STOP
|
||
|
|
||
|
C (111) type
|
||
|
ELSE IF (J1.EQ.J3) THEN
|
||
|
NSPNOR=4
|
||
|
CALL LINE (J1, J1, J1, IWKNOR)
|
||
|
|
||
|
ELSE
|
||
|
WRITE (6,*) '***ERROR - slip plane not (111)'
|
||
|
STOP
|
||
|
|
||
|
END IF
|
||
|
|
||
|
C----- Generating all slip systems in this set
|
||
|
C
|
||
|
C----- Unit vectors in slip directions: SLPDIR, and unit normals to
|
||
|
C slip planes: SLPNOR in local cubic crystal system
|
||
|
C
|
||
|
|
||
|
DO J=1,NSPNOR
|
||
|
DO I=1,NSPDIR
|
||
|
|
||
|
IDOT=0
|
||
|
DO K=1,3
|
||
|
IDOT=IDOT+IWKDIR(K,I)*IWKNOR(K,J)
|
||
|
END DO
|
||
|
|
||
|
IF (IDOT.EQ.0) THEN
|
||
|
NSLIP=NSLIP+1
|
||
|
DO K=1,3
|
||
|
SLPDIR(K,NSLIP)=IWKDIR(K,I)/RMODIR
|
||
|
SLPNOR(K,NSLIP)=IWKNOR(K,J)/RMONOR
|
||
|
END DO
|
||
|
|
||
|
END IF
|
||
|
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
IF (NSLIP.EQ.0) THEN
|
||
|
WRITE (6,*)
|
||
|
* 'There is no slip direction normal to the slip planes!'
|
||
|
STOP
|
||
|
|
||
|
ELSE
|
||
|
|
||
|
C----- Unit vectors in slip directions: SLPDIR, and unit normals to
|
||
|
C slip planes: SLPNOR in global system
|
||
|
C
|
||
|
DO J=1,NSLIP
|
||
|
DO I=1,3
|
||
|
TERM(I)=0.
|
||
|
DO K=1,3
|
||
|
TERM(I)=TERM(I)+ROTATE(I,K)*SLPDIR(K,J)
|
||
|
END DO
|
||
|
END DO
|
||
|
DO I=1,3
|
||
|
SLPDIR(I,J)=TERM(I)
|
||
|
END DO
|
||
|
|
||
|
DO I=1,3
|
||
|
TERM(I)=0.
|
||
|
DO K=1,3
|
||
|
TERM(I)=TERM(I)+ROTATE(I,K)*SLPNOR(K,J)
|
||
|
END DO
|
||
|
END DO
|
||
|
DO I=1,3
|
||
|
SLPNOR(I,J)=TERM(I)
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
END IF
|
||
|
|
||
|
RETURN
|
||
|
END
|
||
|
|
||
|
|
||
|
C----------------------------------
|
||
|
|
||
|
|
||
|
SUBROUTINE LINE (I1, I2, I3, IARRAY)
|
||
|
|
||
|
|
||
|
C----- Generating all possible slip directions <lmn> (or slip planes
|
||
|
C {lmn}) for a cubic crystal, where l,m,n are not zeros.
|
||
|
|
||
|
C----- Use single precision on cray
|
||
|
C
|
||
|
include 'vaba_param.inc'
|
||
|
DIMENSION IARRAY(3,4)
|
||
|
|
||
|
DO J=1,4
|
||
|
IARRAY(1,J)=I1
|
||
|
IARRAY(2,J)=I2
|
||
|
IARRAY(3,J)=I3
|
||
|
END DO
|
||
|
|
||
|
DO I=1,3
|
||
|
DO J=1,4
|
||
|
IF (J.EQ.I+1) IARRAY(I,J)=-IARRAY(I,J)
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
RETURN
|
||
|
END
|
||
|
|
||
|
|
||
|
C-----------------------------------
|
||
|
|
||
|
C----------------------------------------------------------------------
|
||
|
|
||
|
|
||
|
SUBROUTINE GSLPINIT (GSLIP0, NSLIP, NSLPTL, NSET, PROP, NBLOCK)
|
||
|
|
||
|
|
||
|
C----- This subroutine calculates the initial value of current
|
||
|
C strength for each slip system in a rate-dependent single crystal.
|
||
|
C Two sets of initial values, proposed by Asaro, Pierce et al, and
|
||
|
C by Bassani, respectively, are used here. Both sets assume that
|
||
|
C the initial values for all slip systems are the same (initially
|
||
|
C isotropic).
|
||
|
|
||
|
C----- These initial values are assumed the same for all slip systems
|
||
|
C in each set, though they could be different from set to set, e.g.
|
||
|
C <110>{111} and <110>{100}.
|
||
|
|
||
|
C----- Users who want to use their own initial values may change the
|
||
|
C function subprogram GSLP0. The parameters characterizing these
|
||
|
C initial values are passed into GSLP0 through array PROP.
|
||
|
|
||
|
C----- Use single precision on cray
|
||
|
C
|
||
|
include 'vaba_param.inc'
|
||
|
EXTERNAL GSLP0
|
||
|
DIMENSION GSLIP0(NBLOCK,NSLPTL), NSLIP(NSET), PROP(16,NSET)
|
||
|
|
||
|
C----- Function subprograms:
|
||
|
C
|
||
|
C GSLP0 -- User-supplied function subprogram given the initial
|
||
|
C value of current strength at initial state
|
||
|
|
||
|
C----- Variables:
|
||
|
C
|
||
|
C GSLIP0 -- initial value of current strength (OUTPUT)
|
||
|
C
|
||
|
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 characterising 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(1,ID)=GSLP0(NSLPTL,NSET,NSLIP,PROP(1,I),ID,ISET)
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
RETURN
|
||
|
END
|
||
|
|
||
|
|
||
|
|
||
|
C----------------------------------
|
||
|
|
||
|
|
||
|
C----- Use single precision on cray
|
||
|
C
|
||
|
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
|
||
|
include 'vaba_param.inc'
|
||
|
DIMENSION NSLIP(NSET), PROP(16)
|
||
|
|
||
|
GSLP0=PROP(3)
|
||
|
|
||
|
RETURN
|
||
|
END
|
||
|
|
||
|
|
||
|
C----------------------------------------------------------------------
|
||
|
|
||
|
|
||
|
SUBROUTINE STRAINRATE (GAMMA, TAUSLP, GSLIP, NSLIP, FSLIP,
|
||
|
2 DFDXSP, PROP, NBLOCK)
|
||
|
|
||
|
|
||
|
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
|
||
|
include 'vaba_param.inc'
|
||
|
EXTERNAL F, DFDX
|
||
|
DIMENSION GAMMA(NBLOCK,NSLIP), TAUSLP(NBLOCK,NSLIP),
|
||
|
2 GSLIP(NBLOCK,NSLIP),FSLIP(NSLIP),DFDXSP(NSLIP),PROP(8)
|
||
|
|
||
|
DO I=1,NSLIP
|
||
|
X=TAUSLP(1,I)/GSLIP(1,I)
|
||
|
FSLIP(I)=F(X,PROP)
|
||
|
DFDXSP(I)=DFDX(X,PROP)
|
||
|
END DO
|
||
|
|
||
|
RETURN
|
||
|
END
|
||
|
|
||
|
|
||
|
C-----------------------------------
|
||
|
|
||
|
|
||
|
C----- Use single precision on cray
|
||
|
C
|
||
|
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
|
||
|
include 'vaba_param.inc'
|
||
|
DIMENSION PROP(8)
|
||
|
|
||
|
TEMP=(ABS(X))**PROP(1)
|
||
|
F=PROP(2)*TEMP*DSIGN(1.D0,X)
|
||
|
|
||
|
RETURN
|
||
|
END
|
||
|
|
||
|
|
||
|
C-----------------------------------
|
||
|
|
||
|
|
||
|
C----- Use single precision on cray
|
||
|
C
|
||
|
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
|
||
|
include 'vaba_param.inc'
|
||
|
DIMENSION PROP(8)
|
||
|
|
||
|
TEMP=(ABS(X))**(PROP(1)-1.0)
|
||
|
DFDX=PROP(1)*PROP(2)*TEMP
|
||
|
|
||
|
RETURN
|
||
|
END
|
||
|
|
||
|
|
||
|
C----------------------------------------------------------------------
|
||
|
|
||
|
|
||
|
SUBROUTINE LATENTHARDEN (GAMMA, TAUSLP, GSLIP, GAMTOL, NSLIP,
|
||
|
2 NSLPTL, NSET, H, PROP, ND, NBLOCK)
|
||
|
|
||
|
|
||
|
C----- This subroutine calculates the current self- and latent-
|
||
|
C hardening moduli for all slip systems in a rate-dependent single
|
||
|
C crystal. Two kinds of hardening law are used here. The first
|
||
|
C law, proposed by Asaro, and Pierce et al, assumes a HYPER SECANT
|
||
|
C relation between self- and latent-hardening moduli and overall
|
||
|
C shear strain. The Bauschinger effect has been neglected. The
|
||
|
C second is Bassani's hardening law, which gives an explicit
|
||
|
C expression of slip interactions between slip systems. The
|
||
|
C classical three stage hardening for FCC single crystal could be
|
||
|
C simulated.
|
||
|
|
||
|
C----- The hardening coefficients 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}.
|
||
|
|
||
|
C----- Users who want to use their own self- and latent-hardening law
|
||
|
C may change the function subprograms HSELF (self hardening) and
|
||
|
C HLATNT (latent hardening). The parameters characterizing these
|
||
|
C hardening laws are passed into HSELF and HLATNT through array
|
||
|
C PROP.
|
||
|
|
||
|
|
||
|
C----- Function subprograms:
|
||
|
C
|
||
|
C HSELF -- User-supplied self-hardening function in a slip
|
||
|
C system
|
||
|
C
|
||
|
C HLATNT -- User-supplied latent-hardening function
|
||
|
|
||
|
C----- Variables:
|
||
|
C
|
||
|
C GAMMA -- shear strain in all slip systems at the start of time
|
||
|
C step (INPUT)
|
||
|
C TAUSLP -- resolved shear stress in all slip systems (INPUT)
|
||
|
C GSLIP -- current strength (INPUT)
|
||
|
C GAMTOL -- total cumulative shear strains over all slip systems
|
||
|
C (INPUT)
|
||
|
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 H -- current value of self- and latent-hardening moduli
|
||
|
C (OUTPUT)
|
||
|
C H(i,i) -- self-hardening modulus of the ith slip system
|
||
|
C (no sum over i)
|
||
|
C H(i,j) -- latent-hardening molulus of the ith slip
|
||
|
C system due to a slip in the jth slip system
|
||
|
C (i not equal j)
|
||
|
C
|
||
|
C PROP -- material constants characterizing the self- and latent-
|
||
|
C hardening law (INPUT)
|
||
|
C
|
||
|
C For the HYPER SECANT hardening 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 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 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 ND -- leading dimension of arrays defined in subroutine UMAT
|
||
|
C (INPUT)
|
||
|
|
||
|
|
||
|
C----- Use single precision on cray
|
||
|
C
|
||
|
include 'vaba_param.inc'
|
||
|
EXTERNAL HSELF, HLATNT
|
||
|
DIMENSION GAMMA(NBLOCK,NSLPTL), TAUSLP(NBLOCK,NSLPTL),
|
||
|
2 GSLIP(NBLOCK,NSLPTL),NSLIP(NSET),PROP(16,NSET),H(ND,NSLPTL)
|
||
|
|
||
|
CHECK=0.
|
||
|
|
||
|
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 LATENT=1,NSLPTL
|
||
|
IF (LATENT.EQ.ISELF) THEN
|
||
|
H(LATENT,ISELF)=HSELF(GAMMA,GAMTOL,NSLPTL,NSET,NSLIP,
|
||
|
2 PROP(1,I),CHECK,ISELF,ISET,NBLOCK)
|
||
|
ELSE
|
||
|
H(LATENT,ISELF)=HLATNT(GAMMA,GAMTOL,NSLPTL,NSET,
|
||
|
2 NSLIP,PROP(1,I),CHECK,ISELF,
|
||
|
3 ISET,LATENT,NBLOCK)
|
||
|
END IF
|
||
|
END DO
|
||
|
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
RETURN
|
||
|
END
|
||
|
|
||
|
|
||
|
C-----------------------------------
|
||
|
|
||
|
|
||
|
C----- Use single precision on cray
|
||
|
C
|
||
|
FUNCTION HSELF(GAMMA,GAMTOL,NSLPTL,NSET,NSLIP,PROP,
|
||
|
2 CHECK,ISELF,ISET,NBLOCK)
|
||
|
|
||
|
|
||
|
C----- User-supplied self-hardening function in a slip system
|
||
|
|
||
|
C----- Use single precision on cray
|
||
|
C
|
||
|
include 'vaba_param.inc'
|
||
|
DIMENSION GAMMA(NBLOCK,NSLPTL), NSLIP(NSET), PROP(16)
|
||
|
|
||
|
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))
|
||
|
HSELF=PROP(1)*TERM2**2
|
||
|
|
||
|
RETURN
|
||
|
END
|
||
|
|
||
|
|
||
|
C-----------------------------------
|
||
|
|
||
|
|
||
|
C----- Use single precision on cray
|
||
|
C
|
||
|
FUNCTION HLATNT(GAMMA,GAMTOL,NSLPTL,NSET,NSLIP,PROP,
|
||
|
2 CHECK,ISELF,ISET,LATENT,NBLOCK)
|
||
|
|
||
|
|
||
|
C----- User-supplied latent-hardening function
|
||
|
|
||
|
C----- Use single precision on cray
|
||
|
C
|
||
|
include 'vaba_param.inc'
|
||
|
DIMENSION GAMMA(NBLOCK,NSLPTL), NSLIP(NSET), PROP(16)
|
||
|
|
||
|
ILOWER=0
|
||
|
IUPPER=NSLIP(1)
|
||
|
|
||
|
Q=PROP(9)
|
||
|
|
||
|
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))
|
||
|
HLATNT=PROP(1)*TERM2**2*Q
|
||
|
|
||
|
RETURN
|
||
|
END
|
||
|
|
||
|
C----------------------------------------------------------------------
|
||
|
|
||
|
SUBROUTINE LUDCMP (A, N, NP, INDX, D)
|
||
|
|
||
|
|
||
|
C----- LU decomposition
|
||
|
|
||
|
C----- Use single precision on cray
|
||
|
C
|
||
|
include 'vaba_param.inc'
|
||
|
PARAMETER (NMAX=200, TINY=1.0E-20)
|
||
|
DIMENSION A(NP,NP), INDX(N), VV(NMAX)
|
||
|
|
||
|
D=1.
|
||
|
DO I=1,N
|
||
|
AAMAX=0.
|
||
|
|
||
|
DO J=1,N
|
||
|
IF (ABS(A(I,J)).GT.AAMAX) AAMAX=ABS(A(I,J))
|
||
|
END DO
|
||
|
|
||
|
IF (AAMAX.EQ.0.) PAUSE 'Singular matrix.'
|
||
|
VV(I)=1./AAMAX
|
||
|
END DO
|
||
|
|
||
|
DO J=1,N
|
||
|
DO I=1,J-1
|
||
|
SUM=A(I,J)
|
||
|
|
||
|
DO K=1,I-1
|
||
|
SUM=SUM-A(I,K)*A(K,J)
|
||
|
END DO
|
||
|
|
||
|
A(I,J)=SUM
|
||
|
END DO
|
||
|
AAMAX=0.
|
||
|
|
||
|
DO I=J,N
|
||
|
SUM=A(I,J)
|
||
|
|
||
|
DO K=1,J-1
|
||
|
SUM=SUM-A(I,K)*A(K,J)
|
||
|
END DO
|
||
|
|
||
|
A(I,J)=SUM
|
||
|
DUM=VV(I)*ABS(SUM)
|
||
|
IF (DUM.GE.AAMAX) THEN
|
||
|
IMAX=I
|
||
|
AAMAX=DUM
|
||
|
END IF
|
||
|
END DO
|
||
|
|
||
|
IF (J.NE.IMAX) THEN
|
||
|
DO K=1,N
|
||
|
DUM=A(IMAX,K)
|
||
|
A(IMAX,K)=A(J,K)
|
||
|
A(J,K)=DUM
|
||
|
END DO
|
||
|
|
||
|
D=-D
|
||
|
VV(IMAX)=VV(J)
|
||
|
END IF
|
||
|
|
||
|
INDX(J)=IMAX
|
||
|
IF (A(J,J).EQ.0.) A(J,J)=TINY
|
||
|
IF (J.NE.N) THEN
|
||
|
DUM=1./A(J,J)
|
||
|
DO I=J+1,N
|
||
|
A(I,J)=A(I,J)*DUM
|
||
|
END DO
|
||
|
END IF
|
||
|
|
||
|
END DO
|
||
|
|
||
|
RETURN
|
||
|
END
|
||
|
|
||
|
|
||
|
C----------------------------------------------------------------------
|
||
|
|
||
|
|
||
|
SUBROUTINE LUBKSB (A, N, NP, INDX, B)
|
||
|
|
||
|
|
||
|
C----- Linear equation solver based on LU decomposition
|
||
|
|
||
|
C----- Use single precision on cray
|
||
|
C
|
||
|
include 'vaba_param.inc'
|
||
|
DIMENSION A(NP,NP), INDX(N), B(N)
|
||
|
|
||
|
II=0
|
||
|
DO I=1,N
|
||
|
LL=INDX(I)
|
||
|
SUM=B(LL)
|
||
|
B(LL)=B(I)
|
||
|
|
||
|
IF (II.NE.0) THEN
|
||
|
DO J=II,I-1
|
||
|
SUM=SUM-A(I,J)*B(J)
|
||
|
END DO
|
||
|
ELSE IF (SUM.NE.0.) THEN
|
||
|
II=I
|
||
|
END IF
|
||
|
|
||
|
B(I)=SUM
|
||
|
END DO
|
||
|
|
||
|
DO I=N,1,-1
|
||
|
SUM=B(I)
|
||
|
|
||
|
IF (I.LT.N) THEN
|
||
|
DO J=I+1,N
|
||
|
SUM=SUM-A(I,J)*B(J)
|
||
|
END DO
|
||
|
END IF
|
||
|
|
||
|
B(I)=SUM/A(I,I)
|
||
|
END DO
|
||
|
|
||
|
RETURN
|
||
|
END
|
||
|
C
|
||
|
C-----------------------------------------
|
||
|
C
|
||
|
SUBROUTINE DAMAGE(NDIR,NSHR,NPROPS,NSTATEV,STRESSOLD,STRAN,
|
||
|
* PROPS,STATEOLD,TOTALTIME,
|
||
|
* DELATS)
|
||
|
C
|
||
|
include 'vaba_param.inc'
|
||
|
C
|
||
|
DIMENSION STRAN(NDIR+NSHR), STRESSOLD(NDIR+NSHR)
|
||
|
DIMENSION ELASS(NDIR+NSHR), PLASS(NDIR+NSHR)
|
||
|
DIMENSION DELATS(NDIR+NSHR)
|
||
|
DIMENSION PROPS(NPROPS)
|
||
|
DIMENSION STATEOLD(NSTATEV)
|
||
|
C
|
||
|
C Modify stress from failure
|
||
|
C
|
||
|
C----- Use single precision on cray
|
||
|
C
|
||
|
C----- Calculate elastic strains at start of increment
|
||
|
C
|
||
|
IF (STATEOLD(NSTATEV-7).EQ.0.0) THEN
|
||
|
ELASS(1)=STRAN(1)
|
||
|
ELASS(2)=STRAN(2)
|
||
|
ELASS(3)=STRAN(3)
|
||
|
ELASS(4)=STRAN(4)
|
||
|
ELSE
|
||
|
ELASS(1)=STATEOLD(NSTATEV-7)
|
||
|
ELASS(2)=STATEOLD(NSTATEV-6)
|
||
|
ELASS(3)=STATEOLD(NSTATEV-5)
|
||
|
ELASS(4)=STATEOLD(NSTATEV-4)
|
||
|
END IF
|
||
|
C
|
||
|
C----- Calculate the plastic strains
|
||
|
C
|
||
|
PLASS(1)=STRAN(1)-ELASS(1)
|
||
|
PLASS(2)=STRAN(2)-ELASS(2)
|
||
|
PLASS(3)=STRAN(3)-ELASS(3)
|
||
|
PLASS(4)=STRAN(4)-ELASS(4)
|
||
|
C
|
||
|
C----- Calculate the equivalent plastic strain
|
||
|
C
|
||
|
PEEQ=PLASS(1)*PLASS(1)+PLASS(2)*PLASS(2)
|
||
|
* +PLASS(3)*PLASS(3)+PLASS(4)*PLASS(4)
|
||
|
PEEQ=SQRT(2.*PEEQ/3.)
|
||
|
C
|
||
|
C----- Calculate the increment of equivalent plastic strain
|
||
|
C & update equivalent plastic strain (SDV)
|
||
|
C
|
||
|
DEPL=PEEQ-STATEOLD(NSTATEV-8)
|
||
|
STATEOLD(NSTATEV-8)=PEEQ
|
||
|
C
|
||
|
C----- Calculate stress invariants
|
||
|
C
|
||
|
CALL SINV(STRESSOLD,SINV1,SINV2,NDIR,NSHR)
|
||
|
|
||
|
IF (SINV2.NE.0.0) THEN
|
||
|
TRIAX=SINV1/SINV2
|
||
|
ELSE
|
||
|
TRIAX=0.
|
||
|
ENDIF
|
||
|
|
||
|
IF (TRIAX.GE.100.) TRIAX=0.
|
||
|
C
|
||
|
C----- Calculate the damage parameter
|
||
|
C
|
||
|
STATEOLD(NSTATEV-9)=STATEOLD(NSTATEV-9)+
|
||
|
* 1./PROPS(161)*EXP(PROPS(162)*TRIAX)*DEPL
|
||
|
C
|
||
|
IF(STATEOLD(NSTATEV-9).GE.1.0)THEN
|
||
|
STATEOLD(NSTATEV-10)=0.
|
||
|
ENDIF
|
||
|
C
|
||
|
C----- Store elastic strains
|
||
|
C
|
||
|
STATEOLD(NSTATEV-7)=STATEOLD(NSTATEV-7)+DELATS(1)
|
||
|
STATEOLD(NSTATEV-6)=STATEOLD(NSTATEV-6)+DELATS(2)
|
||
|
STATEOLD(NSTATEV-5)=STATEOLD(NSTATEV-5)+DELATS(3)
|
||
|
STATEOLD(NSTATEV-4)=STATEOLD(NSTATEV-4)+DELATS(4)
|
||
|
C
|
||
|
RETURN
|
||
|
|
||
|
END
|
||
|
C
|
||
|
C-----------------------------------------
|
||
|
C
|
||
|
SUBROUTINE SINV(STRESSOLD, SINV1, SINV2, NDIR, NSHR)
|
||
|
C
|
||
|
include 'vaba_param.inc'
|
||
|
C
|
||
|
DIMENSION STRESSOLD(NDIR+NSHR)
|
||
|
C
|
||
|
SINV1=0.
|
||
|
DO I=1, NDIR
|
||
|
SINV1=SINV1+STRESSOLD(I)
|
||
|
END DO
|
||
|
|
||
|
SINV1=SINV1/3.
|
||
|
|
||
|
SINV2=0.
|
||
|
|
||
|
DO I=1,NDIR
|
||
|
SINV2=SINV2+STRESSOLD(I)*STRESSOLD(I)
|
||
|
END DO
|
||
|
|
||
|
DO I=1,NDIR
|
||
|
DO J=1,NDIR
|
||
|
IF(I.LT.J) THEN
|
||
|
SINV2=SINV2-STRESSOLD(I)*STRESSOLD(J)
|
||
|
END IF
|
||
|
END DO
|
||
|
END DO
|
||
|
|
||
|
DO I=1,NSHR
|
||
|
SINV2=SINV2+3*(STRESSOLD(NDIR+I)*STRESSOLD(NDIR+I))
|
||
|
END DO
|
||
|
|
||
|
SINV2=SQRT(SINV2)
|
||
|
|
||
|
RETURN
|
||
|
|
||
|
END
|