      SUBROUTINE EXALE3 (IREZ,JREZ,KREZ,NREZ,XREZ,YREZ,ZREZ)

      USE mdgrid3
      USE kindef
      USE material
      USE matdef
      USE subdef
      USE wrapup

      IMPLICIT NONE

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

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

      ! 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
      ! KREZ - K 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
      ! ZREZ - CURRENT Z-COORDINATE OF VERTEX

      ! OUTPUT PARAMETERS:

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

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

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

      RETURN

      END SUBROUTINE EXALE3

      SUBROUTINE EXBULK3 (BULK)

      ! USE mdgrid3
      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
      ! KNOW - K 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
      ! ML(NCEN)     -  CELL SPECIFIC INTERN3AL ENERGY
      ! ML(NCMU)    -  CELL COMPRESSION (RHO/RHOREF-ONE)
      ! ML(NCPS)    -  EFFECTIVE PLASTIC STRAIN3
      ! EPSDOT(IJK) -  EFFECTIVE PLASTIC STRAIN RATE
      ! ML(NCTP)   -  TEMPERATURE
      ! ML(NCDM)    -  DAMAGE

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

      ! IJK = IJKSET3 (INOW,JNOW,KNOW)

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

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

      RETURN

      END SUBROUTINE EXBULK3

      SUBROUTINE EXCOMP3 (GALPA,ALPHAP,PP)

      ! USE mdgrid3
      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
      !                KNOW - K 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)
      ! T33(IJK)
      ! TO OBTAIN THE VALUE OF THE INDEX IJK FOR THE CURRENT CELL, USE
      ! FUNCTION 'IJKSET3' :-

      ! IJK = IJKSET3 (INOW,JNOW,KNOW)

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

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

      ! NOTE: THIS SUBROUTINE IS NOW OBSELETE AND IS NOT CALLED FROM AUTODYN
      ! TO CREATE YOUR OWN POROUS COMPACTION CURVE FOR THE P-ALPHA EQUATION OF STATE
      ! PLEASE USE SUBROUTINE EXCOMP FOR BOTH 2D AND 3D. THIS CAN BE FOUND IN USRSUB2.F90

      RETURN

      END SUBROUTINE EXCOMP3

      SUBROUTINE EXCRCK3 (DCRACK,ECRINC,SLOPE)

      ! USE mdgrid3
      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 STRAIN3
      !    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
      !                KNOW - K 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)
      ! T33(IJK)
      ! TO OBTAIN THE VALUE OF THE INDEX IJK FOR THE CURRENT CELL, USE
      ! FUNCTION 'IJKSET3' :-

      ! IJK = IJKSET3 (INOW,JNOW,KNOW)

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

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

      RETURN

      END SUBROUTINE EXCRCK3

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

      ! USE mdgrid3
      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 EXBULK3, EXSHR3 AND
      ! EXYLD3 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
      ! KNOW - K 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 'IJKSET3' :-

      ! IJK = IJKSET3 (INOW,JNOW,KNOW)

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

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

      RETURN

      END SUBROUTINE EXDAM3

      SUBROUTINE EXDAM3_JHUSER (JHTYPE,PRES,EPSINC,DAMAGE)

      ! USE mdgrid3
      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 
      !   JHSTYP = 1, JH2 - GRADUAL FAILURE, WITH DAMAGE, DEFINED BY USER
      !   JHSTYP = 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 EXDAM3_JHUSER missing$')
      NSWRAP = 9

      RETURN

      END SUBROUTINE EXDAM3_JHUSER


      SUBROUTINE EXEDIT3

      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 EXEDIT3

      SUBROUTINE EXFLOW3 (NBDY,M,I1,J1,K1,I2,J2,K2,MATFLO, &
      UXFLO,UYFLO,UZFLO,PFLO,DENFLO,SIEFLO)

      USE kindef
      USE cycvar

      IMPLICIT NONE

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

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

      ! THIS IS A USER SUPPLIED SUBROUTINE WHICH ALLOWS YOU TO VARY THE
      ! FLOW PARAMETERS FOR AN EULER FLOW IN 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,K1)
      ! I1,J1,K1) TO (I2,J2,K2) IN SUBGRID NUMBER M
      ! I2,J2,K2)
      ! 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)
      ! UZFLO   Z-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)
      ! UZFLO   Z-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 EXFLOW3

      SUBROUTINE EXFOR3 (NTYPE,NAMBDY,RBC,IJK,FT)

      USE mdgrid3
      USE cycvar
      USE wrapup
      USE bnddef, ONLY: COSX_USER,COSY_USER,COSZ_USER

      IMPLICIT NONE

      INTEGER (INT4) :: NTYPE, IJK
      REAL (REAL8)   ::    FT
      REAL (REAL8), DIMENSION(5) :: RBC
      CHARACTER (LEN=30) :: NAMBDY

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

!     THIS IS A USER SUPPLIED SUBROUTINE WHICH COMPUTES A FORCE BOUNDARY
!     ON A BEAM ELEMENT. THE FORCE APPLED CAN EITHER BE ON A NODE 
!     BOUNDARY OR ON AN ELEMENT BOUNDARY. fOR THE LATTER CASE, THE 
!     BOUNDARY IS APPLIED ON THE UPPER NODE OF THE BEAM ELEMENT. EXFOR3 
!     IS CALLED ONCE PER CYCLE FOR EACH STRUCTURED NODE/BEAM ELEMENT 
!     ASSIGNED THE USER FORCE CONDITION THROUGH INPUT.

!     FOR UNSTRUCTURED ELEMENTS ASSIGNED THE USER FORCE CONDITION THIS
!     ROUTINE IS ONLY CALLED ONCE PER CYCLE. THEREFORE THIS ROUTINE CAN
!     ONLY BE USED FOR SETTING A SINGLE VALUE OF FORCE THAT IS THEN APPLIED
!     TO ALL UNSTRUCTURED NODES ASSIGNED THE USER FORCE CONDITION. THE
!     VALUE OF THE FORCE (FT) CAN THOUGH BE VARIED CYCLE TO CYCLE.

!     EXFOR3 IS USED IF THE FORCE BOUNDARY CANNOT BE DEFINED USING
!     ONE OF THE STANDARD FUNCTIONS PROVIDED BY AUTODYN.


!     INPUT PARAMETERS

!     NTYPE      = 1 FOR NODAL FORCE
!                = 2 FOR FORCE PER UNIT LENGTH

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

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

!     IJK      GLOBAL IJK INDEX OF BEAM NODE

!              NOTE FOR NTYPE==2, OTHER ELEMENT NODE CAN BE ACCESSED
!              VIA INDEX IJK-1

!              IJK = 0 DENOTES THAT THIS ROUTINE HAS BEEN CALLED FOR
!                      UNSTRUCTURED PARTS

!     OUTPUT PARAMETERS

!     FT       FORCE TO BE APPLIED TO NODE OR BEAM LENGTH

!     OPTIONAL OUTPUT:
!     DIRECTION COSINUS CAN BE SET BY MODIFYING THE VALUES OF:
!      COSX_USER,COSY_USER AND COSZ_USER (DEFINED IN module bnddef)
!     IF THESE ARE NOT MODIFIED THE COSINUSES AS DEFINED ON INPUT
!     WILL BE USED.
!     NOTE: EITHER ALL VALUES NEED TO BE MODIFIED OR NONE
      
!     THE FOLLOWING MODULES CONTAIN INFORMATION WHICH MAY BE
!     USEFUL FOR COMPUTING THE BOUNDARY FORCE :-

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

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

      RETURN
      END SUBROUTINE EXFOR3


      SUBROUTINE EXLOAD3 (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 EXSAVE3
      ! 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 EXSAVE3
      ! THIS COMPATIBLE SUBROUTINE EXSAVE3 MUST BE INSERTED WHEN THE DATA
      ! IS SAVED. SEE SUBROUTINE EXSAVE3 FOR MORE INFORMATION.

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

      RETURN

      END SUBROUTINE EXLOAD3

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

      IMPLICIT NONE

      ! INTEGER (INT4) ::   IJK
      INTEGER (INT1) ::  IFAIL
      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
      ! KNOW - K 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 'IJKSET3' :-

      ! IJK = IJKSET3 (INOW,JNOW,KNOW)

      ! IN ORDER TO USE THE FUNCTION 'IJKSET3', THE USER MUST INCLUDE THE
      ! MODULE 'mdgrid3' AT THE TOP OF THIS SUBROUTINE: - USE mdgrid3.
      ! 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 EXPLRN3

      SUBROUTINE EXSAVE3 (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 EXLOAD3
      ! 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 EXLOAD3
      ! THIS COMPATIBLE SUBROUTINE EXLOAD3 MUST BE INSERTD WHENEVER THE
      ! SAVED DATA IS LOADED

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

      RETURN

      END SUBROUTINE EXSAVE3

      SUBROUTINE EXSHR3 (PRES,XMU,EPS,EPSD,TEMP,DAMAGE,SHRMOD)

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

      IMPLICIT NONE

      ! INTEGER (INT4) ::   IJK
      REAL (REAL8)   ::   EPSD,    EPS,   PRES, SHRMOD,   TEMP,    XMU, DAMAGE

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

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

      ! INPUT PARAMETERS

      ! PRES    PRESSURE
      ! XMU     COMPRESSION
      ! EPS     EFFECTIVE PLASTIC STRAIN3
      ! EPSD    EFFECTIVE PLASTIC STRAIN RATE
      ! TEMP    TEMPERATURE
      ! DAMAGE  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
      ! KNOW - K 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
      ! ML(NCEN)     -  CELL SPECIFIC INTERNAL ENERGY
      ! ML(NCMU)    -  CELL COMPRESSION (RHO/RHOREF-ONE)
      ! ML(NCPS)    -  EFFECTIVE PLASTIC STRAIN
      ! EPSDOT(IJK) -  EFFECTIVE PLASTIC STRAIN RATE
      ! ML(NCTP)   -  TEMPERATURE

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

      ! IJK = IJKSET3 (INOW,JNOW,KNOW)

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

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

      RETURN

      END SUBROUTINE EXSHR3

      SUBROUTINE EXSIE3 (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 INTERN3AL 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 :-

      ! 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
      ! 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 EXSIE3

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

      ! USE mdgrid3
      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 EXSHR3.

      ! 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. EXSTIF3 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 'mdgrid3'

      ! T11       = STRESS IN 11 DIRECTION
      ! T22       = STRESS IN 22 DIRECTION
      ! T33       = STRESS IN 33 DIRECTION
      ! T12       = SHEAR STRESS IN 12 PLANE
      ! T23       = SHEAR STRESS IN 23 PLANE
      ! T31       = SHEAR STRESS IN 31 PLANE

      ! STN11     = STRAIN IN 11 DIRECTION
      ! STN22     = STRAIN IN 22 DIRECTION
      ! STN33     = STRAIN IN 33 DIRECTION
      ! STN12V    = STRAIN IN 12 DIRECTION
      ! STN23     = STRAIN IN 23 DIRECTION
      ! STN31     = STRAIN IN 31 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
      ! ML(NCEN)     -  CELL SPECIFIC INTERNAL ENERGY
      ! ML(NCMU)    -  CELL COMPRESSION (RHO/RHOREF-ONE)
      ! ML(NCPS)    -  EFFECTIVE PLASTIC STRAIN
      ! EPSDOT(IJK) -  EFFECTIVE PLASTIC STRAIN RATE
      ! ML(NCTP)   -  TEMPERATURE
      ! ML(NCDM)    -  DAMAGE

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

      ! IJK = IJKSET3 (INOW,JNOW)

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

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

      RETURN

      END SUBROUTINE EXSTIF3

      SUBROUTINE EXSTR3 (NAMSTR,RBC,I1,J1,K1,I2,J2,K2,PRES)

      USE kindef
      USE bnddef
      USE ijknow
      USE cycvar
      USE wrapup

      IMPLICIT NONE

      INTEGER (INT4) ::     I1,     I2,     J1,     J2,     K1,     K2
      REAL (REAL8)   ::   PRES
      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,K=1,K=KMAX) OR MUST BE
      ! ADJACENT TO AN UNUSED CELL. EXSTR3 IS CALLED ONCE PER CYCLE FOR
      ! EACH CELL FACE ASSIGNED THE USER STRESS CONDITION THROUGH INPUT.
      ! EXSTR3 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

      ! FOR STRUCTURED
      ! I1,J1,K1      ) CELL FACE RUNS FROM (I1,J1,K1) TO (I2,J2,K2)
      ! I2,J2,K2      ) WHERE EITHER I1=I2 OR J1=J2 OR K1=K2

      ! FOR UNSTRUCTURED
      ! I1,J1,K1,I2   ) CORRESPOND TO GLOBAL ID OF NODE1, NODE2, NODE3, NODE4 OF A CELL FACE
      ! J2,K2         ) ARE DUMMY ARGUMENTS 
      ! NOTE THAT IF FACE HAS ONLY TWO OR THREE NODES (I.E. BEAMS OR TRIANGULAR FACES),
      ! THE UNUSED ARGUMENTS ARE SET TO ZERO

      ! 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'
      ! MODULE  'MDSTRING'
      
      ! MNOW - CURRENT SUBGRID NUMBER

      ! MODULE  'CYCVAR'

      ! NCYCLE - CURRENT CYCLE NUMBER
      ! TIME   - CURRENT TIME
      ! DLTH   - TIME STEP FOR CURRENT CYCLE
      
      ! FOR UNSTRUCTURED, A NODE SPATIAL COORDINATES CAN BE ACCESSED AS FOLLOWED
      ! X1 = NODAL_RMEMORY(INDEXNODES_R(NODE1)+IDFEXPOS) 

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

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

      RETURN

      END SUBROUTINE EXSTR3

      SUBROUTINE EXTAB3 (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 EXTAB3 missing$')
      NSWRAP = 9

      RETURN

      END SUBROUTINE EXTAB3

      SUBROUTINE EXVAL3 (NS,I,J,K,IJK,MATI,NP,RHOI,RREF,SIEI,TEMP,UXI,UYI,UZI,URI)

      USE kindef
      USE bnddef

      IMPLICIT NONE

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

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

      ! 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,K,IJK       INDICES FOR CURRENT CELL
      ! MATI            CURRENT MATERIAL
      ! NP              PROCESSOR TYPE
      ! RHOI            INPUT INITIAL DENSITY
      ! RREF            REFERENCE DENSITY
      ! SIEI            INPUT INITIAL SPECIFIC INTERNAL ENERGY
      ! TEMP            INPUT INITIAL TEMPERATURE
      ! UXI,UYI,UZI     INPUT INITIAL TRANSLATIONAL VELOCITY COMPONENTS
      ! URI             INPUT INITIAL RADIAL VELOCITY
      
      ! OUTPUT PARAMETERS
      ! RHOI            NEW INITIAL DENSITY
      ! SIEI            NEW INITIAL SPECIFIC INTERNAL ENERGY
      ! TEMP            NEW INITIAL TEMPERATURE
      ! UXI,UYI,UZI     NEW INITIAL TRANSLATIONAL VELOCITY COMPONENTS
      ! URI             NEW INITIAL RADIAL VELOCITY

      ! NOTES:-
      
      ! INITIAL COMPRESSION OF THE MATERIAL WILL BE RE-CALCULATED BASED ON
      ! THE INITIAL DENSITY, RHOI, AND THE REFERENCE DENSITY XMU = (RHOI/RHOREF)-1
      
      ! 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 EXVAL3
      
      SUBROUTINE EXVEL3 (NAMVEL,RBC,K,XB,YB,ZB,UXT,UYT,UZT)

      USE kindef
      USE bnddef
      USE ijknow
      USE wrapup

      IMPLICIT NONE

      INTEGER (INT4) ::      K
      REAL (REAL8)   ::     ZB,    UXT,    UYT,    UZT,     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,Y AND Z
      ! 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,K) FOR NODE IS DEFINED BY 'INOW'
      ! 'JNOW' AND 'KNOW' IN MODULE 'IJKNOW'

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

      ! XB       X-COORDINATE OF NODE AT BEGINNING OF CYCLE

      ! YB       Y-COORDINATE OF NODE AT BEGINNING OF CYCLE

      ! ZB       Z-COORDINATE OF NODE AT BEGINNING OF CYCLE

      ! UXT      TENTATIVE X-VELOCITY BEFORE CONSTRAINTS

      ! UYT      TENTATIVE Y-VELOCITY BEFORE CONSTRAINTS

      ! UZT      TENTATIVE Z-VELOCITY BEFORE CONSTRAINTS

      ! OUTPUT PARAMETERS

      ! UXT      X-VELOCITY AFTER CONSTRAINT HAS BEEN APPLIED

      ! UYT      Y-VELOCITY AFTER CONSTRAINT HAS BEEN APPLIED

      ! UZT      Z-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
      ! ZE = ZB + UZT*DLTH

      ! SO YOU CAN CONSTRAIN THE DOMAIN OF X, Y & Z BY DIRECTLY
      ! MODIFYING UXT, UYT & UZT TO ENSURE THAT XE, YE, ZE 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 EXVEL3 missing$')
      NSWRAP = 9

      RETURN

      END SUBROUTINE EXVEL3

      SUBROUTINE EXZONE3 (SUBGRD,I1,I2,J1,J2,K1,K2)

      USE mdgrid3
      USE kindef

      IMPLICIT NONE

      ! INTEGER (INT4) ::   IJK,      I,      J,      K
      INTEGER (INT4) ::    I1,     I2,     J1,     J2,     K1,     K2
      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
      ! K1,K1  - K-RANGE OF NODES TO BE GENERATED

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

      !    IJK = IJKSET3 (I,J,K)

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

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

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

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

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

      RETURN

      END SUBROUTINE EXZONE3
      
      SUBROUTINE EXFRICTION(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:
      ! FRICNOW  - 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
      ! NUNOW    - COMPUTED FRICTION COEFFICIENT

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

      SUBROUTINE EXORTHO_AXES(NELGL,X11,Y11,Z11,X22,Y22,Z22)
      
      USE kindef  

      IMPLICIT NONE
    
      INTEGER(INT4) ::  NELGL

      REAL(REAL8)   ::  X11, Y11, Z11, X22, Y22, Z22
      
      ! ************************************************************************

      ! THIS SUBROUTINE IS USED TO DEFINE THE 11 AND 22 PRINCIPAL AXES
      ! FOR UNSTRUCTURED ORTHOTROPIC MATERIALS
      
      ! INPUT PARAMETERS:
      !  NELGL     -   GLOBAL ELEMENT INDEX
           
      ! OUTPUT PARAMETERS
      !  X11     -    X COMPONENT OF 11 MATERIAL DIRECTION VECTOR
      !  Y11     -    Y COMPONENT OF 11 MATERIAL DIRECTION VECTOR
      !  Z11     -    Z COMPONENT OF 11 MATERIAL DIRECTION VECTOR
      !  X22     -    X COMPONENT OF 22 MATERIAL DIRECTION VECTOR
      !  Y22     -    Y COMPONENT OF 22 MATERIAL DIRECTION VECTOR
      !  Z22     -    Z COMPONENT OF 22 MATERIAL DIRECTION VECTOR

      ! ************************************************************************
      
      RETURN

      END SUBROUTINE EXORTHO_AXES

