jgrogan/phd-scripts
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
phd-scripts/UndergraduateThesis/CrystalPlasticity/vucrystal_new_elrem.for

2194 lines
70 KiB
Text
Raw Normal View History

Add scripts and inp files.
2024-05-13 19:50:21 +00:00
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),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),A(2,2)
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
A(1,1)=STRAININC(KM,I)
STATEOLD(KM,NSTATEV-15+I)=STATEOLD(KM,NSTATEV-15+I)+A(1,1)
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),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),STATEOLD(KM,2*NSLPTL+ID),
2 STATEOLD(KM,ID),NSLIP(I),FSLIP(ID), DFDXSP(ID),
3 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.O)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.O) 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)*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
CALL DAMAGE(NDIR,NSHR,NPROPS,NSTATEV,ASTRESS,STRAN,
* PROPS,ASTATEV,TOTALTIME,
* 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),NSLIP(NSET),
2 GSLIP(NBLOCK,NSLPTL), 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
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./1.65*EXP(0.4*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
Reference in a new issue Copy permalink