ContactMechanics_ Derived Type

type, public :: ContactMechanics_


Components

Type Visibility Attributes Name Initial
type(FEMDomainp_), public, allocatable :: FEMDomains(:)
type(LinearSolver_), public :: solver
integer(kind=int32), public, allocatable :: contactlist(:,:)
real(kind=real64), public, allocatable :: YoungModulus(:)
real(kind=real64), public, allocatable :: PoissonRatio(:)
real(kind=real64), public, allocatable :: Density(:)
type(Dictionary_), public :: YoungModulusList
type(Dictionary_), public :: PoissonRatioList
type(Dictionary_), public :: DensityList
real(kind=real64), public, allocatable :: Displacement(:)
real(kind=real64), public, allocatable :: TractionForce(:,:)
logical, public :: initialized = .false.
real(kind=real64), public :: gravity(1:3) = [0.0d0, 0.0d0, -9.810d0]
real(kind=real64), public :: penalty = 100000.0d0
type(FEMDomain_), public, pointer :: FEMDomain1
type(FEMDomain_), public, pointer :: FEMDomain2
type(FEMIface_), public, pointer :: FEMIface
real(kind=real64), public, allocatable :: NTSGap(:,:)
real(kind=real64), public, allocatable :: NTSGzi(:,:)
real(kind=real64), public :: penaltypara = dble(1.0e+5)
real(kind=real64), public :: FrictionalCoefficient = 0.30d0
real(kind=real64), public :: Cohesion = 0.0d0
real(kind=real64), public :: Tolerance = dble(1.0e-10)
real(kind=real64), public, allocatable :: Domain1Force(:,:)
real(kind=real64), public, allocatable :: Domain2Force(:,:)
real(kind=real64), public, allocatable :: KcontactEBE(:,:,:)
real(kind=real64), public, allocatable :: KcontactGlo(:,:)
real(kind=real64), public, allocatable :: FcontactEBE(:,:)
real(kind=real64), public, allocatable :: FcontactGlo(:)
real(kind=real64), public, allocatable :: DispVecEBE(:,:)
real(kind=real64), public, allocatable :: DispVecGlo(:)
real(kind=real64), public, allocatable :: NTSvariables(:,:)
real(kind=real64), public, allocatable :: ContactMatPara(:,:)
real(kind=real64), public, allocatable :: GloNodCoord(:,:)
integer(kind=int32), public, allocatable :: u_nod_x(:)
integer(kind=int32), public, allocatable :: u_nod_y(:)
integer(kind=int32), public, allocatable :: u_nod_z(:)
real(kind=real64), public, allocatable :: du_nod_dis_x(:)
real(kind=real64), public, allocatable :: du_nod_dis_y(:)
real(kind=real64), public, allocatable :: du_nod_dis_z(:)
real(kind=real64), public, allocatable :: u_nod_dis_x(:)
real(kind=real64), public, allocatable :: u_nod_dis_y(:)
real(kind=real64), public, allocatable :: u_nod_dis_z(:)
real(kind=real64), public, allocatable :: duvec(:)
real(kind=real64), public, allocatable :: uvec(:)
real(kind=real64), public, allocatable :: dfvec(:)
real(kind=real64), public, allocatable :: fvec(:)
integer(kind=int32), public, allocatable :: NTSMaterial(:)
integer(kind=int32), public, allocatable :: StickOrSlip(:)
integer(kind=int32), public :: step = 0
integer(kind=int32), public :: itr_contact = 0
integer(kind=int32), public :: itr = 0
integer(kind=int32), public :: BiCG_ItrMax = 10000
integer(kind=int32), public :: NR_ItrMax = 100
integer(kind=int32), public :: control = 1
integer(kind=int32), public :: TimeStep = 100
integer(kind=int32), public, allocatable :: nts_elem_nod(:,:)
integer(kind=int32), public, allocatable :: old_nts_elem_nod(:,:)
integer(kind=int32), public, allocatable :: surface_nod(:)
integer(kind=int32), public, allocatable :: sur_nod_inf(:,:)
real(kind=real64), public, allocatable :: nod_coord(:,:)
real(kind=real64), public, allocatable :: old_nod_coord(:,:)
real(kind=real64), public, allocatable :: elem_nod(:,:)
integer(kind=int32), public, allocatable :: nts_mat(:)
integer(kind=int32), public, allocatable :: sur_inf_mat(:,:)
integer(kind=int32), public, allocatable :: contact_mat(:,:)
real(kind=real64), public, allocatable :: contact_mat_para(:,:)
integer(kind=int32), public, allocatable :: active_nts(:)
real(kind=real64), public, allocatable :: k_contact(:,:)
real(kind=real64), public, allocatable :: fvec_contact(:)
real(kind=real64), public, allocatable :: nts_amo(:,:)
integer(kind=int32), public, allocatable :: stick_slip(:)
integer(kind=int32), public, allocatable :: old_stick_slip(:)
real(kind=real64), public, allocatable :: old_nts_amo(:,:)
real(kind=real64), public, allocatable :: kmat(:,:)
real(kind=real64), public, allocatable :: gvec(:)
real(kind=real64), public, allocatable :: rvec(:)
real(kind=real64), public, allocatable :: K_total(:,:)
real(kind=real64), public, allocatable :: initial_duvec(:)
real(kind=real64), public, allocatable :: dduvec(:)
real(kind=real64), public, allocatable :: dduvec_nr(:)

Type-Bound Procedures

procedure, public :: Init => InitializeContactMechanics

  • public subroutine InitializeContactMechanics(obj, femdomains, femdomainsp, ContactList, femdomain1, femdomain2, AllYoungModulus, AllPoissonRatio, AllDensity)

    Arguments

    Type IntentOptional Attributes Name
    class(ContactMechanics_), intent(inout) :: obj
    type(FEMDomain_), intent(in), optional, target :: femdomains(:)
    type(FEMDomainp_), intent(in), optional, target :: femdomainsp(:)
    integer(kind=int32), intent(in), optional :: ContactList(:,:)
    type(FEMDomain_), intent(in), optional, target :: femdomain1
    type(FEMDomain_), intent(in), optional, target :: femdomain2
    real(kind=real64), intent(in), optional :: AllYoungModulus
    real(kind=real64), intent(in), optional :: AllPoissonRatio
    real(kind=real64), intent(in), optional :: AllDensity

procedure, public :: setup => runCM

  • public subroutine runCM(obj, penaltyparameter, debug, GaussPointProjection)

    call f%write(A_ij)

    Read more…

    Arguments

    Type IntentOptional Attributes Name
    class(ContactMechanics_), intent(inout), target :: obj
    real(kind=real64), intent(in), optional :: penaltyparameter
    logical, intent(in), optional :: debug
    logical, intent(in), optional :: GaussPointProjection

procedure, public :: run => runCM

  • public subroutine runCM(obj, penaltyparameter, debug, GaussPointProjection)

    call f%write(A_ij)

    Read more…

    Arguments

    Type IntentOptional Attributes Name
    class(ContactMechanics_), intent(inout), target :: obj
    real(kind=real64), intent(in), optional :: penaltyparameter
    logical, intent(in), optional :: debug
    logical, intent(in), optional :: GaussPointProjection

procedure, public :: solve => solveCM

  • public subroutine solveCM(obj, Algorithm)

    update displacement udate traction force

    Arguments

    Type IntentOptional Attributes Name
    class(ContactMechanics_), intent(inout), target :: obj
    character(len=*), intent(in) :: Algorithm

procedure, public :: updateMesh => updateMeshContactMechanics

procedure, public :: fix => fixContactMechanics

  • public subroutine fixContactMechanics(Obj, direction, disp, DomainID, x_min, x_max, y_min, y_max, z_min, z_max, NodeIDs, reduction)

    Arguments

    Type IntentOptional Attributes Name
    class(ContactMechanics_), intent(inout) :: Obj
    character(len=1), intent(in) :: direction
    real(kind=real64), intent(in) :: disp
    integer(kind=int32), intent(in) :: DomainID
    real(kind=real64), intent(in), optional :: x_min
    real(kind=real64), intent(in), optional :: x_max
    real(kind=real64), intent(in), optional :: y_min
    real(kind=real64), intent(in), optional :: y_max
    real(kind=real64), intent(in), optional :: z_min
    real(kind=real64), intent(in), optional :: z_max
    integer(kind=int32), intent(in), optional :: NodeIDs(:)
    real(kind=real64), intent(in), optional :: reduction

procedure, public :: setDensity

  • public subroutine setDensity(Obj, density, DomainID)

    Arguments

    Type IntentOptional Attributes Name
    class(ContactMechanics_), intent(inout) :: Obj
    real(kind=real64), intent(in) :: density
    integer(kind=int32), intent(in), optional :: DomainID

procedure, public :: setYoungModulus

  • public subroutine setYoungModulus(Obj, YoungModulus, DomainID)

    Arguments

    Type IntentOptional Attributes Name
    class(ContactMechanics_), intent(inout) :: Obj
    real(kind=real64), intent(in) :: YoungModulus
    integer(kind=int32), intent(in), optional :: DomainID

procedure, public :: setPoissonRatio

  • public subroutine setPoissonRatio(Obj, PoissonRatio, DomainID)

    Arguments

    Type IntentOptional Attributes Name
    class(ContactMechanics_), intent(inout) :: Obj
    real(kind=real64), intent(in) :: PoissonRatio
    integer(kind=int32), intent(in), optional :: DomainID

procedure, public :: properties => propertiesCM

  • public subroutine propertiesCM(obj, config, penalty, gravity)

    Arguments

    Type IntentOptional Attributes Name
    class(ContactMechanics_), intent(inout) :: obj
    character(len=*), intent(in), optional :: config
    real(kind=real64), intent(in), optional :: penalty
    real(kind=real64), intent(in), optional :: gravity(3)

procedure, public :: property => propertiesCM

  • public subroutine propertiesCM(obj, config, penalty, gravity)

    Arguments

    Type IntentOptional Attributes Name
    class(ContactMechanics_), intent(inout) :: obj
    character(len=*), intent(in), optional :: config
    real(kind=real64), intent(in), optional :: penalty
    real(kind=real64), intent(in), optional :: gravity(3)

procedure, public :: showProperty => showPropertyCM

procedure, public :: remove => removeContactMechanics

procedure, public :: Update => UpdateContactConfiguration

  • public subroutine UpdateContactConfiguration(obj, WeakCoupling, StrongCoupling)

    Arguments

    Type IntentOptional Attributes Name
    class(ContactMechanics_), intent(inout) :: obj
    logical, intent(in), optional :: WeakCoupling
    logical, intent(in), optional :: StrongCoupling

procedure, public :: Import => ImportContactMechanics

procedure, public :: deploy => deployContactMechanics

procedure, public :: ContactSearch

procedure, public :: getKcmat

  • public subroutine getKcmat(obj, Stick, StickSlip)

    Arguments

    Type IntentOptional Attributes Name
    class(ContactMechanics_), intent(inout) :: obj
    logical, intent(in), optional :: Stick
    logical, intent(in), optional :: StickSlip

procedure, public :: getKcmatStick

procedure, public :: getKcmatStickSlip

procedure, public :: getAllCoordinate => getAllCoordinateContactMechanics

  • public function getAllCoordinateContactMechanics(obj, DomainID) result(Coordinate)

    Arguments

    Type IntentOptional Attributes Name
    class(ContactMechanics_), intent(in), target :: obj
    integer(kind=int32), intent(in), optional :: DomainID

    Return Value real(kind=real64), allocatable, (:,:)

procedure, public :: getDisplacement => getDisplacementContactMechanics

  • public function getDisplacementContactMechanics(obj, DomainID) result(displacement)

    Arguments

    Type IntentOptional Attributes Name
    class(ContactMechanics_), intent(in), target :: obj
    integer(kind=int32), intent(in), optional :: DomainID

    Return Value real(kind=real64), allocatable, (:,:)

procedure, public :: getStress => getStressContactMechanics

  • public function getStressContactMechanics(obj, DomainID) result(Stress)

    Arguments

    Type IntentOptional Attributes Name
    class(ContactMechanics_), intent(in), target :: obj
    integer(kind=int32), intent(in) :: DomainID

    Return Value real(kind=real64), allocatable, (:,:,:,:)

procedure, public :: get => getStressContactMechanics

  • public function getStressContactMechanics(obj, DomainID) result(Stress)

    Arguments

    Type IntentOptional Attributes Name
    class(ContactMechanics_), intent(in), target :: obj
    integer(kind=int32), intent(in) :: DomainID

    Return Value real(kind=real64), allocatable, (:,:,:,:)

procedure, public :: setPenaltyParameter => setPenaltyParaCM

  • public subroutine setPenaltyParaCM(obj, para)

    Arguments

    Type IntentOptional Attributes Name
    class(ContactMechanics_), intent(inout) :: obj
    real(kind=real64), intent(in) :: para

procedure, public :: updateContactStress => updateContactStressCM

procedure, public :: updateTimestep => updateTimestepContact

  • public subroutine updateTimestepContact(obj, timestep)

    Arguments

    Type IntentOptional Attributes Name
    class(ContactMechanics_), intent(inout) :: obj
    integer, intent(in), optional :: timestep

procedure, public :: getGap => getGapCM

  • public subroutine getGapCM(obj)

    Arguments

    Type IntentOptional Attributes Name
    class(ContactMechanics_), intent(inout) :: obj

procedure, public :: getForce => getForceCM

procedure, public :: exportForceAsTraction => exportForceAsTractionCM

procedure, public :: getDispBound => getDispBoundCM

procedure, public :: getTracBound => getTracBoundCM

  • public subroutine getTracBoundCM(obj, dim_num)

    Arguments

    Type IntentOptional Attributes Name
    class(ContactMechanics_), intent(inout) :: obj
    integer(kind=int32), intent(in), optional :: dim_num

procedure, public :: ls_add_du => ls_add_duCM

procedure, public :: ls_nts_generate => ls_nts_generateCM

procedure, public :: ls_nts_material => ls_nts_materialCM

procedure, public :: ls_get_stabilized_nts => ls_get_stabilized_ntsCM

procedure, public :: ls_check_active => ls_check_active_CM