      SUBROUTINE EXALE (IREZ,JREZ,NREZ,XREZ,YREZ)

      USE mdgrid
      USE kindef
      USE material
      USE matdef
      USE subdef
      USE wrapup

      IMPLICIT NONE

      INTEGER (INT4) ::   IREZ,   JREZ,   NREZ
      REAL (REAL8)   ::   XREZ,   YREZ

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

      ! THIS SUBROUTINE COMPUTES THE CONSTRAINED GRID VELOCITIES FOR
      ! VERTICES ASSIGNED THE "USER" MOTION CONSTRAINT

      ! INPUT PARAMETERS:

      !    IREZ - I INDEX FOR VERTEX TO BE CONSTRAINED
      !    JREZ - J INDEX FOR VERTEX TO BE CONSTRAINED
      !    NREZ - SUBGRID # FOR VERTEX TO BE CONSTRAINED
      !    XREZ - CURRENT X-COORDINATE OF VERTEX
      !    YREZ - CURRENT Y-COORDINATE OF VERTEX

      ! OUTPUT PARAMETERS:

      !    XREZ - CONSTRAINED X-COORDINATE OF VERTEX
      !    YREZ - CONSTRAINED Y-COORDINATE OF VERTEX

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

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

      RETURN

      END SUBROUTINE EXALE

      SUBROUTINE EXACC (XC,YC,ACCX,ACCY)

      USE kindef

      IMPLICIT NONE

      REAL (REAL8)   ::   ACCX, ACCY,XC, YC

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

      ! THIS SUBROUTINE ADDS AN ACCELERATION TO EACH NODE 

      ! INPUT PARAMETERS:
      !    XC       X-COORDINATE OF CURRENT NODE
      !    YC       Y-COORDINATE OF CURRENT NODE
      !    N.B. FOR AN UNSTRUCTURED RIGID BODY THE ROUTINE EXACC IS ONLY CALLED 
      !         FOR THE CENTRE OF GRAVITY(XC,YC) 
      !         THE ACCELLERATION IS THEN APPLIED TO THE CENTRE OF GRAVITY

      ! OUTPUT PARAMETERS:

      !    ACCX     ACCELERATION COMPONENT IN X-DIRECTION
      !    ACCY     ACCELERATION COMPONENT IN Y-DIRECTION

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

      RETURN

      END SUBROUTINE EXACC

      SUBROUTINE EXBULK (BULK)

      ! USE mdgrid
      USE kindef
      USE ijknow
      USE locelm
      USE material
      USE matdef
      USE wrapup

      IMPLICIT NONE

      ! INTEGER (INT4) ::   IJK
      REAL (REAL8)   ::   BULK

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

      ! THIS IS A USER SUPPLIED SUBROUTINE WHICH CAN BE USED TO MODIFY
      ! THE BULK MODULUS OF A MATERIAL USING A LINEAR EOS

      ! INPUT PARAMETER

      !    BULK      CONSTANT BULK MODULUS FOR CURRENT MATERIAL
      !              (ASSIGNED THROUGH INPUT)

      ! OUTPUT PARAMETER

      !    BULK      MODIFIED BULK MODULUS FOR CURRENT MATERIAL

      ! 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
      !                NAMMAT(MATNO) -  THE MATERIAL NAME OF THE
      !                                 CURRENT MATERIAL

      ! MODULE  'CYCVAR'

      !                NCYCLE - CURRENT CYCLE NUMBER
      !                TIME   - CURRENT TIME
      !                DLTH   - TIME STEP FOR CURRENT CYCLE

      ! THE FOLLOWING GRID VARIABLES MAY ALSO BE USEFUL :-

      ! PN(IJK)     -  CELL PRESSURE
      ! EN(IJK)     -  CELL SPECIFIC INTERNAL ENERGY
      ! XMU(IJK)    -  CELL COMPRESSION (RHO/RHOREF-ONE)
      ! EPS(IJK)    -  EFFECTIVE PLASTIC STRAIN
      ! EPSDOT(IJK) -  EFFECTIVE PLASTIC STRAIN RATE
      ! TEMP(IJK)   -  TEMPERATURE
      ! DAM(IJK)    -  DAMAGE

      ! TO OBTAIN THE VALUE OF THE INDEX IJK FOR THE CURRENT CELL, USE
      ! FUNCTION 'IJSET' :-

      ! IJK = IJSET (INOW,JNOW)

      ! IN ORDER TO USE THE FUNCTION 'IJSET', THE USER MUST INCLUDE THE
      ! MODULE 'MDGRID' AT THE TOP OF THIS SUBROUTINE: - USE mdgrid.

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

      RETURN

      END SUBROUTINE EXBULK

      SUBROUTINE EXCOMP (GALPA,ALPHAP,PP)

      ! USE mdgrid
      USE kindef
      USE ijknow
      USE material
      USE matdef
      USE wrapup

      IMPLICIT NONE

      ! INTEGER (INT4) ::   IJK
      REAL (REAL8)   ::  GALPA, ALPHAP,   PP

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

      ! THIS IS A USER SUPPLIED SUBROUTINE WHICH CAN BE USED TO DEFINE
      ! THE POROUS COMPACTION CURVE FOR THE P-ALPHA EQUATION OF STATE

      ! THE STANDARD EQUATION IS AS FOLLOWS:

      ! IF (PP>PACP) THEN
      !   GALPA = ONE
      ! ELSE
      !   GALPA = ONE + (ALPHAP - ONE)*((PACP - PP)/(PACP - PAEL))**PAEN
      ! END IF

      ! INPUT PARAMETERS:

      !    ALPHAP
      !    PP       CURRENT CELL PRESSURE

      ! OUTPUT PARAMETER:

      !    GALPA    PLASTIC COMPACTION CURVE FUNCTION G(ALPHA)

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

      ! MODULE  'MATDEF'
      !                PACP -
      !                PAEL -
      !                PAEN - COMPACTION EXPONENT N

      ! MODULE  'IJKNOW'

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

      ! MODULE  'CYCVAR'

      !                NCYCLE - CURRENT CYCLE NUMBER
      !                TIME   - CURRENT TIME
      !                DLTH   - TIME STEP FOR CURRENT CYCLE

      ! THE FOLLOWING GRID VARIABLES MAY ALSO BE USEFUL :-

      ! PN(IJK)     -  CELL PRESSURE
      ! T11(IJK)
      ! T22(IJK)
      ! TTT(IJK)
      ! TO OBTAIN THE VALUE OF THE INDEX IJK FOR THE CURRENT CELL, USE
      ! FUNCTION 'IJSET' :-

      ! IJK = IJSET (INOW,JNOW)

      ! IN ORDER TO USE THE FUNCTION 'IJSET', THE USER MUST INCLUDE THE
      ! MODULE 'MDGRID' AT THE TOP OF THIS SUBROUTINE: - USE mdgrid.
      ! THE INDEX IJK MUST ALSO BE DEFINED AS AN INTEGER:  -  INTEGER (INT4) ::   IJK

      ! ************************************************************************
      CALL USR_MESSAG ('$User subroutine EXCOMP missing$')
      NSWRAP = 9

      RETURN

      END SUBROUTINE EXCOMP

      SUBROUTINE EXCRCK (DCRACK,ECRINC,SLOPE)

      ! USE mdgrid
      USE kindef
      USE ijknow
      USE material
      USE matdef
      USE wrapup

      IMPLICIT NONE

      ! INTEGER (INT4) ::   IJK
      REAL (REAL8)   :: DCRACK, ECRINC,  SLOPE

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

      ! THIS IS A USER SUPPLIED SUBROUTINE WHICH CAN BE USED TO DEFINE
      ! THE RATE AT WHICH TENSILE CRACK SOFTENING TAKES PLACE WITHIN A CELL

      ! INPUT PARAMETER

      !    DCRACK   CURRENT CRACK DAMAGE INCRMENT CALCULATED BY AUTODYN
      !             BASED ON A LINEAR CRACK SOFTENING ALGORITHM
      !    ECRINC   CURRENT INCREMENT IN CRACK STRAIN
      !    SLOPE    SLOPE USED IN LINEAR SOFTENING ALGORITHM

      ! OUTPUT PARAMETER

      !    DCRACK   MODIFIED INCREMENT IN CRACK DAMAGE FOR CELL

      ! 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  'CYCVAR'

      !                NCYCLE - CURRENT CYCLE NUMBER
      !                TIME   - CURRENT TIME
      !                DLTH   - TIME STEP FOR CURRENT CYCLE

      ! THE FOLLOWING GRID VARIABLES MAY ALSO BE USEFUL :-

      ! PN(IJK)     -  CELL PRESSURE
      ! T11(IJK)
      ! T22(IJK)
      ! TTT(IJK)
      ! TO OBTAIN THE VALUE OF THE INDEX IJK FOR THE CURRENT CELL, USE
      ! FUNCTION 'IJSET' :-

      ! IJK = IJSET (INOW,JNOW)

      ! IN ORDER TO USE THE FUNCTION 'IJSET', THE USER MUST INCLUDE THE
      ! MODULE 'MDGRID' AT THE TOP OF THIS SUBROUTINE: - USE mdgrid.
      ! THE INDEX IJK MUST ALSO BE DEFINED AS AN INTEGER:  -  INTEGER (INT4) ::   IJK

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

      RETURN

      END SUBROUTINE EXCRCK

      SUBROUTINE EXDAM (DAMAGE, EPSINC, PRES, ENN, XMUN, EPSN, EPSD, TEMPN)

      ! USE mdgrid
      USE kindef
      USE ijknow
      USE material
      USE matdef
      USE wrapup

      IMPLICIT NONE

      ! INTEGER (INT4) ::   IJK
      REAL (REAL8)   :: DAMAGE, EPSINC, PRES, ENN, XMUN, EPSN, EPSD, TEMPN

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

      ! THIS IS A USER SUPPLIED SUBROUTINE WHICH CAN BE USED TO DEFINE
      ! THE THE DAMAGE PARAMETER FOR A CELL. THE DAMAGE PARAMETER IS NOT
      ! CURRENTLY USED BY AUTODYN. HOWEVER A USER MAY WANT TO DEFINE A
      ! DAMAGE PARAMETER HERE TO BE USED IN SUBROUTINES EXBULK, EXSHR AND
      ! EXYLD TO MODIFY THE BULK AND SHEAR MODULUS AND YIELD STRESS OF A
      ! MATERIAL THAT IS FAILED OR DAMAGED

      ! INPUT PARAMETER
      !
      ! DAMAGE  - CURRENT DAMAGE PARAMETER FOR CELL
      !           (ZERO UNLESS PREVIOUSLY MODIFIED BY THIS ROUTINE)
      ! EPSINC  - PLASTIC STRAIN INCREMENT
      ! PRES    - CELL PRESSURE
      ! ENN     - CELL SPECIFIC INTERNAL ENERGY
      ! XMUN    - CELL COMPRESSION (RHO/RHOREF-ONE)
      ! EPSN    - EFFECTIVE PLASTIC STRAIN
      ! EPSD    - EFFECTIVE PLASTIC STRAIN RATE
      ! TEMPN   - TEMPERATURE

      ! OUTPUT PARAMETER
      !
      ! DAMAGE  -  MODIFIED DAMAGE PARAMETER FOR CELL

      ! 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  'CYCVAR'

      !                NCYCLE - CURRENT CYCLE NUMBER
      !                TIME   - CURRENT TIME
      !                DLTH   - TIME STEP FOR CURRENT CYCLE

      ! TO OBTAIN THE VALUE OF THE INDEX IJK FOR THE CURRENT CELL, USE
      ! FUNCTION 'IJSET' :-
      !               IJK = IJSET (INOW,JNOW)
      !
      ! IN ORDER TO USE THE FUNCTION 'IJSET', THE USER MUST INCLUDE THE
      ! MODULE 'MDGRID' AT THE TOP OF THIS SUBROUTINE: - USE mdgrid.
      ! THE INDEX IJK MUST ALSO BE DEFINED AS AN INTEGER:  -  INTEGER (INT4) ::   IJK

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

      RETURN

      END SUBROUTINE EXDAM

      SUBROUTINE EXDAM2_JHUSER (JHTYPE,PRES,EPSINC,DAMAGE)

      ! USE mdgrid
      USE kindef
      USE ijknow
      USE material
      USE matdef
      USE wrapup

      IMPLICIT NONE

      ! INTEGER (INT4) ::   IJK
      INTEGER(INT4) :: JHTYPE
      REAL (REAL8)   :: PRES, EPSINC, DAMAGE

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

      ! ROUTINE TO ALLOW USER DEFINITION OF DAMAGE LAW FOR JH MODEL
      !
      ! INPUT 
      !   JHTYPE = 1, JH2 - GRADUAL FAILURE, WITH DAMAGE, DEFINED BY USER
      !   JHTYPE = 2, JH1 - ALWAYS INSTANTANEOUS FAILURE WHEN DAMAGE = 1
      !   PRES - ELEMENT PRESSURE
      !   EPSINC - ELEMENT PLASTIC STRAIN INCREMENT
      !   DAMAGE - ELEMENT DAMAGE AT PREVIOUS CYCLE
      ! 
      ! OUTPUT PARAMETER
      !   DAMAGE - UPDATED DAMAGE

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

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

      RETURN

      END SUBROUTINE EXDAM2_JHUSER


      SUBROUTINE EXEDIT

      USE kindef
      USE wrapup

      IMPLICIT NONE

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

      ! THIS IS A USER SUPPLIED SUBROUTINE WHICH CAN BE USED TO PROVIDE
      ! SPECIAL CUSTOM EDITING. THE FREQUENCY AT WHICH THIS SUBROUTINE
      ! IS CALLED IS DEFINED THROUGH INPUT (GLOBAL-EDIT-USER). WHEN
      ! REQUESTED, IT IS CALLED BY THE EDIT PROCESSOR AT THE END OF A
      ! COMPUTATIONAL CYCLE. THE ROUTINE IS CALLED BEFORE ANY OTHER
      ! TYPES OF STANDARD EDITS ARE CALLED FOR THAT CYCLE (EG. PRINT,
      ! SAVE, HISTORY, DISPLAY, ETC), SO IT MAY ALSO BE USED TO SET UP
      ! DATA TO BE PROCESSED BY OTHER EDIT TYPES.

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

      RETURN

      END SUBROUTINE EXEDIT

      SUBROUTINE EXFLOW &
      (NBDY,M,I1,J1,I2,J2,MATFLO,UXFLO,UYFLO,PFLO,DENFLO,SIEFLO)

      USE kindef
      USE cycvar

      IMPLICIT NONE

      INTEGER (INT4) ::     I1,     I2,     J1,     J2, MATFLO,      M
      INTEGER (INT4) ::   NBDY
      REAL (REAL8)   :: DENFLO,   PFLO, SIEFLO,  UXFLO,  UYFLO

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

      ! THIS IS A USER SUPPLIED SUBROUTINE WHICH ALLOWS YOU TO VARY THE
      ! FLOW PARAMETERS FOR AN EULER FLOW BOUNDARY. IT IS CALLED EACH
      ! CYCLE FOR EACH FACE OF AN EULER GRID ASSIGNED A FLOW BOUNDARY. IF
      ! YO DO NOT MODIFY THE FLOW PARAMETERS THEY WILL RETAIN THE CONSTANT
      ! VALUES YOU DEFINED ON INPUT.

      ! INPUT PARAMETERS

      !    NBDY    BOUNDARY CONDITION NUMBER
      !    M       ) FACE BEING PROCESSED IS FROM (I1,J1)
      !    I1,J1   ) TO (I2,J2) IN SUBGRID NUMBER M
      !    I2,J2   )
      !    MATFLO  FLOW MATERIAL # (VALUE DEFINED ON INPUT)
      !    UXFLO   X-COMPONENT OF FLOW VELOCITY (VALUE DEFINED ON INPUT)
      !    UYFLO   Y-COMPONENT OF FLOW VELOCITY (VALUE DEFINED ON INPUT)
      !    PFLO    PRESSURE OF FLOW MATERIAL (VALUE DEFINED ON INPUT)
      !    DENFLO  DENSITY OF FLOW MATERIAL (VALUE DEFINED ON INPUT)
      !    SIEFLO  SPECIFIC INTERNAL ENERGY OF FLOW MATERIAL (VALUE DEFINED
      !                                                            ON INPUT)
      ! OUTPUT PARAMETERS

      !    MATFLO  FLOW MATERIAL # (MODIFIED)
      !    UXFLO   X-COMPONENT OF FLOW VELOCITY (MODIFIED)
      !    UYFLO   Y-COMPONENT OF FLOW VELOCITY (MODIFIED)
      !    PFLO    PRESSURE OF FLOW MATERIAL (MODIFIED)
      !    DENFLO  DENSITY OF FLOW MATERIAL (MODIFIED)
      !    SIEFLO  SPECIFIC INTERNAL ENERGY OF FLOW MATERIAL (MODIFIED)

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

      ! MODULE  'MATDEF'
      !                NAMMAT(M) -  THE MATERIAL NAME OF THE
      !                             CURRENT MATERIAL

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

      ! MODULE  'BNDDEF'
      !                NAMBDY(NBDY) - BOUNDARY CONDITION NAME

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

      RETURN

      END SUBROUTINE EXFLOW

      SUBROUTINE EXLOAD (NTYPE)

      USE kindef
      USE fildef

      IMPLICIT NONE

      INTEGER (INT4) ::  NTYPE

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

      ! THIS IS A USER SUPPLIED SUBROUTINE WHICH ALLOWS NON-STANDARD DATA
      ! TO BE READ FROM UNFORMATTED AND FORMATTED SAVE FILES.

      ! THE ROUTINE IS CALLED EACH TIME A LOAD IS REQUESTED (THE DEFAULT
      ! ROUTINE READS NO NON-STANDARD DATA).

      ! IT IS ALSO CALLED WHEN YOU USE THE "UPDATE" AND "CONVERT" OPTIONS
      ! FROM THE POST PROCESSOR

      ! THIS ROUTINE MUST BE USED IN CONJUNCTION WITH SUBROUTINE EXSAVE
      ! WHICH APPENDS THE NON-STANDARD DATA TO THE SAVE FILE.

      ! IF NTYPE=1, YOU SHOULD READ UNFORMATTED DATA FROM UNIT "NUT1". A
      ! TYPICAL  STATEMENT WOULD BE :-

      !         READ (NUT1) NVAR1, VAR2, VAR3, VAR4

      ! IF NTYPE=2, YOU SHOULD READ FORMATTED DATA FROM UNIT "NUT2". A
      ! TYPICAL  STATEMENT WOULD BE :-

      !         READ (NUT2,1000) NVAR1, VAR2, VAR3, VAR4
      !    1000 FORMAT (I10,3ES15.8)

      ! IDENTICAL WRITE STATEMENTS SHOULD BE INSERTD IN SUBROUTINE EXSAVE
      ! THIS COMPATIBLE SUBROUTINE EXSAVE MUST BE INSERTED WHEN THE DATA
      ! IS SAVED. SEE SUBROUTINE EXSAVE FOR MORE INFORMATION.

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

      RETURN

      END SUBROUTINE EXLOAD

      SUBROUTINE EXPLRN(PRES,TT1,TT2,TT3,TVME,YLD, &
                        SXXE, SYYE, SZZE, TXYE, TYZE, TZXE, EPSINC)
      ! USE mdgrid
      USE kindef
      USE ijknow
      USE material
      USE matdef
      USE wrapup

      IMPLICIT NONE

      ! INTEGER (INT4) ::   IJK
      REAL (REAL8)   ::   PRES,   TEMP,    TT1,    TT2,    TT3,    TVME,     YLD
      REAL (REAL8)   ::   SXXE,   SYYE,   SZZE,   TXYE,   TYZE,    TZXE,  EPSINC

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

      ! THIS IS A USER SUPPLIED SUBROUTINE WHICH CAN BE USED TO COMPUTE
      ! THE NEW STRESS DEVIATORS AFTER PLASTIC FLOW

      ! INPUT PARAMETER

      ! PRES    PRESSURE
      ! TTn     TRIAL ELASTIC PRINCIPAL STRESSES
      ! TVME    TRIAL ELASTIC VON MISES STRESS
      ! YLD     CURRENT YIELD STRESS
      ! SnnE    CORRECTED DEVIATORIC STRESSES AFTER RADIAL RETURN
      !         NOTE: 
      !         THE RADIAL RETURN SCALE PARAMETER IS OBTAINED AS
      !         SCALE = YLD/TVME
      !         THUS THE TRIAL ELASTIC DEVIATORS CAN BE OBTAINED USING
      !         SnnTRIAL = SnnE/SCALE
      !         TXYTRIAL = TXYE/SCALE
      !         TYZTRIAL = TYZE/SCALE
      !         TZXTRIAL = TZXE/SCALE

      ! EPSINC  PLASTIC STRAIN INCREMENT AFTER RADIAL RETURN

      ! OUTPUT PARAMETERS

      ! SnnE    CORRECTED DEVIATORIC STRESSES AFTER USER RETURN TO YIELD SURFACE
      ! EPSINC  TOTAL PLASTIC STRAIN INCREMENT AFTER USER RETURN TO YIELD SURFACE


      ! 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
      ! NAMMAT(MATNO) -  THE MATERIAL NAME OF THE
      ! CURRENT MATERIAL

      ! MODULE  'CYCVAR'

      ! NCYCLE - CURRENT CYCLE NUMBER
      ! TIME   - CURRENT TIME
      ! DLTH   - TIME STEP FOR CURRENT CYCLE

      ! TO OBTAIN THE VALUE OF THE INDEX IJK FOR THE CURRENT CELL, USE
      ! FUNCTION 'IJKSET' :-

      ! IJK = IJKSET (INOW,JNOW)

      ! IN ORDER TO USE THE FUNCTION 'IJKSET', THE USER MUST INCLUDE THE
      ! MODULE 'MDGRID' AT THE TOP OF THIS SUBROUTINE: - USE mdgrid.
      ! THE INDEX IJK MUST ALSO BE DEFINED AS AN INTEGER:  -  INTEGER (INT4) ::   IJK

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

      ! SUBROUTINE CALLED BY ALL STRENGTH MODELS (except Johnson-Holmquist)
      ! SO SKIP OUT, BY DEFAULT

  900 RETURN

      END SUBROUTINE EXPLRN


      SUBROUTINE EXPOR (NP,XCENT,YCENT,PVP)

      USE kindef

      IMPLICIT NONE

      INTEGER (INT4) ::     NP
      REAL (REAL8)   ::    PVP,  XCENT,  YCENT

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

      ! THIS IS A USER SUPPLIED SUBROUTINE WHICH ALLOWS A VARIABLE
      ! POSROSITY TO BE ASSIGNED TO A POLYGON.

      ! INPUT PARAMETERS

      !    NP            - ID# OF POLYGON BEING PROCESSED
      !    (XCENT,YCENT) - CENTER OF EULER CELL BEING PROCESSED
      !    PVP           - CONSTANT POROSITY ASSIGNED THROUGH INPUT

      ! OUTPUT PARAMETER

      !    PVP   - MODIFIED POROSITY

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

      ! MODULE  'POLGON'

      !                NAMPOL(NP) - NAME OF POLYGON BEING PROCESSED

      ! MODULE  'IJCELL'

      !                XE1,YE1 - COORDINATES OF 1ST CORNER OF EULER CELL
      !                XE2,YE2 - COORDINATES OF 2ND CORNER OF EULER CELL
      !                XE3,YE3 - COORDINATES OF 3RD CORNER OF EULER CELL
      !                XE4,YE4 - COORDINATES OF 4TH CORNER OF EULER CELL

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

      RETURN

      END SUBROUTINE EXPOR

      SUBROUTINE EXSAVE (NTYPE)

      USE kindef
      USE fildef

      IMPLICIT NONE

      INTEGER (INT4) ::  NTYPE

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

      ! THIS IS A USER SUPPLIED SUBROUTINE WHICH ALLOWS NON-STANDARD DATA
      ! TO BE APPENDED TO THE NORMAL DATA WRITTEN FOR UNFORMATTED AND
      ! FORMATTED SAVE FILES.

      ! THE ROUTINE IS CALLED EACH TIME A SAVE EDIT IS REQUESTED (THE
      ! DEFAULT ROUTINE APPENDS NO DATA).

      ! IT IS ALSO CALLED WHEN YOU USE THE "CONVERT" OPTION FROM THE
      ! POST PROCESSOR

      ! THIS ROUTINE MUST BE USED IN CONJUNCTION WITH SUBROUTINE EXLOAD
      ! WHICH READS THE APPENDED DATA.

      ! THE ROUTINE CAN BE USED IN CONJUNCTION WITH OTHER USER SUBROUTINES
      ! TO ALLOW THE USER TO SAVE INFORMATION FOR HIS/HER CUSTOM MODELS.
      ! TO DO THIS, STORE THE RELEVENT DATA IN A NAMED MODULE AND
      ! THEN PLACE THE MODULE IN THE USER SUBROUTINES AND THIS
      ! ROUTINE

      ! IF NTYPE=1, YOU SHOULD WRITE UNFORMATTED DATA TO UNIT "NUT1". A
      ! TYPICAL  STATEMENT WOULD BE :-

      !         WRITE (NUT1) NVAR1, VAR2, VAR3, VAR4

      ! IF NTYPE=2, YOU SHOULD WRITE FORMATTED DATA TO UNIT "NUT2". A
      ! TYPICAL  STATEMENT WOULD BE :-

      !         WRITE (NUT2,1000) NVAR1, VAR2, VAR3, VAR4
      !    1000 FORMAT (I10,3ES15.8)

      ! IDENTICAL READ STATEMENTS SHOULD BE INSERTD IN SUBROUTINE EXLOAD
      ! THIS COMPATIBLE SUBROUTINE EXLOAD MUST BE INSERTD WHENEVER THE
      ! SAVED DATA IS LOADED

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

      RETURN

      END SUBROUTINE EXSAVE

      SUBROUTINE EXSHR (PRES,XMUT,EPST,EPSD,TEMPT,DAMT,SHRMOD)

      ! USE mdgrid
      USE kindef
      USE ijknow
      USE locelm
      USE material
      USE matdef
      USE wrapup

      IMPLICIT NONE

      ! INTEGER (INT4) ::   IJK
      REAL (REAL8)   ::   EPSD,    EPST,   PRES, SHRMOD,   TEMPT,    XMUT,  DAMT

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

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

      ! INPUT PARAMETERS

      !    PRES    PRESSURE
      !    XMUT    COMPRESSION
      !    EPST    EFFECTIVE PLASTIC STRAIN
      !    EPSD    EFFECTIVE PLASTIC STRAIN RATE
      !    TEMPT   TEMPERATURE
      !    DAMT    DAMAGE
      !    SHRMOD  CONSTANT SHEAR MODULUS FOR CURRENT MATERIAL
      !            (ASSIGNED THROUGH INPUT)

      ! OUTPUT PARAMETER

      !    SHRMOD  MODIFIED SHEAR MODULUS FOR CURRENT MATERIAL

      ! 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
      !                NAMMAT(MATNO) -  THE MATERIAL NAME OF THE
      !                CURRENT MATERIAL

      ! MODULE  'CYCVAR'

      !                NCYCLE - CURRENT CYCLE NUMBER
      !                TIME   - CURRENT TIME
      !                DLTH   - TIME STEP FOR CURRENT CYCLE

      ! THE FOLLOWING GRID VARIABLES MAY ALSO BE USEFUL :-

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

      ! TO OBTAIN THE VALUE OF THE INDEX IJK FOR THE CURRENT CELL, USE
      ! FUNCTION 'IJSET' :-

      ! IJK = IJSET (INOW,JNOW)

      ! IN ORDER TO USE THE FUNCTION 'IJSET', THE USER MUST INCLUDE THE
      ! MODULE 'MDGRID' AT THE TOP OF THIS SUBROUTINE: - USE mdgrid.

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

      RETURN

      END SUBROUTINE EXSHR

      SUBROUTINE EXSIE (DSIE)

      USE kindef
      USE ijknow
      USE locelm
      USE material
      USE matdef
      USE cycvar

      IMPLICIT NONE

      REAL (REAL8)   ::   DSIE

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

      ! THIS IS A USER SUPPLIED SUBROUTINE WHICH CAN BE USED TO DEPOSIT
      ! SPECIFIC INTERNAL ENERGY INTO MATERIALS IN LAGRANGE AND EULER
      ! CELLS

      ! OUTPUT PARAMETER

      !    DSIE    THE INCREMENT IN SIE TO BE DEPOSITED

      ! THE FOLLOWING MODULES CONTAIN INFORMATION WHICH MAY BE
      ! USEFUL FOR COMPUTING THE BURN FRACTION :-

      ! MODULE  'IJKNOW'

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

      ! MODULE  'LOCELM'

      !                XE1,XE2,XE3,XE4 - X-COORDINATES OF CELL CORNERS AT
      !                                  END OF CYCLE
      !                YE1,YE2,YE3,YE4 - Y-COORDINATES OF CELL CORNERS AT
      !                                  END OF CYCLE

      !                (  POINT #1 IS AT (I,J)
      !                POINT #2 IS AT (I-1,J)
      !                POINT #3 IS AT (I-1,J-1)
      !                POINT #4 IS AT (I,J-1)   )

      ! MODULE  'MATDEF'
      !                MATNO         -  THE MATERIAL NUMBER OF THE
      !                                 MATERIAL BEING PROCESSED
      !                NAMMAT(MATNO)  - THE MATERIAL NAME OF THE MATERIAL
      !                                 BEING PROCESSED

      ! MODULE  'CYCVAR'

      !                NCYCLE - CURRENT CYCLE NUMBER
      !                TIME   - CURRENT TIME
      !                DLTH   - TIME STEP FOR CURRENT CYCLE

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

      RETURN

      END SUBROUTINE EXSIE

      SUBROUTINE EXSTIF (E11,E22,E33,PR12,PR13,PR23,PR21,PR31,PR32,IFAIL)

      ! USE mdgrid
      USE kindef
      USE ijknow
      USE material
      USE matdef
      USE wrapup

      IMPLICIT NONE

      ! INTEGER (INT4) ::   IJK
      INTEGER (INT1) ::  IFAIL
      REAL (REAL8)   ::    E11,    E22,    E33,   PR12,   PR13,   PR21
      REAL (REAL8)   ::   PR23,   PR31,   PR32

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

      ! THIS IS A USER SUPPLIED SUBROUTINE WHICH CAN BE USED TO COMPUTE
      ! THE STIFFNESS MATRIX FOR AN ORTHOTROPIC ELASTIC MATERIAL WITH
      ! FAILURE .  IT IS CALLED FOR EVERY CELL THAT HAS A USER STRENGTH
      ! MODEL AND AN ORTHO EQUATION OF STATE. NOTE THAT THE SHEAR MODULUS
      ! IS COMPUTED IN USER-SUBROUTINE EXSHR.

      ! THE STIFFNESS MATRIX CAN BE UPDATED EACH CYCLE BASED ON THE PREVIOUS
      ! CYCLE CELL DIRECTIONAL STATUS FLAGS, AND ANY CURRENT USER SPECIFIED
      ! VARIABLES SUCH AS STRESS & STRAIN. EXSTIF CAN ALSO BE USED TO
      ! ACTUALLY SET THESE DIRECTIONAL STATUS FLAGS.

      ! INPUT PARAMETERS

      !    E11,E22,E33        YOUNGS MODULII FOR DIRECTIONS 11,22,33
      !    PR12,PR23,PR31     POISSONS RATIOS
      !    PR21,PR32,PR13     POISSONS RATIOS
      !    IFAIL              STRESS STATE INDICATOR FOR CELL
      !            = 0   HYDRO
      !            = 1   ELASTIC
      !            = 2   PLASTIC
      !            = 3   BULK FAILURE WITH REHEAL
      !            = 4   BULK FAILURE WITH NO REHEAL
      !            = 5   PARTIAL FAILURE INITIATION IN DIRECTION 11
      !            = 6   PARTIAL FAILURE INITIATION IN DIRECTION 22
      !            = 7   PARTIAL FAILURE INITIATION IN DIRECTION 33
      !            = 8   PARTIAL FAILURE INITIATION IN DIRECTION 12

      ! OUTPUT PARAMETER

      !    E11,E22,E33        NEW YOUNGS MODULII FOR DIRECTIONS 11,22,33
      !    PR12,PR23,PR31     NEW POISSONS RATIOS
      !    PR21,PR32,PR13     NEW POISSONS RATIOS
      !    IFAIL              NEW STRESS STATE INDICATOR FOR CELL

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

      ! MODULE 'MDGRID'

      !    T11       = STRESS IN 11 DIRECTION
      !    T22       = STRESS IN 22 DIRECTION
      !    TTT       = STRESS IN TT DIRECTION (OUT OF XY PLANE)
      !    T12       = SHEAR STRESS IN 12 (XY) PLANE

      !    STN11     = STRAIN IN 11 DIRECTION
      !    STN22     = STRAIN IN 22 DIRECTION
      !    STN33     = STRAIN IN TT DIRECTION
      !    STN12     = STRAIN IN 12 DIRECTION

      ! 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
      !                NAMMAT(MATNO) -  THE MATERIAL NAME OF THE
      !                                 CURRENT MATERIAL

      ! MODULE  'CYCVAR'

      !                NCYCLE - CURRENT CYCLE NUMBER
      !                TIME   - CURRENT TIME
      !                DLTH   - TIME STEP FOR CURRENT CYCLE

      ! THE FOLLOWING GRID VARIABLES MAY ALSO BE USEFUL :-

      ! PN(IJK)     -  CELL PRESSURE
      ! EN(IJK)     -  CELL SPECIFIC INTERNAL ENERGY
      ! XMU(IJK)    -  CELL COMPRESSION (RHO/RHOREF-ONE)
      ! EPS(IJK)    -  EFFECTIVE PLASTIC STRAIN
      ! EPSDOT(IJK) -  EFFECTIVE PLASTIC STRAIN RATE
      ! TEMP(IJK)   -  TEMPERATURE
      ! DAM(IJK)    -  DAMAGE

      ! TO OBTAIN THE VALUE OF THE INDEX IJK FOR THE CURRENT CELL, USE
      ! FUNCTION 'IJSET' :-

      ! IJK = IJSET (INOW,JNOW)

      ! IN ORDER TO USE THE FUNCTION 'IJSET', THE USER MUST INCLUDE THE
      ! MODULE 'MDGRID' AT THE TOP OF THIS SUBROUTINE: - USE mdgrid.
      ! THE INDEX IJK MUST ALSO BE DEFINED AS AN INTEGER:  -  INTEGER (INT4) ::   IJK

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

      RETURN

      END SUBROUTINE EXSTIF

      SUBROUTINE EXSTR (NAMSTR,RBC,I1,J1,I2,J2,X1,Y1,X2,Y2,PRES)

      USE kindef
      USE bnddef
      USE ijknow
      USE cycvar
      USE wrapup

      IMPLICIT NONE

      INTEGER (INT4) ::     I1,     I2,     J1,     J2
      REAL (REAL8)   ::   PRES,     X1,     X2,     Y1,     Y2
      REAL (REAL8), DIMENSION(5) :: RBC
      CHARACTER (LEN=30) :: NAMSTR

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

      ! THIS IS A USER SUPPLIED SUBROUTINE WHICH COMPUTES A BOUNDARY
      ! PRESSURE FOR A CELL FACE. THE FACE OF THE CELL MUST EITHER BE
      ! ON A GRID BOUNDARY (I=1,I=IMAX,J=1,J=JMAX) OR MUST BE ADJACENT
      ! TO AN UNUSED CELL. EXSTR IS CALLED ONCE PER CYCLE FOR EACH CELL
      ! FACE ASSIGNED THE USER STRESS CONDITION THROUGH INPUT. EXSTR IS
      ! USED IF THE BOUNDARY PRESSURE CANNOT BE DEFINED USING ONE OF THE
      ! STANDARD FUNCTIONS PROVIDED BY AUTODYN.

      ! INPUT PARAMETERS

      !    NAMSTR     BOUNDARY CONDITION NAME (DEFINED BY USER DURING INPUT)

      !    RBC(1-5)   INPUT PARAMETERS FOR BOUNDARY CONDITION

      !    I1,J1      )
      !               ) CELL FACE RUNS FROM (I1,J1) TO (I2,J2)
      !    I2,J2      )

      !    X1,Y1      COORDINATES OF (I1,J1)

      !    X2,Y2      COORDINATES OF (I2,J2)

      ! OUTPUT PARAMETERS

      !    PRES       PRESSURE TO BE APPLIED TO CELL FACE

      ! THE FOLLOWING MODULES CONTAIN INFORMATION WHICH MAY BE
      ! USEFUL FOR COMPUTING THE BOUNDARY PRESSURE :-

      ! MODULE  'IJKNOW'

      !                MNOW - CURRENT SUBGRID NUMBER

      ! MODULE  'CYCVAR'

      !                NCYCLE - CURRENT CYCLE NUMBER
      !                TIME   - CURRENT TIME
      !                DLTH   - TIME STEP FOR CURRENT CYCLE

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

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

      RETURN

      END SUBROUTINE EXSTR

      SUBROUTINE EXTAB (NPOINT,TABV,TABP,TABE,TABG,TABT,TABS)

      USE kindef
      USE material
      USE matdef
      USE wrapup

      IMPLICIT NONE

      INTEGER (INT4) :: NPOINT
      REAL (REAL8), DIMENSION(:), POINTER ::   TABE, TABG, TABP, TABS, TABT, TABV

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

      ! THIS IS A USER SUPPLIED SUBROUTINE WHICH GENERATES SATURATION
      ! CURVE DATA FOR TWO-PHASE EQUATION OF STATE.

      ! INPUT PARAMETER

      !    NPOINT  NUMBER OF POINTS TO BE GENERATEED

      ! OUTPUT PARAMETERS

      !    TABV    TABLE VALUES OF SPECIFIC VOLUME
      !    TABP    TABLE VALUES OF PRESSURE
      !    TABE    TABLE VALUES OF SPECIFIC INTERNAL ENERGY
      !    TABG    TABLE VALUES OF GAMMA
      !    TABT    TABLE VALUES OF TEMPERATURE
      !    TABS    TABLE VALUES OF SOUND SPEED

      ! IN ADDITION TO THE FORMAL PARAMETERS, MODULE "MATDEF"
      ! CONTAINS THE FOLLOWING INFORMATION

      !    MATNO          THE MATERIAL NUMBER OF THE MATERIAL BEING PROCESSED
      !    NAMMAT(MATNO)  THE MATERIAL NAME OF THE MATERIAL BEING PROCESSED

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

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

      RETURN

      END SUBROUTINE EXTAB

      SUBROUTINE EXVAL (NS,I,J,IJK,MATI,NP,RHOI,RREF,SIEI,UXI,UYI,URI)

      USE kindef
      USE bnddef

      IMPLICIT NONE

      INTEGER (INT4) ::    IJK,      I,      J,   MATI,     NP,     NS
      REAL (REAL8)   ::   RHOI,   RREF,   SIEI,    URI,    UXI,    UYI

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

      ! THIS IS A USER SUPPLIED SUBROUTINE WHICH IS CALLED AFTER FILLING
      ! ALL ONE MATERIAL CELLS OF LAGRANGE, EULER AND SHELL SUBGRIDS.
      ! YOU CAN USE THIS ROUTINE TO CUSTOM MODIFY THE INITIAL CONDITIONS
      ! FOR EACH CELL/NODE.

      ! INPUT PARAMETERS

      !    NS              CURRENT SUBGRID #
      !    I,J,IJK          INDICES FOR CURRENT CELL
      !    MATI            CURRENT MATERIAL
      !    NP              PROCESSOR TYPE
      !    RHOI            INPUT INITIAL DENSITY
      !    RREF            REFERENCE DENSITY
      !    SIEI            INPUT INITIAL SPECIFIC INTERNAL ENERGY
      !    UXI,UYI,URI     INPUT INITIAL VELOCITY COMPONENTS

      ! USE THIS ROUTINE TO SET INITIAL VALUES OF VARIABLES SUCH AS

      ! XMU(IJK)    - COMPRESSION (RHO/RREF-ONE)
      ! EN(IJK)     - SPECIFIC INTERNAL ENERGY
      ! PN(IJK)     - PRESSURE
      ! THICK(IJK)  - SHELL THICKNESS
      ! STNn(IJK)   - SHELL STRAINS
      ! TEMP(IJK)   - TEMPERATURE
      ! VARn(IJK)   - USER VARIABLES
      ! UXN(IJK)    - X-COMPONENT OF VELOCITY
      ! UYN(IJK)    - Y-COMPONENT OF VELOCITY

      ! NOTES:-

      ! ALL VARIABLES ARE CELL CENTERED EXCEPT FOR VELOCITIES WHICH
      ! ARE CELL CENTERED IN EULER SUBGRIDS BUT NODE CENTERED IN LAGRANGE
      ! AND SHELL SUBGRIDS. IF YOU WANT TO ASSIGN VELOCITIES TO THE FOUR
      ! NODES OF A CELL, THEY HAVE INDICES IJK, IJK-1, IJK-JMAXP AND
      ! IJK-JMAXP-1 (JMAXP IS IN "USE subdef").

      ! DO NOT INITIALIZE "DEN" (DENSITY) AS THIS IS COMPUTED FROM THE
      ! COMPRESSION "XMU". INITIALIZE "XMU" INSTEAD.

      ! THIS ROUTINE IS ONLY CALLED FOR CELLS CONTAINING ONE MATERIAL.
      ! IT IS NOT CALLED FOR UNUSED CELLS, VOID EULER CELLS OR EULER CELLS
      ! CONTAINING MULTIPLE MATERIALS.

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

      RETURN

      END SUBROUTINE EXVAL

      SUBROUTINE EXVEL (NAMVEL,RBC,K,XB,YB,UXT,UYT)

      USE kindef
      USE bnddef
      USE ijknow
      USE wrapup

      IMPLICIT NONE

      INTEGER (INT4) ::      K
      REAL (REAL8)   ::    UXT,    UYT,     XB,     YB
      REAL (REAL8), DIMENSION(5) :: RBC
      CHARACTER (LEN=30) :: NAMVEL

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

      ! THIS IS A USER SUPPLIED SUBROUTINE WHICH APPLIES VELOCITY
      ! CONSTRAINTS TO NODES. THE ROUTINE IS CALLED ONCE PER CYCLE FOR
      ! EACH NODE ASSIGNED WITH THE USER VELOCITY CONSTRAINT THROUGH
      ! INPUT. THE USER VELOCITY CONSTRAINT IS USED WHEN THE X AND Y
      ! VELOCITY CONSTRAINTS CANNOT BE DESCRIBED BY A COMBINATION OF THE
      ! STANDARD VELOCITY CONSTRAINTS AVAILABLE AUTODYN

      ! INPUT PARAMETERS

      !    NAMVEL   BOUNDARY CONDITION NAME (SUPPLIED BY USER DURING INPUT)

      !    RBC(1-5) INPUT PARAMETERS FOR BOUNDARY CONDITION

      !    K        = 0,  REGULAR NODE, (I,J) FOR NODE IS DEFINED BY 'INOW'
      !                   AND 'JNOW' IN MODULE 'IJKNOW'

      !             > 0,  INTERACTIVE NODE, K IS THE INTERACTIVE NODE #

      !<0,  POLYGON NODE, -K IS THE POLYGON NODE #

      !    XB       X-COORDINATE OF NODE AT BEGINNING OF CYCLE

      !    YB       Y-COORDINATE OF NODE AT BEGINNING OF CYCLE

      !    UXT      TENTATIVE X-VELOCITY BEFORE CONSTRAINTS

      !    UYT      TENTATIVE Y-VELOCITY BEFORE CONSTRAINTS

      ! OUTPUT PARAMETERS

      !    UXT      X-VELOCITY AFTER CONSTRAINT HAS BEEN APPLIED

      !    UYT      Y-VELOCITY AFTER CONSTRAINT HAS BEEN APPLIED

      ! NOTE: AFTER RETURNING FROM THIS ROUTINE, END OF CYCLE COORDINATES
      !       WILL BE COMPUTED USING:-

      !             XE = XB + UXT*DLTH        YE = YB + UYT*DLTH

      !       SO YOU CAN CONSTRAIN THE DOMAIN OF X AND Y BY DIRECTLY
      !       MODIFYING UXT AND UYT TO ENSURE THAT XE AND/OR YE REMAIN
      !       WITHIN CERTAIN BOUNDS

      ! THE FOLLOWING MODULES CONTAIN INFORMATION WHICH MAY BE
      ! USEFUL FOR COMPUTING THE VELOCITY CONSTRAINTS :-

      ! MODULE  'IJKNOW'

      !                MNOW - CURRENT SUBGRID NUMBER

      ! MODULE  'CYCVAR'

      !                NCYCLE - CURRENT CYCLE NUMBER
      !                TIME   - CURRENT TIME
      !                DLTH   - TIME STEP FOR CURRENT CYCLE

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

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

      RETURN

      END SUBROUTINE EXVEL

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

      ! USE mdgrid
      USE kindef
      USE ijknow
      USE material
      USE matdef
      USE wrapup

      IMPLICIT NONE

      ! INTEGER (INT4) ::   IJK
      INTEGER (INT1) ::  IFAIL
      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
      !    TEMPT   TEMPERATURE
      !    DAMAGE  DAMAGE
      !    IFAIL   STRESS STATE INDICATOR
      !            = 0   HYDRO
      !            = 1   ELASTIC
      !            = 2   PLASTIC
      !            = 3   BULK FAILURE (WITH HEAL)
      !            > 3   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
      !                NAMMAT(MATNO) -  THE MATERIAL NAME OF THE
      !                                 CURRENT MATERIAL

      ! MODULE  'CYCVAR'

      !                NCYCLE - CURRENT CYCLE NUMBER
      !                TIME   - CURRENT TIME
      !                DLTH   - TIME STEP FOR CURRENT CYCLE

      ! THE FOLLOWING GRID VARIABLES MAY ALSO BE USEFUL :-

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

      ! TO OBTAIN THE VALUE OF THE INDEX IJK FOR THE CURRENT CELL, USE
      ! FUNCTION 'IJSET' :-

      ! IJK = IJSET (INOW,JNOW)

      ! IN ORDER TO USE THE FUNCTION 'IJSET', THE USER MUST INCLUDE THE
      ! MODULE 'MDGRID' AT THE TOP OF THIS SUBROUTINE: - USE mdgrid.
      ! 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 EXYLD missing$')
      NSWRAP = 9

  900 RETURN

      END SUBROUTINE EXYLD

      SUBROUTINE EXZONE (SUBGRD,I1,I2,J1,J2)

      USE mdgrid
      USE kindef

      IMPLICIT NONE

      ! INTEGER (INT4) ::    IJK,      I,      J
      INTEGER (INT4) ::     I1,     I2,     J1,     J2
      CHARACTER (LEN=10) :: SUBGRD

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

      ! THIS SUBROUTINE IS USED TO DEFINE THE COORDINATES OF A BLOCK OF
      ! NODES WITHIN A SUBGRID.

      ! INPUT PARAMETERS:

      !    SUBGRD - SUBGRID NAME
      !    I1,I1  - I-RANGE OF NODES TO BE GENERATED
      !    J1,J1  - J-RANGE OF NODES TO BE GENERATED

      ! TO DEFINE THE COORDINATES OF THE THE NODE (I,J), FIRST
      ! GET THE GRID ARRAY INDEX OF THE POINT USING THE FUNCTION
      ! "IJSET" AS FOLLOWS:

      !    IJK = IJSET (I,J)

      ! THEN ASSIGN THE (X,Y) VALUES AS FOLLOW:

      !    XN(IJK) = XVALUE
      !    YN(IJK) = YVALUE

      ! THE INDICES IJK, I AND J MUST ALSO BE DEFINED AS INTEGERS AT THE TOP
      ! OF THIS SUBROUTINE:-         INTEGER (INT4) ::   IJK,      I,      J

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

      ! TEMPORARY ERROR MESSAGE - REPLACE WITH YOUR OWN CODE
      CALL MESSAG ('$User subroutine EXZONE missing$')

      RETURN

      END SUBROUTINE EXZONE

      SUBROUTINE EXFRICTION2D(PNORM,FRICNOW,FRICSTAT,FRICDYN,FRICDEC,VREL)

      USE kindef  

      IMPLICIT NONE
    
      REAL(REAL8)   :: FRICNOW, FRICSTAT,  FRICDYN,  FRICDEC,     VREL,   PNORM

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

      ! THIS SUBROUTINE IS USED TO DEFINE THE FRICTION COEFFICIENT
      ! FOR USE WITH THE TRAJECTORY CONTACT ALGORITHM
      
      ! INPUT PARAMETERS:
      ! NUNOW    - COMPUTED FRICTION COEFFICIENT
      ! FRICSTAT - STATIC FRICTION COEFFICIENT
      ! FRICDYN  - DYNAMIC FRICTION COEFFICIENT
      ! FRICDEC  - FRICTION DECAY CONSTANT
      ! VREL     - RELATIVE VELOCITY OF NODE TO FACE AT CONTACT POINT
      ! PNORM    - NORMAL CONTACT IMPULSE
      
      ! OUTPUT PARAMETERS
      ! FRICNOW    - COMPUTED FRICTION COEFFICIENT

      ! ************************************************************************
           
      ! TEMPORARY ERROR MESSAGE - REPLACE WITH YOUR OWN CODE
      CALL MESSAG ('$User subroutine EXFRICTION2D missing$')
      
      RETURN
      
      END SUBROUTINE EXFRICTION2D

