### 7.6.6. Access to Nodal Variables for NBS Tetrahedral Elements

The following is an example of how erosion of NBS tetrahedral elements based on the effective plastic strain at the nodes might be achieved. This serves as an example of how to obtain data from unstructured nodes and elements, The example can be found in your distribution in file MDERO_USER_1.TUT

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

          ! THIS MODULE IS A CONTAINER FOR THE INITIALISATION AND SOLUTION
          ! OF A MATERIAL MODELLING EQUATION/OPTION

          ! THE FOLLOWING ROUTINES ARE INCLUDED:

          ! MODULE ERO_USER_1
          !   DEFINE COMMON PARAMETERS TO BE ACCESSED IN ROUTINES BELOW

          ! SUBROUTINE INIT_ERO_USER_1
          !   ALLOCATE SPACE AND DEFINE THE PARAMETERS FOR A GIVEN FLAG

          ! SUBROUTINE CHECK_ERO_USER_1
          !   CHECK PARAMETERS ARE VALID FOR flagname

          ! SUBROUTINE SET_ERO_USER_1 (optional)
          !   SET PARAMETERS FOR SUBSEQUENT USE IN THE SOLVER

          ! SUBROUTINE SOLVE_ERO_USER_1_2D
          ! SUBROUTINE SOLVE_ERO_USER_1_3D
          !   SOLVE EQUATION (CALLED FROM SOLVER)

          ! 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 ERO_USER_1
          USE kindef
          IMPLICIT NONE
          SAVE

          ! SPECIFY COMMON VARIABLES TO BE ACCESSED BY ROUITNES BELOW HERE
          !INTEGER(INT4) ::
          REAL(REAL8) :: MAX_EPS

          END MODULE ERO_USER_1

          SUBROUTINE INIT_ERO_USER_1(IFACT)

          USE material
          USE ero_user_1

          IMPLICIT NONE

          INTEGER (INT4) ::   IFACT

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

          ! THIS SUBROUTINE INITIALIZES (ALLOCATES) PARAMETERS AND DATA

          ! FLAG - IMF_ERO_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_ERO_USER_1
          EQ%NAME = 'User Erosion #1'
          EQ%NPAR = 1
          EQ%NUMOPT = 0
          EQ%NDEPFLG = 0
          EQ%NCHAR = 0
          EQ%NPAR_VEC = 0

          IF (IFACT==1) THEN
            ! ALLOCATE ARRAYS FOR EQUATION/FLAG
            CALL ALLOC_EQ

            ! SET PARAMETER NAMES
            EQ%PAR(1)=PRMT(1,'Erosion Plastic Strain',0,0,0,0,BIG,SMALL,BIG,BIG,0,1)
          ENDIF

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

          RETURN
          END SUBROUTINE INIT_ERO_USER_1

          SUBROUTINE SET_ERO_USER_1

          USE material
          USE ero_user_1
          USE mdvar_all

          IMPLICIT NONE

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

          ! THIS SUBROUTINE ASSIGNS EOS CONSTANTS FOR DIRECT USE IN THE SOLVER

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

          EROMOD = 5 ! DO NOT MODIFY THIS LINE

          MAX_EPS = EQ%PAR(1)%VAL

          IF_IVAR_ALL(IVI_EROSION) = 2

          RETURN

          END SUBROUTINE SET_ERO_USER_1

          SUBROUTINE CHECK_ERO_USER_1

          USE material
          USE ero_user_1

          IMPLICIT NONE

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

          ! THIS SUBROUTINE CHECKS EOS INPUT DATA

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

          ! NO CHECKS REQUIRED

          RETURN

          END SUBROUTINE CHECK_ERO_USER_1

          SUBROUTINE SOLVE_ERO_USER_1_2D (ISTAT)

          USE material
          USE ero_user_1
          USE mdgrid
          USE wrapup

          IMPLICIT NONE

          INTEGER (INT4) ::  ISTAT

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

          ! THIS IS A USER SUPPLIED SUBROUTINE WHICH CAN BE USED TO ERODE THE
          ! CURRENT CELL ACCORDING TO ANY CRITERIA THE USER DECIDES.

          ! OUTPUT PARAMETER

          !    ISTAT   EROSION SWITCH - ASSIGN TO NON-ZERO TO ERODE THE CURRENT CELL

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

          !    MATNO          THE MATERIAL NUMBER OF THE MATERIAL BEING PROCESSED
          !    MTL%NAME       THE MATERIAL NAME OF THE MATERIAL BEING PROCESSED

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

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

          ! UNCOMMENT THE NEXT LINE TO USE OLD V4.3 USER SUBROUITNE
          ! CALL EXEROD2 (ISTAT)

          RETURN

          END SUBROUTINE SOLVE_ERO_USER_1_2D

          SUBROUTINE SOLVE_ERO_USER_1_3D (ISTAT)

          USE material
          USE ero_user_1
          USE mdgrid3
          USE wrapup
          USE mdvar_all
          USE mdstring
          USE mdsolv
          USE cycvar

          IMPLICIT NONE

          INTEGER (INT4) ::  ISTAT, N, ELTYPE, NBS_TET_HGMODEL
          INTEGER (INT4) :: LOCMAT
          INTEGER (INT4) :: IDNODEEPS
          INTEGER (INT4), DIMENSION(4) :: NODENM, MATLOCL

          REAL (REAL8) ::   PUSOELEM_EPS, ELEM_EPS, TET_HG_COEFF
          REAL (REAL8), DIMENSION(4) :: NODEEPS

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

          ! THIS IS A USER SUPPLIED SUBROUTINE WHICH CAN BE USED TO ERODE THE
          ! CURRENT CELL ACCORDING TO ANY CRITERIA THE USER DECIDES.

          ! OUTPUT PARAMETER

          !    ISTAT   EROSION SWITCH - ASSIGN TO NON-ZERO TO ERODE THE CURRENT CELL

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

          !    MATNO          THE MATERIAL NUMBER OF THE MATERIAL BEING PROCESSED
          !    MTL%NAME       THE MATERIAL NAME OF THE MATERIAL BEING PROCESSED

          ! AN EXAMPLE OF USING USER EROSION WITH NBS TETRAHEDRA CAN BE FOUND IN
          ! THE APPENDIX OF THE USER SUBROUTINE MANUAL

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

          ! THE FOLLOWING ERODES NBS ELEMENTS BASED ON PLASTIC STRAIN - IT WILL DO
          ! NOTHING FOR OTHER ELEMENT TYPES

          ISTAT = 0

          IF (ELEM_NOW == 0) GO TO 100

          CALL GET_ELEM_VAR(ELEM_NOW,0)
          ! ASSESS WHETHER NBS ELEMENT OR NOT AND IF NOT RETURN
          ELTYPE = DATA_STR(NSTRING)%P%OPT(EL_SOPT_ELEMTYPE)

          IF (ELTYPE /= ELTYPE_TET4_ANS) GO TO 100

          ! DETERMINE IF PUSO STABILISATION IS USED AND THE PUSO COEFFICIENT IF NECESSARY
          NBS_TET_HGMODEL     = DATA_STR(NSTRING)%P%OPT(EL_SOPT_NBS_HGMODEL)
          TET_HG_COEFF        = DATA_STR(NSTRING)%P%RPARAM(RPAR_NBS_HGCOEFF)

          ! GET EFFECTIVE PLASTIC STRAIN IN THE PUSO MATERIAL
          PUSOELEM_EPS = RVL(IVR_NBS_EPS)

          ! GET GLOBAL NODE NUMBERS CONNECTED TO ELEMENT
          NODENM(1) = IVL(IVI_CON1)
          NODENM(2) = IVL(IVI_CON2)
          NODENM(3) = IVL(IVI_CON3)
          NODENM(4) = IVL(IVI_CON4)
          ! NBS NODES HAVE A LAYERED STORAGE STRUCTURE FOR VARIABLES DUE TO MULTI-
          ! MATERIALS ON THE NODES. THE FOLLOWING GETS THE LAYER NUMBER OF THE
          ! CURRENT ELEMENT MATERIAL FOR EACH NODE
          MATLOCL(1) = IVL(IVI_NBS_MATLOC1)
          MATLOCL(2) = IVL(IVI_NBS_MATLOC2)
          MATLOCL(3) = IVL(IVI_NBS_MATLOC3)
          MATLOCL(4) = IVL(IVI_NBS_MATLOC4)

          ! GET THE PLASTIC STRAIN AT THE NODES
          DO N = 1,4
            ! CALL TO GET_NODE_VAR(NODENO,MATLOC) RETRIEVES NODAL DATA FOR NODE
            ! WITH GLOBAL NODE NUMBER, NODENO, AND LAYER NUMBER, MATLOC
            CALL GET_NODE_VAR(NODENM(N),MATLOCL(N))
            ! RETRIEVE EFFECTIVE PLASTIC STRAIN FOR NODE N
            NODEEPS(N) = RVL(IVR_NBS_EPS)
          END DO

          ! SET ELEMENT TO FAILED IF PLASTIC STRAIN EXCEEDED
          ELEM_EPS = MINVAL(NODEEPS)
          ELEM_EPS = MAX(ELEM_EPS,PUSOELEM_EPS)
          IF (ELEM_EPS >= MAX_EPS) ISTAT = 1

    100   CONTINUE

          RETURN

          END SUBROUTINE SOLVE_ERO_USER_1_3D

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