      ! ************************************************************************
      
      ! THIS MODULE IS A CONTAINER FOR THE INITIALISATION AND SOLUTION
      ! OF A USER STRENGTH MODEL
      
      ! THE FOLLOWING ROUTINES ARE INCLUDED:

      ! MODULE STR_USER_1
      !   DEFINE VARIABLES THAT ARE COMMON BETWEEN THE ROUTINES BELOW

      ! SUBROUTINE INIT_STR_USER_1
      !   DEFINE THE INPUT PARAMETERS FOR THE USER STRENGTH MODEL

      ! SUBROUTINE CHECK_STR_USER_1
      !   CHECK PARAMETERS ARE VALID FOR THE USER STRENGTH MODEL

      ! SUBROUTINE SET_STR_USER_1
      !   SET SHORTCUTS TO PARAMETERS FOR THE USER STRENGTH MODEL

      ! SUBROUTINE SOLVE_STR_USER_1
      !   SOLVE THE USER STRENGTH MODEL

      ! BEFORE EACH ROUTINE IS CALLED, THE FOLLOWING POINTERS ARE SET-UP
      !   MTL - POINTER TO THE CURRENT MATERIAL
      !   EQ  - POINTER TO THE CURRENT FLAG/EQUATION/MATERIAL OPTION

      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      ! NOTE: CARE SHOULD BE TAKEN WHEN USING THIS MATERIAL MODEL WITH THE 
      !       ANP TETRAHEDRAL ELEMENTS. IT IS HIGHLY RECOMMENDED THAT YOU
      !       CONTACT ANSYS FOR ADVICE ON THE TYPES OF MATERIALS
      !       APPLICABLE TO THE ANP TERTRAHEDRAL ELEMENT.
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

      ! ************************************************************************

      MODULE STR_USER_1
      USE kindef
      IMPLICIT NONE
      SAVE

      ! SPECIFY COMMON VARIABLES TO BE ACCESSED BY ROUITNES BELOW HERE
      !INTEGER(INT4) ::
      !REAL(REAL8) ::
      REAL(REAL8), DIMENSION(50) :: SC
      
      END MODULE STR_USER_1


      SUBROUTINE INIT_STR_USER_1(IFACT)

      USE material
      USE str_user_1

      IMPLICIT NONE

      INTEGER (INT4) ::   IFACT

      ! ************************************************************************

      ! THIS SUBROUTINE INITIALISES (ALLOCATES) PARAMETERS AND DATA

      ! FLAG - IMF_STR_USER_1

      ! INPUT - IFACT = 0 JUST GET NAME OF EQUATION AND DEPENDANT FLAGS
      !         IFACT = 1 EQUATION IS ACTIVE HENCE ALLOCATE

      ! ************************************************************************

      ! DEFINE PARAMETERS TO ALLOW ALLOCATION
      EQ%EQTYPE = IMF_STR_USER_1   ! DO NOT MODIFY THIS LINE
      EQ%NAME = 'User Strength #1' 
      EQ%NPAR = 11                 ! NUMBER OF REAL INPUT PARAMETER (MINIMUM OF 1)
      EQ%NUMOPT = 0                ! NUMBER OF OPTION LISTS
      EQ%NDEPFLG = 0               ! NUMBER OF NON-OPTIONAL DEPENDANT (CHILD) FLAGS/MODEL OPTION
      EQ%NCHAR = 0
      EQ%NPAR_VEC = 0

      IF (IFACT==1) THEN
        CALL ALLOC_EQ ! DO NOT MODIFY THIS LINE, ALLOCATES MEMORY

        ! FOR EACH REAL INPUT PARAMETER, ASSIGN DATA
        !                ('name    '     L, T,M,H, val, min,max,default,0,required)
        EQ%PAR(1)=PRMT (1,'Shear Modulus',-1,-2,1,0,ZERO,ZERO,BIG,ZERO   ,0,1)  ! THIS LINE MUST ALWAYS EXIST
        EQ%PAR(2)=PRMT (2,'SC(2)'        ,-1,-2,1,0,ZERO,ZERO,BIG,ZERO   ,0,0)
        EQ%PAR(3)=PRMT (3,'SC(3)'        ,-1,-2,1,0,ZERO,ZERO,BIG,ZERO   ,0,0)
        EQ%PAR(4)=PRMT (4,'SC(4)'        ,-1,-2,1,0,ZERO,ZERO,BIG,ZERO   ,0,0)
        EQ%PAR(5)=PRMT (5,'SC(5)'        ,-1,-2,1,0,ZERO,ZERO,BIG,ZERO   ,0,0)
        EQ%PAR(6)=PRMT (6,'SC(6)'        ,-1,-2,1,0,ZERO,ZERO,BIG,ZERO   ,0,0)
        EQ%PAR(7)=PRMT (7,'SC(7)'        ,-1,-2,1,0,ZERO,ZERO,BIG,ZERO   ,0,0)
        EQ%PAR(8)=PRMT (8,'SC(8)'        ,-1,-2,1,0,ZERO,ZERO,BIG,ZERO   ,0,0)
        EQ%PAR(9)=PRMT (9,'SC(9)'        ,-1,-2,1,0,ZERO,ZERO,BIG,ZERO   ,0,0)
        EQ%PAR(10)=PRMT(10,'SC(10)'       ,-1,-2,1,0,ZERO,ZERO,BIG,ZERO   ,0,0)
        EQ%PAR(11)=PRMT(11,'SC(11)'       ,-1,-2,1,0,ZERO,ZERO,BIG,ZERO   ,0,0)

        ! FOR EACH OPTION LIST, ASSIGN DATA
        !   FOR EXAMPLE, 
        !   EQ%OPTION(1)%NAME = 'Strain rate dependant'  ! OPTION LIST NAME
        !   EQ%OPTION(1)%NUMOPT = 2          ! NUMBER OF OPTIONS IN THE LIST
        !   EQ%OPTION(1)%DEFAULT = 1         ! DEFAULT OPTION
        !   EQ%OPTION(1)%SELECTED = 1        ! SELECTED OPTION
        !   CALL ALLOC_OPTION(1)             ! ALLOCATE THE MEMORY
        !   DEFINE OPTIONS
        !                                ('name  ',active,' ',0 / Dependant (child) flag)
        !   EQ%OPTION(1)%OPTS(1) = OPTION('Yes','Y',' ',0)
        !   EQ%OPTION(1)%OPTS(2) = OPTION('No','Y',' ',0)

        ! FOR EACH NON-OPTIONAL DEPENDANT (CHILD) FLAG/MODEL OPTION, ASSIGN DEPENDANT FLAG
        !EQ%DEPFLG(1) = IMF_YP_PCWISE
      ENDIF

      ! SET IN ACTIVE SWITCH FOR APPROPRIATE PROCESSOR TYPE:: ALL ON BY DEFAULT
      EQ%IFSOLVER(ISLV_FCT) = 0

      RETURN
      END SUBROUTINE INIT_STR_USER_1


      SUBROUTINE SET_STR_USER_1

      USE material
      USE str_user_1

      IMPLICIT NONE

      ! ************************************************************************

      ! THIS SUBROUTINE ASSIGNS SHORTCUTS FOR DIRECT USE IN THE SOLVER

      ! ************************************************************************

      ! FOR EXAMPLE
      SHRMDZ = EQ%PAR(1)%VAL  ! THIS LINE MUST BE PRESENT
      SC(1) = EQ%PAR(1)%VAL
      SC(2) = EQ%PAR(2)%VAL
      SC(3) = EQ%PAR(3)%VAL
      SC(4) = EQ%PAR(4)%VAL
      SC(5) = EQ%PAR(5)%VAL
      SC(6) = EQ%PAR(6)%VAL
      SC(7) = EQ%PAR(7)%VAL
      SC(8) = EQ%PAR(8)%VAL
      SC(9) = EQ%PAR(9)%VAL
      SC(10) = EQ%PAR(10)%VAL
      SC(11) = EQ%PAR(11)%VAL

      !   ISEL_OPT = EQ%OPTION(1)%SELECTED

      RETURN

      END SUBROUTINE SET_STR_USER_1

      SUBROUTINE CHECK_STR_USER_1

      USE material
      USE str_user_1

      IMPLICIT NONE

      ! ************************************************************************

      ! THIS SUBROUTINE CHECKS EOS INPUT DATA

      ! ************************************************************************

      ! PLACE USER CHECKS HERE

      RETURN

      END SUBROUTINE CHECK_STR_USER_1

      SUBROUTINE SOLVE_STR_USER_1_2D (PRES,TT1,TT2,TT3,XMUT,EPST,EPSD,TEMPT,DAMAGE,YIELDT,IFAIL)

      USE material
      USE str_user_1
      USE cycvar
      USE edtdef
      USE ijknow
      USE wrapup
      USE mdgrid

      IMPLICIT NONE

      INTEGER (INT1) ::  IFAIL
      INTEGER (INT4) ::    IJK
      REAL (REAL8)   ::   EPSD,    EPST,   PRES,   TEMPT,    TT1,    TT2
      REAL (REAL8)   ::    TT3,    XMUT, YIELDT, DAMAGE

      ! ************************************************************************

      ! THIS IS A USER SUPPLIED SUBROUTINE WHICH CAN BE USED TO COMPUTE
      ! THE YIELD STRESS FOR A MATERIAL

      ! INPUT PARAMETER

      ! PRES    PRESSURE
      ! Tnn     PRINCIPAL STRESSES
      ! XMUT     COMPRESSION
      ! EPST     EFFECTIVE PLASTIC STRAIN
      ! EPSD    EFFECTIVE PLASTIC STRAIN RATE
      ! TEMP    TEMPERATURE
      ! DAMAGE  DAMAGE
      ! IFAIL   STRESS STATE INDICATOR
      ! = 0   HYDRO
      ! = 1   ELASTIC
      ! = 2   PLASTIC
      ! = 3   BULK FAILURE (WITH HEAL)
      ! = 4   BULK FAILURE (NO HEAL)

      ! OUTPUT PARAMETERS

      ! YIELDT    YIELD STRESS FOR CURRENT MATERIAL
      ! IFAIL     STRESS STATE INDICATOR (SEE ABOVE)

      ! THE FOLLOWING MODULES CONTAIN INFORMATION WHICH MAY BE
      ! USEFUL FOR COMPUTING THE OUTPUT PARAMETERS :-

      ! MODULE  'IJKNOW'

      ! INOW - I INDEX FOR CURRENT CELL
      ! JNOW - J INDEX FOR CURRENT CELL
      ! MNOW - CURRENT SUBGRID NUMBER

      ! MODULE  'MATDEF'
      ! MATNO         -  THE MATERIAL NUMBER OF THE CURRENT MATERIAL
      ! MATERIALS(MATNO)%NAME -  THE MATERIAL NAME OF THE CURRENT MATERIAL

      ! MODULE  'CYCVAR'
      ! NCYCLE - CURRENT CYCLE NUMBER
      ! TIME   - CURRENT TIME
      ! DLTH   - TIME STEP FOR CURRENT CYCLE

      ! MODULE  'EDTDEF'
      ! NTCODE - DIMENSIONS: 2 = 2D, 3 = 3D

      ! EN(IJK)   -  CELL SPECIFIC INTERNAL ENERGY
      ! DAM(IJK)  -  DAMAGE

      ! TO OBTAIN THE VALUE OF THE INDEX IJK FOR THE CURRENT CELL, USE
      !   IJK = IJSET(INOW,JNOW)
      ! THE INDEX IJK MUST ALSO BE DEFINED AS AN INTEGER:  -  INTEGER (INT4) ::   IJK

      ! ************************************************************************

      ! SUBROUTINE CALLED BY ALL STRENGTH MODELS SO SKIP OUT, BY DEFAULT
      IF (NSTR/=IMF_STR_USER_1) GO TO 900

      ! TEMPORARY ERROR MESSAGE - REPLACE WITH YOUR OWN CODE
      CALL USR_MESSAG ('User subroutine STR_USER_1_2D missing')
      NSWRAP = 9

      ! TO ACCESS A V4.3 USER SUBROUITNE FOR AUTODYN-2D, UNCOMMENT THE NEXT LINE
      !CALL EXYLD (PRES,TT1,TT2,TT3,XMUT,EPST,EPSD,TEMPT,YIELDT,IFAIL)


  900 RETURN

      END SUBROUTINE SOLVE_STR_USER_1_2D

      SUBROUTINE SOLVE_STR_USER_1_3D (PRES,TT1,TT2,TT3,XMUT,EPST,EPSD,TEMPT,DAMAGE,YIELDT,IFAIL)

      USE material
      USE str_user_1
      USE cycvar
      USE edtdef
      USE ijknow
      USE wrapup
      USE mdgrid3

      IMPLICIT NONE

      INTEGER (INT1) ::  IFAIL
      INTEGER (INT4) ::    IJK
      REAL (REAL8)   ::   EPSD,    EPST,   PRES,   TEMPT,    TT1,    TT2
      REAL (REAL8)   ::    TT3,    XMUT, YIELDT, DAMAGE

      ! ************************************************************************

      ! THIS IS A USER SUPPLIED SUBROUTINE WHICH CAN BE USED TO COMPUTE
      ! THE YIELD STRESS FOR A MATERIAL

      ! INPUT PARAMETER

      ! PRES    PRESSURE
      ! Tnn     PRINCIPAL STRESSES
      ! XMUT     COMPRESSION
      ! EPST     EFFECTIVE PLASTIC STRAIN
      ! EPSD    EFFECTIVE PLASTIC STRAIN RATE
      ! TEMP    TEMPERATURE
      ! DAMAGE  DAMAGE
      ! IFAIL   STRESS STATE INDICATOR
      ! = 0   HYDRO
      ! = 1   ELASTIC
      ! = 2   PLASTIC
      ! = 3   BULK FAILURE (WITH HEAL)
      ! = 4   BULK FAILURE (NO HEAL)

      ! OUTPUT PARAMETERS

      ! YIELDT    YIELD STRESS FOR CURRENT MATERIAL
      ! IFAIL     STRESS STATE INDICATOR (SEE ABOVE)

      ! THE FOLLOWING MODULES CONTAIN INFORMATION WHICH MAY BE
      ! USEFUL FOR COMPUTING THE OUTPUT PARAMETERS :-

      ! MODULE  'IJKNOW'

      ! INOW - I INDEX FOR CURRENT CELL
      ! JNOW - J INDEX FOR CURRENT CELL
      ! KNOW - K INDEX FOR CURRENT CELL
      ! MNOW - CURRENT SUBGRID NUMBER

      ! MODULE  'MATDEF'
      ! MATNO         -  THE MATERIAL NUMBER OF THE CURRENT MATERIAL
      ! MATERIALS(MATNO)%NAME -  THE MATERIAL NAME OF THE CURRENT MATERIAL

      ! MODULE  'CYCVAR'
      ! NCYCLE - CURRENT CYCLE NUMBER
      ! TIME   - CURRENT TIME
      ! DLTH   - TIME STEP FOR CURRENT CYCLE

      ! MODULE  'EDTDEF'
      ! NTCODE - DIMENSIONS: 2 = 2D, 3 = 3D

      ! THE FOLLOWING GRID VARIABLES MAY ALSO BE USEFUL :-
      ! ML(NCEN)   -  CELL SPECIFIC INTERN3AL ENERGY
      ! XMU (IJK) -  CELL COMPRESSION (RHO/RHOREF-ONE)
      ! ML(NCDM)  -  DAMAGE

      ! TO OBTAIN THE VALUE OF THE INDEX IJK FOR THE CURRENT CELL, USE
      !   IJK = IJKSET3(INOW,JNOW,KNOW)
      ! THE INDEX IJK MUST ALSO BE DEFINED AS AN INTEGER:  -  INTEGER (INT4) ::   IJK

      ! ************************************************************************

      ! SUBROUTINE CALLED BY ALL STRENGTH MODELS SO SKIP OUT, BY DEFAULT
      IF (NSTR/=IMF_STR_USER_1) GO TO 900

      ! TEMPORARY ERROR MESSAGE - REPLACE WITH YOUR OWN CODE
      CALL USR_MESSAG ('User subroutine STR_USER_1_3D missing')
      NSWRAP = 9

      ! TO ACCESS A V4.3 USER SUBROUITNE FOR AUTODYN-3D, UNCOMMENT THE NEXT LINE
      !CALL EXYLD (PRES,TT1,TT2,TT3,XMUT,EPST,EPSD,TEMPT,YIELDT,IFAIL)
      ! ALSO NOTE:: USE mdgrid3 AND NOT mdgrid for AUTODYN-3D


  900 RETURN

      END SUBROUTINE SOLVE_STR_USER_1_3D

      SUBROUTINE SOLVE_STR_USER_1_3D_SHELL (IFAIL, DSTN1 ,DSTN2 ,DSTN3 ,DSTN12,DSTN23,DSTN31, &
                                                   SSN1  ,SSN2  ,SSN3  ,SSN12 ,SSN23 ,SSN31 , &
                                                   STR1N ,STR2N ,STR12N,STR23N,STR31N)

      USE material
      USE str_user_1
      USE cycvar
      USE ijknow
      USE wrapup
      USE mdgrid3
      USE locelm

      IMPLICIT NONE

      INTEGER (INT1) ::  IFAIL
      REAL (REAL8)   ::  DSTN1,  DSTN2,  DSTN3, DSTN12, DSTN23, DSTN31
      REAL (REAL8)   ::   SSN1,   SSN2,   SSN3,  SSN12,  SSN23,  SSN31
      REAL (REAL8)   ::  STR1N,  STR2N, STR12N, STR23N, STR31N

      ! ************************************************************************

      ! THIS IS A USER SUPPLIED SUBROUTINE WHICH CAN BE USED TO COMPUTE
      ! THE STRESSES FOR A SUBLAYER OF SHELL ELEMENT

      ! INPUT PARAMETER

      ! IFAIL   STRESS STATE INDICATOR
      ! = 0   HYDRO
      ! = 1   ELASTIC
      ! = 2   PLASTIC
      ! = 3   BULK FAILURE (WITH HEAL)
      ! = 4   BULK FAILURE (NO HEAL)

      ! DSTN1   STRAIN INCREMENT IN LOCAL 11 DIRECTION
      ! DSTN2   STRAIN INCREMENT IN LOCAL 22 DIRECTION
      ! DSTN3   STRAIN INCREMENT IN LOCAL 33 DIRECTION (THROUGH THICKNESS)
      ! DSTN12  SHEAR STRAIN INCREMENT IN LOCAL 12 DIRECTION
      ! DSTN23  SHEAR STRAIN INCREMENT IN LOCAL 23 DIRECTION
      ! DSTN31  SHEAR STRAIN INCREMENT IN LOCAL 31 DIRECTION

      ! SSN1    TOTAL STRAIN IN LOCAL 11 DIRECTION
      ! SSN2    TOTAL STRAIN IN LOCAL 22 DIRECTION
      ! SSN3    TOTAL STRAIN IN LOCAL 33 DIRECTION (THROUGH THICKNESS)
      ! SSN12   TOTAL SHEAR STRAIN IN LOCAL 12 DIRECTION
      ! SSN23   TOTAL SHEAR STRAIN IN LOCAL 23 DIRECTION
      ! SSN31   TOTAL SHEAR STRAIN IN LOCAL 31 DIRECTION

      ! OUTPUT PARAMETERS

      ! STR1N   STRESS IN LOCAL 11 DIRECTION
      ! STR2N   STRESS IN LOCAL 22 DIRECTION
      ! STR12N  SHEAR STRESS IN LOCAL 12 DIRECTION
      ! STR23N  SHEAR STRESS IN LOCAL 23 DIRECTION
      ! STR31N  SHEAR STRESS IN LOCAL 31 DIRECTION

      ! NOTE THAT THROUGH THICKNESS STRESS STR3N FOR SHELLS IS ALWAYS ZERO

      ! THE FOLLOWING MODULES CONTAIN INFORMATION WHICH MAY BE
      ! USEFUL FOR COMPUTING THE OUTPUT PARAMETERS :-

      ! MODULE  'IJKNOW'

      ! INOW - I INDEX FOR CURRENT CELL
      ! JNOW - J INDEX FOR CURRENT CELL
      ! KNOW - K INDEX FOR CURRENT CELL
      ! MNOW - CURRENT SUBGRID NUMBER

      ! MODULE  'MATDEF'
      ! MATNO                 -  THE MATERIAL NUMBER OF THE CURRENT MATERIAL
      ! MATERIALS(MATNO)%NAME -  THE MATERIAL NAME OF THE CURRENT MATERIAL

      ! MODULE  'CYCVAR'
      ! NCYCLE - CURRENT CYCLE NUMBER
      ! TIME   - CURRENT TIME
      ! DLTH   - TIME STEP FOR CURRENT CYCLE

      ! MODULE 'LOCELM'
      ! IJK     - THE INDEX IJK FOR THE CURRENT CELL
      ! LELM(1) - THE INDEX FOR NODE 1 OF THE CURRENT CELL
      ! LELM(2) - THE INDEX FOR NODE 2 OF THE CURRENT CELL
      ! LELM(3) - THE INDEX FOR NODE 3 OF THE CURRENT CELL
      ! LELM(4) - THE INDEX FOR NODE 4 OF THE CURRENT CELL

      ! THE FOLLOWING GRID VARIABLES MAY ALSO BE USEFUL :-
      ! XN0(IJK) -  INITIAL X CO-ORDINATE OF NODE IJK
      ! YN0(IJK) -  INITIAL Y CO-ORDINATE OF NODE IJK
      ! ZN0(IJK) -  INITIAL Z CO-ORDINATE OF NODE IJK
      ! XN(IJK)  -  CURRENT X CO-ORDINATE OF NODE IJK
      ! YN(IJK)  -  CURRENT Y CO-ORDINATE OF NODE IJK
      ! ZN(IJK)  -  CURRENT Z CO-ORDINATE OF NODE IJK

      ! ************************************************************************

      ! SUBROUTINE CALLED BY ALL STRENGTH MODELS SO SKIP OUT, BY DEFAULT
      IF (NSTR/=IMF_STR_USER_1) GO TO 900

      ! TEMPORARY ERROR MESSAGE - REPLACE WITH YOUR OWN CODE
      CALL USR_MESSAG ('User subroutine SOLVE_STR_USER_1_3D_SHELL missing')
      NSWRAP = 9

  900 RETURN

      END SUBROUTINE SOLVE_STR_USER_1_3D_SHELL

