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