## 7.1. Subroutine MDSTR_USER_1

The listing below shows the contents of the file MDSTR_USER_1.TUT, used for the example User Subroutine Tutorial problem (Ident: USER_STRENGTH_EXAMPLE). List the file included with your distribution for the latest version of this subroutine.

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

          ! 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

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

          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(3) :: EP, YS

          END MODULE STR_USER_1

          SUBROUTINE INIT_STR_USER_1(IFACT)

          USE material
          USE str_user_1

          IMPLICIT NONE

          INTEGER (INT4) ::   IFACT

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

          ! THIS SUBROUTINE INITIALIZES (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 = 7                  ! 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

          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,'EPS #1'       , 0, 0,0,0,ZERO,ZERO,BIG,ZERO   ,0,0)
            EQ%PAR(3)=PRMT (3,'EPS #2'       , 0, 0,0,0,ZERO,ZERO,BIG,ZERO   ,0,0)
            EQ%PAR(4)=PRMT (4,'EPS #3'       , 0, 0,0,0,ZERO,ZERO,BIG,ZERO   ,0,0)
            EQ%PAR(5)=PRMT (5,'YIELD #1'     ,-1,-2,1,0,ZERO,ZERO,BIG,ZERO   ,0,0)
            EQ%PAR(6)=PRMT (6,'YIELD #2'     ,-1,-2,1,0,ZERO,ZERO,BIG,ZERO   ,0,0)
            EQ%PAR(7)=PRMT (7,'YIELD #3'     ,-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
          EP(1) = EQ%PAR(2)%VAL
          EP(2) = EQ%PAR(3)%VAL
          EP(3) = EQ%PAR(4)%VAL
          YS(1) = EQ%PAR(5)%VAL
          YS(2) = EQ%PAR(6)%VAL
          YS(3) = EQ%PAR(7)%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

          INTEGER (INT4) :: IERROR

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

          ! THIS SUBROUTINE CHECKS EOS INPUT DATA

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

          ! PLACE USER CHECKS HERE

          ! CHECK THAT EPS IS MONOTONICALLY INCREASING
          IERROR = 0
          IF (EP(1)>EP(2).OR.EP(1)>EP(3)) IERROR = 1
          IF (EP(2)>EP(3)) IERROR = 1
          IF (IERROR==1) THEN
            CALL USR_ERROR (' ERROR  !','USER STRENGTH MODEL. Plastic strain must be monotonically
       			   increasing.')
          END IF

          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

          INTEGER (INT4) ::      I,      IM

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

          ! 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

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

          ! TO OBTAIN THE VALUE OF THE INDEX IJK FOR THE CURRENT CELL, USE
          !   IJK = IJKSET(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

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

          ! THIS ROUTINE IS ONLY WRITTEN FOR TANTALUM.
          ! CHECK THAT NO OTHER MATERIAL TRIES TO USE THIS ROUTINE.
          ! (NSWRAP = 99 WRAPS UP THE CALCULATION WITH MESSAGE THAT
          ! PROBLEM HAS BEEN TERMINATED DUE TO USER DETECTED ERROR)
          IF (MTL%NAME(1:8)/='TANTALUM') THEN
            CALL USR_MESSAG ('USER STRENGTH MODEL called for invalid material')
            NSWRAP = 99
            YIELDT = ZERO
            GO TO 900
          END IF

          ! SET CURRENT YIELD STRESS

          ! PLASTIC STRAIN LESS THAN EP(1)
          IF (EPST<=EP(1)) THEN
            YIELDT = YS(1)

          ! PLASTIC STRAIN GREATER THAN EP(3)
          ELSE IF (EPST>=EP(3)) THEN
            YIELDT = YS(3)

          ! INTERPOLATE YIELD STRESS FROM YP VS. EP CURVE
          ELSE

            DO I = 2,3
              IF (EPST<=EP(I)) THEN
                IM = I-1
                YIELDT = YS(IM) + (YS(I)-YS(IM))*(EPST-EP(IM))/(EP(I)-EP(IM))
                EXIT
              END IF
            END DO

          END IF

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

Release 18.2 - © ANSYS, Inc. All rights reserved.