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 (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