User Subroutine Interface
SUBROUTINE UDMGINI(FINDEX,NFINDEX,FNORMAL,NDI,NSHR,NTENS,PROPS,
1 NPROPS,STATEV,NSTATV,STRESS,STRAIN,STRAINEE,LXFEM,TIME,
2 DTIME,TEMP,DTEMP,PREDEF,DPRED,NFIELD,COORDS,NOEL,NPT,LAYER,
3 KSPT,KSTEP,KINC,KDIRCYC,KCYCLELCF,TIMECYC,SSE,SPD,SCD,SVD,
4 SMD,JMAC,JMATYP,MATLAYO,LACCFLA,CELENT,DROT,ORI)
C
INCLUDE 'ABA_PARAM.INC'
C
DIMENSION FINDEX(NFINDEX),FNORMAL(NDI,NFINDEX),COORDS(*),
1 STRESS(NTENS),STRAIN(NTENS),STRAINEE(NTENS),PROPS(NPROPS),
2 STATEV(NSTATV),PREDEF(NFIELD),DPRED(NFIELD),TIME(2),JMAC(*),
3 JMATYP(*),DROT(3,3),ORI(3,3),LXFEM(3)
user coding to define FINDEX, and FNORMAL
RETURN
END
Variables to Be Defined
-
FINDEX(NFINDEX)
-
A Vector defining the indices for all the failure mechanisms.
-
FNORMAL(NDI, NFINDEX)
-
An Array defining the normal direction to the fracture plane (three dimensions) or
line (two dimensions) for each failure mechanism.
Variables That Can Be Updated
-
STATEV
-
An array containing the user-defined solution-dependent state variables at this
point. This array will be passed in containing the values of these variables at the
start of the increment unless the values are updated in user subroutine USDFLD. They can be updated in
this subroutine to their values at the end of the increment. You define the size of
this array by allocating space for it (see Allocating Space for Solution-Dependent State Variables for more
information).
-
SSE,SPD,SCD,SVD,SMD
-
Specific elastic strain energy, plastic dissipation, “creep” dissipation, viscous,
and damage energy, respectively, passed in as the values at the start of the increment
and should be updated to the corresponding specific energy values at the end of the
increment. They have no effect on the solution, except that they are used for energy
output.
Variables Passed in for Information
-
NFINDEX
-
Number of indices for all failure mechanisms.
-
NDI
-
Number of direct stress components at this point.
-
NSHR
-
Number of engineering shear stress components at this point.
-
NTENS
-
Size of the stress or strain component array (NRI +
NSHR).
-
PROPS(NPROPS)
-
User-specified array of material constants associated with this user-defined failure
criterion.
-
NPROPS
-
User-defined number of material constants associated with this user-defined failure
criterion.
-
NSTATV
-
Number of solution-dependent state variables associated with this material (specified
when space is allocated for the array; see Allocating Space for Solution-Dependent State Variables).
-
STRESS(NTENS)
-
An Array passed in as the current stress tensor. If a local orientation is used at
the same point as user subroutine UDMGINI, the stress components
will be in the local orientation; in the case of finite-strain analysis, the basis
system in which stress components are stored rotates with the material.
-
STRAIN(NTENS)
-
An Array containing the current total strains. If a local orientation is used at the
same point as user subroutine UDMGINI, the strain components
will be in the local orientation; in the case of finite-strain analysis, the basis
system in which strain components are stored rotates with the material.
-
STRAINEE(NTENS)
-
An Array containing the current elastic strains. If a local orientation is used at
the same point as user subroutine UDMGINI, the elastic strain
components will be in the local orientation; in the case of finite-strain analysis,
the basis system in which elastic strain components are stored rotates with the
material.
-
LXFEM(1)
-
An integer flag to indicate an enriched element.
-
LXFEM(2)
-
An integer flag to indicate an enriched zone.
-
LXFEM(3)
-
An integer flag to indicate the number of cracks initiated in an enriched zone.
-
TIME(1)
-
Value of step time at the beginning of the current increment.
-
TIME(2)
-
Value of total time at the beginning of the current increment.
-
DTIME
-
Time increment.
-
TEMP
-
Temperature at the start of the increment.
-
DTEMP
-
Increment of temperature during the time increment.
-
PREDEF
-
An array containing the values of all of the user-specified predefined variables at
this point at the start of the increment.
-
DPRED
-
An array containing the increments of all of the predefined variables during the time
increment.
-
NFIELD
-
Number of user-specified predefined variables.
-
COORDS
-
An array containing the current coordinates of this point.
-
NOEL
-
Element number.
-
NPT
-
Integration point number.
-
LAYER
-
Layer number (for composite shells and layered solids).
-
KSPT
-
Section point number within the current layer.
-
KSTEP
-
Step number.
-
KINC
-
Increment number.
-
KDIRCYC
-
Iteration number in a direct cyclic analysis.
-
KCYCLELCF
-
Cycle number in a direct cyclic low-cycle fatigue analysis.
-
TIMECYC
-
Time period in one loading cycle in a direct cyclic analysis.
-
JMAC
-
Variable that must be passed into the
GETVRM utility routine to access a
material point variable.
-
JMATYP
-
Variable that must be passed into the
GETVRM utility routine to access a
material point variable.
-
MATLAYO
-
Variable that must be passed into the
GETVRM utility routine to access a
material point variable.
-
LACCFLA
-
Variable that must be passed into the
GETVRM utility routine to access a
material point variable.
-
CELENT
-
Characteristic element length, which is a typical length of a line across an element
for a first-order element; it is half of the same typical length for a second-order
element. For beams and trusses it is a characteristic length along the element axis.
For membranes and shells it is a characteristic length in the reference surface. For
axisymmetric elements it is a characteristic length in the
(r, z) plane only. For cohesive
elements it is equal to the constitutive thickness.
-
DROT(3,3)
-
Rotation increment matrix. This matrix represents the increment of rigid body
rotation of the basis system in which the components of stress
(STRESS) and strain
(STRAIN) are stored. It is
provided so that vector- or tensor-valued state variables can be rotated appropriately
in this subroutine: stress and strain components are already rotated by this amount
before UDMGINI is called. This matrix
is passed in as a unit matrix for small-displacement analysis and for
large-displacement analysis if the basis system for the material point rotates with
the material (as in a shell element or when a local orientation is used).
-
ORI(3,3)
-
Material orientation with respect to global basis.
Example: User-Defined Damage Initiation Criterion with Two Different Failure Mechanisms
As a simple example of the coding of user subroutine UDMGINI, consider a damage initiation
criterion based on two different failure mechanisms: the maximum principal stress and the
quadratic traction-interaction.
SUBROUTINE UDMGINI(FINDEX,NFINDEX,FNORMAL,NDI,NSHR,NTENS,PROPS,
1 NPROPS,STATEV,NSTATV,STRESS,STRAIN,STRAINEE,LXFEM,TIME,
2 DTIME,TEMP,DTEMP,PREDEF,DPRED,NFIELD,COORDS,NOEL,NPT,
3 KLAYER,KSPT,KSTEP,INC,KDIRCYC,KCYCLELCF,TIMECYC,SSE,SPD,
4 SCD,SVD,SMD,JMAC,JMATYP,MATLAYO,LACCFLA,CELENT,DROT,ORI)
C
INCLUDE 'ABA_PARAM.INC'
CC
DIMENSION FINDEX(NFINDEX),FNORMAL(NDI,NFINDEX),COORDS(*),
1 STRESS(NTENS),STRAIN(NTENS),STRAINEE(NTENS),PROPS(NPROPS),
2 STATEV(NSTATV),PREDEF(NFIELD),DPRED(NFIELD),TIME(2),
3 JMAC(*),JMATYP(*),DROT(3,3),ORI(3,3),LXFEM(3)
DIMENSION PS(3), AN(3,3), WT(6)
PS(1)=0.0
PS(2)=0.0
PS(3)=0.0
C
C ROTATE THE STRESS TO GLOBAL SYSTEM IF THERE IS ORIENTATION
C
CALL ROTSIG(STRESS,ORI,WT,1,NDI,NSHR)
C
C MAXIMUM PRINCIPAL STRESS CRITERION
C
CALL SPRIND(WT,PS,AN,1,NDI,NSHR)
SIG1 = PS(1)
KMAX=1
DO K1 = 2, NDI
IF(PS(K1).GT.SIG1) THEN
SIG1 = PS(K1)
KMAX = K1
END IF
END DO
FINDEX(1) = SIG1/PROPS(1)
DO K1=1, NDI
FNORMAL(K1,1) = AN(KMAX,K1)
END DO
C
C QUADRATIC TRACTION-INTERACTION CRITERION
c
FINDEX(2)=(STRESS(1)/PROPS(2))**2.0+(STRESS(NDI+1)/
$ PROPS(3))**2.0+(STRESS(NDI+2)/PROPS(4))**2.0
C
FINDEX(2)=sqrt(FINDEX(2))
C
DO K1=1, NDI
FNORMAL(K1,2)=ORI(K1,1)
END DO
RETURN
END
|