module ContactMechanicsClass use, intrinsic :: iso_fortran_env use MathClass ! use MPIClass use FEMIfaceClass use FEMDomainClass use FiniteDeformationClass implicit none type :: ContactMechanics_ ! Modern type(FEMDomainp_), allocatable :: FEMDomains(:) type(LinearSolver_) :: solver integer(int32), allocatable :: contactlist(:, :) real(real64), allocatable :: YoungModulus(:) real(real64), allocatable :: PoissonRatio(:) real(real64), allocatable :: Density(:) type(Dictionary_) :: YoungModulusList type(Dictionary_) :: PoissonRatioList type(Dictionary_) :: DensityList real(real64), allocatable :: Displacement(:) real(real64), allocatable :: TractionForce(:, :) logical :: initialized = .false. real(real64) :: gravity(1:3) = [0.0d0, 0.0d0, -9.810d0] real(real64) :: penalty = 100000.0d0 ! >>>>>>>>>>>> Regacy >>>>>>>>>>>>>>>>> ! >>>>>>>>>>>> Regacy >>>>>>>>>>>>>>>>> ! >>>>>>>>>>>> Regacy >>>>>>>>>>>>>>>>> ! >>>>>>>>>>>> Regacy >>>>>>>>>>>>>>>>> ! type(FEMDomain_), pointer::FEMDomain1 type(FEMDomain_), pointer::FEMDomain2 type(FEMIface_), pointer::FEMIface ! common fields real(real64), allocatable :: NTSGap(:, :) real(real64), allocatable :: NTSGzi(:, :) real(real64) :: penaltypara = dble(1.0e+5) real(real64) :: FrictionalCoefficient = 0.30d0 real(real64) :: Cohesion = 0.0d0 real(real64) :: Tolerance = dble(1.0e-10) ! for weak coupling contact analysis real(real64), allocatable :: Domain1Force(:, :) real(real64), allocatable :: Domain2Force(:, :) ! for strong coupling contact analysys real(real64), allocatable ::KcontactEBE(:, :, :) real(real64), allocatable ::KcontactGlo(:, :) real(real64), allocatable ::FcontactEBE(:, :) real(real64), allocatable ::FcontactGlo(:) real(real64), allocatable ::DispVecEBE(:, :) real(real64), allocatable ::DispVecGlo(:) real(real64), allocatable ::NTSvariables(:, :) real(real64), allocatable ::ContactMatPara(:, :) real(real64), allocatable ::GloNodCoord(:, :) ! boundary conditions for lodging simulator 2.5 integer(int32), allocatable ::u_nod_x(:) integer(int32), allocatable ::u_nod_y(:) integer(int32), allocatable ::u_nod_z(:) real(real64), allocatable ::du_nod_dis_x(:) real(real64), allocatable ::du_nod_dis_y(:) real(real64), allocatable ::du_nod_dis_z(:) real(real64), allocatable ::u_nod_dis_x(:) real(real64), allocatable ::u_nod_dis_y(:) real(real64), allocatable ::u_nod_dis_z(:) real(real64), allocatable :: duvec(:) real(real64), allocatable :: uvec(:) real(real64), allocatable :: dfvec(:) real(real64), allocatable :: fvec(:) integer(int32), allocatable ::NTSMaterial(:) integer(int32), allocatable ::StickOrSlip(:) integer(int32) :: step = 0 integer(int32) :: itr_contact = 0 integer(int32) :: itr = 0 integer(int32) :: BiCG_ItrMax = 10000 integer(int32) :: NR_ItrMax = 100 integer(int32) :: control = 1 ! 1:displacement-control, 2: traction-control integer(int32) :: TimeStep = 100 ! from lodging-simulatiro 2.5 integer(int32), allocatable ::nts_elem_nod(:, :) integer(int32), allocatable ::old_nts_elem_nod(:, :) integer(int32), allocatable ::surface_nod(:) integer(int32), allocatable ::sur_nod_inf(:, :) real(real64), allocatable ::nod_coord(:, :) real(real64), allocatable ::old_nod_coord(:, :) real(real64), allocatable ::elem_nod(:, :) integer(int32), allocatable :: nts_mat(:) integer(int32), allocatable :: sur_inf_mat(:, :) integer(int32), allocatable :: contact_mat(:, :) real(real64), allocatable ::contact_mat_para(:, :) integer(int32), allocatable :: active_nts(:) real(real64), allocatable ::k_contact(:, :) real(real64), allocatable ::fvec_contact(:) real(real64), allocatable ::nts_amo(:, :) integer(int32), allocatable :: stick_slip(:) integer(int32), allocatable :: old_stick_slip(:) real(real64), allocatable ::old_nts_amo(:, :) real(real64), allocatable ::kmat(:, :), gvec(:), rvec(:) real(real64), allocatable ::K_total(:, :), initial_duvec(:), dduvec(:), dduvec_nr(:) contains ! modern procedure :: Init => InitializeContactMechanics procedure :: setup => runCM procedure :: run => runCM procedure :: solve => solveCM procedure :: updateMesh => updateMeshContactMechanics procedure :: fix => fixContactMechanics procedure :: setDensity => setDensity procedure :: setYoungModulus => setYoungModulus procedure :: setPoissonRatio => setPoissonRatio procedure :: properties => propertiesCM procedure :: property => propertiesCM procedure :: showProperty => showPropertyCM procedure :: remove => removeContactMechanics ! regacy procedure :: Update => UpdateContactConfiguration procedure :: Import => ImportContactMechanics procedure :: deploy => deployContactMechanics procedure :: ContactSearch => ContactSearch procedure :: getKcmat => getKcmat procedure :: getKcmatStick => getKcmatStick procedure :: getKcmatStickSlip => getKcmatStickSlip procedure :: getAllCoordinate => getAllCoordinateContactMechanics procedure :: getDisplacement => getDisplacementContactMechanics procedure :: getStress => getStressContactMechanics procedure :: get => getStressContactMechanics procedure :: setPenaltyParameter => setPenaltyParaCM procedure :: updateContactStress => updateContactStressCM procedure :: updateTimestep => updateTimestepContact procedure :: getGap => getGapCM procedure :: getForce => getForceCM procedure :: exportForceAsTraction => exportForceAsTractionCM procedure :: getDispBound => getDispBoundCM procedure :: getTracBound => getTracBoundCM ! >>> regacy subroutines for lodging-simulator 2.5 procedure :: ls_add_du => ls_add_duCM procedure :: ls_nts_generate => ls_nts_generateCM procedure :: ls_nts_material => ls_nts_materialCM procedure :: ls_get_stabilized_nts => ls_get_stabilized_ntsCM procedure :: ls_check_active => ls_check_active_CM end type contains ! ##################################################### subroutine InitializeContactMechanics(obj, femdomains, femdomainsp, contactlist, femdomain1, femdomain2, & AllYoungModulus, AllPoissonRatio, AllDensity) class(ContactMechanics_), intent(inout) :: obj type(FEMDomain_), target, optional, intent(in) :: femdomains(:) type(FEMDomainp_), target, optional, intent(in) :: femdomainsp(:) type(FEMDomain_), target, optional, intent(in) :: femdomain1, femdomain2 integer(int32), optional, intent(in) :: ContactList(:, :) real(real64) :: DefaultYoungModulus = 1000.0d0 real(real64) :: DefaultPoissonRatio = 0.30d0 real(real64) :: DefaultDensity = 0.0d0 real(real64), optional, intent(in) :: AllYoungModulus real(real64), optional, intent(in) :: AllPoissonRatio real(real64), optional, intent(in) :: AllDensity integer(int32) :: node_num_1 integer(int32) :: node_num_2 integer(int32) :: numDomain, i integer(int32), allocatable :: NumberOfNode(:) ! modern if (present(AllYoungModulus)) then DefaultYoungModulus = AllYoungModulus end if if (present(AllPoissonRatio)) then DefaultPoissonRatio = AllPoissonRatio end if if (present(AllDensity)) then DefaultDensity = AllDensity end if if (present(femdomains) .and. present(contactList)) then numDomain = size(femdomains) if (numDomain == 0) then print *, "[Caution] :: InitializeContactMechanics >> No domain was found in femdomains=***" print *, " as well as contactlist=***" return end if if (allocated(obj%femdomains)) then deallocate (obj%femdomains) end if allocate (obj%femdomains(numDomain)) allocate (obj%YoungModulus(numDomain)) allocate (obj%PoissonRatio(numDomain)) allocate (obj%Density(numDomain)) obj%YoungModulus(:) = DefaultYoungModulus obj%PoissonRatio(:) = DefaultPoissonRatio obj%Density(:) = DefaultDensity ! receive domains as pointers do i = 1, numDomain obj%femdomains(i)%femdomainp => femdomains(i) end do obj%ContactList = contactList ! initialize solver allocate (NumberOfNode(numDomain)) do i = 1, numDomain NumberOfNode(i) = obj%femdomains(i)%femdomainp%nn() end do call obj%solver%init(NumberOfNode=NumberOfNode, DOF=obj%femdomains(1)%femdomainp%nd()) obj%initialized = .true. return elseif (present(femdomainsp) .and. present(contactList)) then numDomain = size(femdomainsp) if (numDomain == 0) then print *, "[Caution] :: InitializeContactMechanics >> No domain was found in femdomains=***" print *, " as well as contactlist=***" return end if if (allocated(obj%femdomains)) then deallocate (obj%femdomains) end if allocate (obj%femdomains(numDomain)) allocate (obj%YoungModulus(numDomain)) allocate (obj%PoissonRatio(numDomain)) allocate (obj%Density(numDomain)) obj%YoungModulus(:) = DefaultYoungModulus obj%PoissonRatio(:) = DefaultPoissonRatio obj%Density(:) = DefaultDensity ! receive domains as pointers do i = 1, numDomain obj%femdomains(i)%femdomainp => femdomainsp(i)%femdomainp end do obj%ContactList = contactList ! initialize solver allocate (NumberOfNode(numDomain)) do i = 1, numDomain NumberOfNode(i) = obj%femdomains(i)%femdomainp%nn() end do call obj%solver%init(NumberOfNode=NumberOfNode, DOF=obj%femdomains(1)%femdomainp%nd()) obj%initialized = .true. return else print *, "[Caution] :: contactmechanics%init >> you attempt to run REGACY mode. If you want to run" print *, "Modern version, please set your type(FEMDomain_),allocatable :: something(:) object as" print *, "femdomains = " end if if (present(femdomain1)) then ! regacy ! regacy ! regacy ! regacy if (allocated(obj%KcontactEBE)) then deallocate (obj%KcontactEBE) end if if (allocated(obj%KcontactGlo)) then deallocate (obj%KcontactGlo) end if if (allocated(obj%FcontactEBE)) then deallocate (obj%FcontactEBE) end if if (allocated(obj%FcontactGlo)) then deallocate (obj%FcontactGlo) end if if (allocated(obj%DispVecEBE)) then deallocate (obj%DispVecEBE) end if if (allocated(obj%DispVecGlo)) then deallocate (obj%DispVecGlo) end if if (allocated(obj%NTSvariables)) then deallocate (obj%NTSvariables) end if if (associated(obj%femdomain1)) then nullify (obj%femdomain1) end if if (associated(obj%femdomain2)) then nullify (obj%femdomain2) end if obj%femdomain1 => femdomain1 obj%femdomain2 => femdomain2 !if(.not. associated(obj%FEMDomain1) )then ! print *, "ContactMechanics%Init >> FEMDomain1 is not imported" ! return !endif !if(.not. associated(obj%FEMDomain2) )then ! print *, "ContactMechanics%Init >> FEMDomain2 is not imported" ! return !endif !if(.not. associated(obj%FEMIface) )then ! print *, "ContactMechanics%Init >> FEMIface is not imported" ! return !endif if (obj%femdomain1%mesh%empty() .eqv. .true.) then print *, "[Caution] >> initContactMechanics:: obj%femdomain1%mesh is empty" stop end if if (obj%femdomain2%mesh%empty() .eqv. .true.) then print *, "[Caution] >> initContactMechanics:: obj%femdomain2%mesh is empty" stop end if node_num_1 = size(obj%femdomain1%mesh%nodcoord, 1) node_num_2 = size(obj%femdomain2%mesh%nodcoord, 1) ! initialize data objects if (.not. allocated(obj%duvec)) then allocate (obj%duvec((node_num_1 + node_num_2)*size(obj%femdomain1%mesh%nodcoord, 2))) end if if (.not. allocated(obj%uvec)) then allocate (obj%uvec((node_num_1 + node_num_2)*size(obj%femdomain1%mesh%nodcoord, 2))) end if if (.not. allocated(obj%dfvec)) then allocate (obj%dfvec((node_num_1 + node_num_2)*size(obj%femdomain1%mesh%nodcoord, 2))) end if if (.not. allocated(obj%fvec)) then allocate (obj%fvec((node_num_1 + node_num_2)*size(obj%femdomain1%mesh%nodcoord, 2))) end if return end if end subroutine ! ##################################################### subroutine fixContactMechanics(obj, direction, disp, DomainID, x_min, x_max, y_min, y_max, z_min, z_max, NodeiDs, reduction) class(ContactMechanics_), intent(inout) :: Obj character(1), intent(in) :: direction real(real64), intent(in) :: disp integer(int32), intent(in) :: DomainID integer(int32), optional, intent(in) :: NodeIDs(:) real(real64), optional, intent(in) :: reduction ! percent real(real64), optional, intent(in) :: x_min, x_max, y_min, y_max, z_min, z_max real(real64) :: rate integer(int32), allocatable :: FixBoundary(:), reducedFixBoundary(:) integer(int32) :: entryID, i, nsize, interval print *, "fixContactMechanics >> [1] selecting fix boundary" if (present(NodeIDs)) then FixBoundary = NodeIDs else FixBoundary = obj%FEMdomains(DomainID)%femdomainp%select( & x_min=x_min, x_max=x_max, y_min=y_min, y_max=y_max, z_min=z_min, z_max=z_max) end if if (direction == "x") then EntryId = 1 end if if (direction == "y") then EntryId = 2 end if if (direction == "z") then EntryId = 3 end if if (direction == "X") then EntryId = 1 end if if (direction == "Y") then EntryId = 2 end if if (direction == "Z") then EntryId = 3 end if ! if(present(reduction) )then ! print *, "fixContactMechanics >> [2] setting fix boundary, size:: ",nsize ! if( 0.0d0 < reduction .and. reduction < 1.0d0 )then ! rate = reduction ! elseif( 1.0d0 < reduction .and. reduction < 100.0d0 )then ! rate = reduction/100.0d0 ! endif ! nsize = int( dble(size(FixBoundary) )*rate ) ! interval = int(size(FixBoundary)/nsize) ! ! do i=1,size(FixBoundary),interval ! call obj%solver%fix(nodeid=FixBoundary(i), & ! EntryID=EntryID, & ! entryvalue=disp, & ! DOF=obj%solver%DOF ,& ! row_DomainID=domainid) ! enddo ! else ! print *, "fixContactMechanics >> [2] setting fix boundary, size:: ",size(FixBoundary) ! do i=1,size(FixBoundary) ! call obj%solver%fix(nodeid=FixBoundary(i), & ! EntryID=EntryID, & ! entryvalue=disp, & ! DOF=obj%solver%DOF ,& ! row_DomainID=domainid) ! enddo ! endif print *, "fixContactMechanics >> [2] setting fix boundary, size:: ", size(FixBoundary) do i = 1, size(FixBoundary) call obj%solver%fix(nodeid=FixBoundary(i), & EntryID=EntryID, & entryvalue=disp, & DOF=obj%solver%DOF, & row_DomainID=domainid) end do print *, "fixContactMechanics >> [ok] Done" end subroutine ! ##################################################### subroutine updateMeshContactMechanics(obj) class(ContactMechanics_), target, intent(inout) :: obj integer(int32) :: i, DOF, From, To if (obj%initialized) then DOF = obj%solver%DOF From = 1 To = 0 do i = 1, size(obj%solver%NumberOfNode) To = To + obj%solver%NumberOfNode(i)*DOF obj%femdomains(i)%femdomainp%mesh%nodcoord(:, :) = obj%femdomains(i)%femdomainp%mesh%nodcoord(:, :) + & reshape(obj%solver%x(From:To), obj%femdomains(i)%femdomainp%nn(), DOF) From = From + obj%solver%NumberOfNode(i)*DOF end do end if end subroutine ! ##################################################### ! ##################################################### subroutine runCM(obj, penaltyparameter, debug, GaussPointProjection) class(ContactMechanics_), target, intent(inout) :: obj real(real64), optional, intent(in) :: penaltyparameter logical, optional, intent(in) :: debug logical :: Debugflag = .false. logical, optional, intent(in) :: GaussPointProjection integer(int32) :: i, nod_max, nn, itr, fstep, j, k, l, o, GaussPointID integer(int32) :: node_num_1, node_num_2, converge_check, error type(IO_) :: ErrorLog, f real(real64) :: rvec0, u_norm, er, er0, reacforcex, reacforcey integer(int32) :: DomainID, ElementID, InterfaceID, NodeID integer(int32), allocatable :: DomainIDs1(:), DomainIDs12(:), InterConnect(:) real(real64), allocatable :: A_ij(:, :), x_i(:), b_i(:) ! A x = b real(real64), allocatable :: A_ij_GPP(:, :) real(real64) :: position(3), center(3) real(real64) :: penalty, YoungModulus, PoissonRatio, Density type(FEMDomain_), pointer :: domain1, domain2 type(ShapeFunction_) :: sf logical :: GPP ! enable Gauss-Point projection if (present(GaussPointProjection)) then if (GaussPointProjection) then GPP = .true. end if end if if (present(debug)) then obj%solver%debug = debug end if if (obj%initialized) then ! linear elastic, small strain ! create stiffness matrix for all domains do DomainID = 1, size(obj%femdomains) print *, "Ax = b for Domain-ID :: ", DomainID if (allocated(DomainIDs1)) then deallocate (DomainIDs1) end if allocate (DomainIDs1(obj%femdomains(DomainID)%femdomainp%nne() & *obj%femdomains(DomainID)%femdomainp%nd())) DomainIDs1(:) = DomainID do ElementID = 1, obj%femdomains(DomainID)%femdomainp%ne() ! ! If type(Dictionary_) :: YoungMoludus_EBE exitsts ! For 1st element, create stiffness matrix YoungModulus = obj%YoungModulus(DomainID) if (obj%YoungModulusList%initialized) then if (allocated(obj%YoungModulusList%pages)) then if (allocated(obj%YoungModulusList%pages(DomainID)%realist)) then YoungModulus = & obj%YoungModulusList%pages(DomainID)%realist(ElementID) end if end if end if PoissonRatio = obj%PoissonRatio(DomainID) if (obj%PoissonRatioList%initialized) then if (allocated(obj%PoissonRatioList%pages)) then if (allocated(obj%PoissonRatioList%pages(DomainID)%realist)) then PoissonRatio = & obj%PoissonRatioList%pages(DomainID)%realist(ElementID) end if end if end if Density = obj%Density(DomainID) if (obj%DensityList%initialized) then if (allocated(obj%DensityList%pages)) then if (allocated(obj%DensityList%pages(DomainID)%realist)) then Density = & obj%DensityList%pages(DomainID)%realist(ElementID) end if end if end if A_ij = obj%femdomains(DomainID)%femdomainp%StiffnessMatrix( & ElementID=ElementID, & E=YoungModulus, & v=PoissonRatio) b_i = obj%femdomains(DomainID)%femdomainp%MassVector( & ElementID=ElementID, & DOF=obj%femdomains(DomainID)%femdomainp%nd(), & Density=Density, & Accel=obj%Gravity & ) ! assemble them call obj%solver%assemble( & connectivity=obj%femdomains(DomainID)%femdomainp%connectivity(ElementID=ElementID), & DOF=obj%femdomains(DomainID)%femdomainp%nd(), & eMatrix=A_ij, & DomainIDs=DomainIDs1) call obj%solver%assemble( & connectivity=obj%femdomains(DomainID)%femdomainp%connectivity(ElementID=ElementID), & DOF=obj%femdomains(DomainID)%femdomainp%nd(), & eVector=b_i, & DomainIDs=DomainIDs1) end do end do InterfaceID = 0 penalty = input(default=obj%penalty, option=penaltyparameter) do i = 1, size(obj%ContactList, 1) do j = 1, size(obj%ContactList, 2) if (obj%contactList(i, j) >= 1) then ! domains are in contact InterfaceID = InterfaceID + 1 ! Interface print *, "K_c x = 0 for Interface ID :: ", InterfaceID ! create Elemental Matrices and Vectors if (allocated(DomainIDs12)) then deallocate (DomainIDs12) end if if (allocated(InterConnect)) then deallocate (InterConnect) end if if (associated(domain1)) then nullify (domain1) end if if (associated(domain2)) then nullify (domain2) end if domain1 => obj%femdomains(i)%femdomainp domain2 => obj%femdomains(j)%femdomainp allocate (DomainIDs12(domain2%nne() + 1)) allocate (InterConnect(domain2%nne() + 1)) DomainIDs12(1) = i DomainIDs12(2:) = j if (GPP) then ! compute constrait matrix ! by Gauss-Point Projection InterConnect = int(zeros(domain1%nne() + domain2%nne())) DomainIDs12 = int(zeros(domain1%nne() + domain2%nne())) DomainIDs12(1:domain1%nne()) = i DomainIDs12(domain1%nne() + 1:) = j do ElementID = 1, domain1%ne() do GaussPointID = 1, domain1%ngp() ! For 1st element, create stiffness matrix ! set global coordinate position = domain1%GlobalPositionOfGaussPoint(ElementID, GaussPointID) if (domain2%mesh%nearestElementID(x=position(1), y=position(2), z=position(3)) <= 0) then cycle end if InterConnect(1:domain1%nne()) = domain1%connectivity(ElementID) InterConnect(domain1%nne() + 1:) & = domain2%connectivity(domain2%mesh%nearestElementID(x=position(1), y=position(2), z=position(3))) sf = domain1%mesh%getShapeFunction(ElementID, GaussPointID) !print *, "shapefunc" !call print(matmul( transpose(sf%ElemCoord),sf%nmat) ) sf%ElementID = ElementID A_ij = penalty*domain2%connectMatrix(position, DOF=domain2%nd(), shapefunction=sf) !A_ij = penalty*domain2%connectMatrix(position,DOF=domain2%nd()) !call f%open("Domain1.txt") !!call f%write(A_ij) !call f%close() !call f%open("Domain1.txt") !!call f%write(A_ij) !call f%close() !stop !stop ! assemble them call obj%solver%assemble( & connectivity=InterConnect, & DOF=domain2%nd(), & eMatrix=A_ij, & DomainIDs=DomainIDs12) end do end do else do NodeID = 1, domain1%nn() ! For 1st element, create stiffness matrix ! set global coordinate position(:) = domain1%mesh%nodcoord(NodeID, :) if (domain2%mesh%nearestElementID(x=position(1), y=position(2), z=position(3)) <= 0) then cycle end if InterConnect(1) = NodeID InterConnect(2:) = domain2%connectivity(domain2%mesh%nearestElementID(x=position(1), y=position(2), z=position(3))) A_ij = penalty*domain2%connectMatrix(position, DOF=domain2%nd()) ! assemble them call obj%solver%assemble( & connectivity=InterConnect, & DOF=domain2%nd(), & eMatrix=A_ij, & DomainIDs=DomainIDs12) end do end if end if end do end do call print("[ok] Assembled InterConnect matrices") call obj%solver%prepareFix() return else print *, "[Caution] :: runContactMechanics >> No domain was found in femdomains=***" print *, "You attempt to run it as REGACY mode." if (present(debug)) then Debugflag = debug end if ! initialize domains as deformable bodies call obj%femdomain1%bake(template="FiniteDeform_") call obj%femdomain2%bake(template="FiniteDeform_") ! get displacement boundary call obj%getDispBound() call obj%getTracBound() if (obj%control == 2) then !外力制御であれば、外力増分の計算 do i = 1, size(obj%dfvec) obj%dfvec(i) = 1.0d0/dble(obj%timestep)*obj%fvec(i) end do obj%fvec(:) = 0.0d0 elseif (obj%control == 1) then !変位制御であれば、変位増分の計算と外力ベクトルの計算 obj%du_nod_dis_x(:) = 1.0d0/dble(obj%timestep)*obj%u_nod_dis_x(:) obj%du_nod_dis_y(:) = 1.0d0/dble(obj%timestep)*obj%u_nod_dis_y(:) obj%u_nod_dis_x(:) = 0.0d0 obj%u_nod_dis_y(:) = 0.0d0 end if call ErrorLog%open("Contact_ErrorLog.txt") write (ErrorLog%fh, *) 'step=', 1, "/", fstep obj%step = 0 ! time-loop do i = 1, obj%TimeStep obj%step = obj%step + 1 obj%duvec(:) = 0.0d0 obj%itr_contact = 0 fstep = obj%TimeStep print *, 'Step=', i !現在のstepの出力 if (Debugflag .eqv. .true.) print *, "Debug flag 0" !========================================================= !Add force/displacement increments !-------------------------------------- obj%itr = 0 !N-R法ループ1回目 if (obj%control == 1) then !変位/外力増分の追加 call obj%ls_add_du() !強制変位量の追加 elseif (obj%control == 2) then obj%fvec(:) = obj%fvec(:) + obj%dfvec(:) !外力増分の追加 else print *, "wrong nomber is in control" exit end if !================================================================== if (Debugflag .eqv. .true.) print *, "Debug flag 1" call obj%ls_nts_generate() call obj%ls_get_stabilized_nts() call obj%ls_nts_material() !================================================================ if (Debugflag .eqv. .true.) print *, "Debug flag 2" if (obj%nts_elem_nod(1, 1) + obj%nts_elem_nod(1, 2) + obj%nts_elem_nod(1, 3) /= 0) then !contact exists !================================================================ !check for contact: gn<0 → active NTS-element !-------------------------------------------- call obj%ls_check_active() !================================================================ end if if (Debugflag .eqv. .true.) print *, "Debug flag 3" !=============================================================================== !Elastic stick の計算(trial phase) !Calculate [K_stick(u)],[K(u)],gvec !----------------------------------- if (.not. allocated(obj%k_contact)) then allocate (obj%k_contact(size(obj%uvec), size(obj%uvec))) end if if (.not. allocated(obj%fvec_contact)) then allocate (obj%fvec_contact(size(obj%uvec))) end if obj%k_contact(:, :) = 0.0d0 obj%fvec_contact(:) = 0.0d0 if (obj%nts_elem_nod(1, 1) + obj%nts_elem_nod(1, 2) + obj%nts_elem_nod(1, 3) /= 0) then !contact exists !nts諸量の初期化 allocate (obj%nts_amo(size(obj%nts_elem_nod, 1), 12), obj%stick_slip(size(obj%nts_elem_nod, 1))) obj%nts_amo(:, :) = 0.0d0 obj%stick_slip(:) = 0 !もし過去にNTSを構成していれば、load data if (allocated(obj%old_nts_amo)) then call load_nts_element(obj%nts_elem_nod, obj%nts_amo, obj%old_nts_elem_nod, obj%old_nts_amo, & obj%stick_slip, obj%old_stick_slip) end if obj%stick_slip(:) = 0 do j = 1, size(obj%active_nts, 1) if (obj%stick_slip(obj%active_nts(j)) == 0) then nod_max = size(obj%nod_coord, 1) call state_stick(j, nod_max, obj%nod_coord, obj%nts_elem_nod, obj%active_nts & , obj%nts_amo, obj%k_contact, obj%nts_mat, obj%contact_mat_para, obj%uvec, obj%fvec_contact, & obj%stick_slip) !state stick and K_contactへの重ね合わせ else call update_res_grad_c_i(j, nod_max, obj%nod_coord, obj%nts_elem_nod, obj%active_nts & , obj%nts_amo, obj%k_contact, obj%uvec, obj%duvec, obj%fvec_contact, obj%stick_slip, & obj%contact_mat_para, obj%nts_mat) end if end do end if ! ここは、FiniteDeformationClassから呼び出し obj%kmat(:, :) = 0.0d0 obj%gvec(:) = 0.0d0 !call k_mat_f_int(elem_mat,elem_nod,f_nod,nod_coord,mat_cons, Kmat,stress,duvec,& ! pulout,gvec,sigma,uvec,strain_measure,itr_tol,tol,itr,i,obj%itr_contact) !================================================================================ if (Debugflag .eqv. .true.) print *, "Debug flag 4" !========================================================================== !Solve !----------------------- obj%K_total(:, :) = obj%kmat(:, :) + obj%k_contact(:, :) !全体接触剛性マトリクスの計算 obj%rvec(:) = obj%fvec(:) - obj%gvec(:) - obj%fvec_contact(:)!fvec_contact(:) !!!!no tension wall 保留中 !call no_tension_wall(gvec,surface_nod,sur_nod_inf,nod_coord,uvec,& ! u_nod_x,u_nod_y,active_wall_x,active_wall_y) !active_wall_x(:)=1 !active_wall_y(:)=1 !================== call displace(obj%K_total, obj%rvec, obj%u_nod_x, obj%du_nod_dis_x, obj%u_nod_y, & obj%du_nod_dis_y) !Dirichlet Boundary conditions nn = size(obj%uvec, 1) !Parameters for gauss_joprdan do k = 1, size(obj%rvec) if (obj%rvec(k) >= 0.0d0 .or. obj%rvec(k) < 0.0d0) then cycle else error = 1 print *, "NaN !!" exit end if end do do k = 1, size(obj%K_total, 1) do l = 1, size(obj%k_total, 2) if (obj%K_total(k, l) >= 0.0d0 .or. obj%K_total(k, l) < 0.0d0) then cycle else error = 1 print *, "NaN !!" exit end if end do end do !call gauss_jordan_pv(k_total, duvec, rvec, nn) !duvec(:)=0.0d0 !call bicgstab1d(k_total, Rvec, duvec, nn, itr_tol, tol_rm) !obtain initial du er = 1.0e-15 nn = size(obj%rvec) call bicgstab_nr1(obj%k_total, obj%Rvec, obj%duvec, nn, obj%BiCG_ItrMax, & er, obj%u_nod_x, obj%u_nod_y, obj%u_nod_dis_x, obj%u_nod_dis_y) !#### ERROR CHECKER ######## if (dot_product(obj%duvec, obj%duvec) /= dot_product(obj%duvec, obj%duvec)) then print *, "ERROR :: runContactMechanics" exit end if !#### ERROR CHECKER ######## !call gnuplot_out(elem_nod,nod_coord,uvec+duvec,i,process_parallel) ! stop "debug" !x=duvec(2*u_nod_y(1)) !write(108,*) x,du_nod_dis_y(1) !if(int(x)/=int(du_nod_dis_y(1)) )then ! error=1 ! print *, "invalid uvec" ! exit !endif obj%initial_duvec(:) = obj%duvec(:) !========================================================================= print *, "Debug flag 5" do !call gnuplot_out(elem_nod,nod_coord,uvec+duvec,obj%itr_contact,process_parallel) !================================================================== if (obj%nts_elem_nod(1, 1) + obj%nts_elem_nod(1, 2) + obj%nts_elem_nod(1, 3) /= 0) then !contact exists !================================================================== !check contact pairing !================================================================== !check for contact: gn<0 → active NTS-element !----------------------------------------------- call obj%ls_check_active() !===================================================================== end if print *, "Debug flag 6" !================================================ if (obj%nts_elem_nod(1, 1) + obj%nts_elem_nod(1, 2) + obj%nts_elem_nod(1, 3) /= 0 .and. obj%itr_contact >= 2) then !contact exists obj%k_contact(:, :) = 0.0d0 obj%fvec_contact(:) = 0.0d0 do j = 1, size(obj%active_nts, 1) call update_friction(j, nod_max, obj%nod_coord, obj%nts_elem_nod, obj%active_nts, obj%surface_nod, obj%sur_nod_inf & , obj%nts_amo, obj%k_contact, obj%uvec, obj%duvec, obj%fvec_contact, obj%stick_slip, & obj%contact_mat_para, obj%nts_mat, obj%itr_contact) !with return mapping Algorithm end do end if !================================================ print *, "Debug flag 7" !==================================================================== !LOOP OVER ITERATIONS : k = 1, 2, ..., convergence !------------------------------------------------------ itr = itr + 1 obj%dduvec(:) = 0.0d0 if (obj%nts_elem_nod(1, 1) + obj%nts_elem_nod(1, 2) + obj%nts_elem_nod(1, 3) /= 0) then !contact exists obj%k_contact(:, :) = 0.0d0 obj%fvec_contact(:) = 0.0d0 do j = 1, size(obj%active_nts, 1) call update_res_grad_c(j, nod_max, obj%nod_coord, obj%nts_elem_nod, obj%active_nts & , obj%nts_amo, obj%k_contact, obj%uvec, obj%duvec, obj%fvec_contact, obj%stick_slip, & obj%contact_mat_para, obj%nts_mat) !with return mapping Algorithm end do end if !=============================================================================== !Elastic stick/ Plastic slip の計算 !Calculate [K_stick(u)],[K(u)] !----------------------------------- obj%kmat(:, :) = 0.0d0 obj%gvec(:) = 0.0d0 !call k_mat_f_int(elem_mat,elem_nod,f_nod,nod_coord,mat_cons, Kmat,stress,duvec,pulout,gvec,& ! sigma,uvec,strain_measure,itr_tol,tol,itr,i,obj%itr_contact) !================================================================================ print *, "Debug flag 8" !================================================================================ !Calculate Rresidual vecor r !-------------------------------- obj%k_total(:, :) = obj%kmat(:, :) + obj%k_contact(:, :) obj%rvec(:) = obj%fvec(:) - obj%gvec(:) - obj%fvec_contact(:) if (itr == 1) then rvec0 = abs(dot_product(obj%rvec, obj%rvec)) !**(1.0d0/2.0d0) end if !================================================================================= print *, "Debug flag 9" print *, "itr=", itr !================================================================================ !Solve !--------------- !!!!no tension wall 保留中 !call no_tension_wall(gvec,surface_nod,sur_nod_inf,nod_coord,uvec+duvec,& !u_nod_x,u_nod_y,active_wall_x,active_wall_y) !if(obj%itr_contact<0)then !active_wall_x(:)=1 !active_wall_y(:)=1 !endif !===================== call displace_nr(obj%K_total, obj%Rvec, obj%u_nod_x, obj%u_nod_dis_x, obj%u_nod_y, & obj%u_nod_dis_y) !変位境界ではΔu=0 !call gauss_jordan_pv(k_total, dduvec, Rvec, nn) !call bicgstab1d(k_total, Rvec, dduvec, nn, itr_tol, tol_rm) obj%dduvec(:) = 0.0d0 er = 1.0e-15 !NaN checker do k = 1, size(obj%rvec) if (obj%rvec(k) >= 0.0d0 .or. obj%rvec(k) < 0.0d0) then cycle else error = 1 exit end if end do do k = 1, size(obj%K_total, 1) do l = 1, size(obj%k_total, 2) if (obj%K_total(k, l) >= 0.0d0 .or. obj%K_total(k, l) < 0.0d0) then cycle else error = 1 exit end if end do end do call bicgstab_nr(obj%k_total, obj%Rvec, obj%dduvec, nn, obj%BiCG_ItrMax, er, & obj%u_nod_x, obj%u_nod_y) !#### ERROR CHECKER ######## if (dot_product(obj%dduvec, obj%dduvec) /= dot_product(obj%dduvec, obj%dduvec)) then error = 1 exit end if !#### ERROR CHECKER ######## !---変位ベクトルの足しこみ----------------------------- obj%duvec(:) = obj%duvec(:) + obj%dduvec(:) if (obj%itr_contact*itr == 1) then obj%dduvec_nr(:) = obj%dduvec(:) end if u_norm = abs(dot_product(obj%rvec, obj%rvec))/rvec0! if (u_norm == 0.0d0) then print *, "u_norm=0 at step", i, "contact_itr=", obj%itr_contact, "itr=", itr end if !u_norm=(abs(dot_product(rvec,rvec))**(1.0d0/2.0d0))/u_norm !#### ERROR CHECKER ######## if (u_norm > 100000.0d0) then error = 1 end if if (error == 1) then exit end if !#### ERROR CHECKER ######## !========================================================================== !Check convergence !Contact analysisの収束判定 !------------------------------------ !call gnuplot_out(elem_nod,nod_coord,uvec+duvec,itr,process_parallel) if (abs(u_norm) <= 1.0e-5 .and. obj%itr_contact >= 2) then print *, 'contact loop itr=', itr, 'residual_out_cont', u_norm !write(1000,*)'contact loop itr=',itr,'residual_out_cont',u_norm obj%uvec(:) = obj%uvec(:) + obj%duvec(:) if (dot_product(obj%uvec, obj%uvec) == 0.0d0) then error = 1 exit end if obj%duvec(:) = 0.0d0 !compute traction forces: reacforcey = 0.0d0 reacforcex = 0.0d0 do o = 1, size(obj%u_nod_x) if (obj%u_nod_dis_x(o) == 0.0d0) then cycle else reacforcex = reacforcex + obj%gvec(2*obj%u_nod_x(o) - 1) end if end do do o = 1, size(obj%u_nod_y) if (obj%u_nod_dis_y(o) == 0.0d0) then cycle else reacforcey = reacforcey + obj%gvec(2*obj%u_nod_y(o)) end if end do !if(i==outputstep)then ! outputstep=outputstep+ops ! !call gnuplot_out(elem_nod,nod_coord,uvec,i,process_parallel) !endif !call gnu_st(elem_nod,nod_coord,uvec,sigma,i,scalar) !write(1000,*)'step=',i+1,"/",fstep print *, "Debug flag 11" !debug !write(52,*) "step, s12 elem,gauss=(1,1),(2,1)...",Fstep, sigma(:,:,3) if (obj%nts_elem_nod(1, 1) + obj%nts_elem_nod(1, 2) + obj%nts_elem_nod(1, 3) /= 0) then !contact exists call save_nts_element(obj%nts_elem_nod, obj%nts_amo, obj%old_nts_elem_nod, obj%old_nts_amo, obj%surface_nod, obj%sur_nod_inf, obj% & stick_slip, obj%old_stick_slip) deallocate (obj%nts_amo, obj%active_nts, obj%stick_slip) end if !call output_stress_contour(nod_coord,uvec,elem_nod,sigma,strain_measure,i,process_parallel ) deallocate (obj%nts_elem_nod) !call variable_update(strain_measure) !converge_check=1 !error=0 exit elseif (abs(u_norm) <= obj%Tolerance .and. obj%itr_contact <= 1) then obj%itr_contact = obj%itr_contact + 1 itr = 0 cycle else print *, 'contact loop itr=', obj%itr_contact, 'residual_out', u_norm !write(1000,*)'contact loop itr=',obj%itr_contact,'residual_out',u_norm if (itr >= obj%NR_ItrMax) then !close(40) !close(50) !close(61) !close(70) !call execute_command_line("png_script.gp") !call execute_command_line("stre_png_scr.gp") ! stop 'contact loop did not converge' print *, "ERROR :: NR-did not converge" converge_check = 0 exit else cycle end if end if !------------収束判定ここまで------------------------------------------------ !=========================================================================== end do if (converge_check == 0 .or. error == 1) then exit end if end do !output restart data if (error == 0 .and. converge_check == 1) then !call restart_out(nod_coord,uvec,fvec,sigma,strain_measure,old_nts_elem_nod,& ! old_nts_amo,old_stick_slip,gvec,process_parallel) end if write (*, *) 'Contact Elasto-Plastic analysis was completed!' call ErrorLog%close() end if end subroutine ! ##################################################### subroutine propertiesCM(obj, config, penalty, gravity) class(ContactMechanics_), intent(inout) :: obj character(*), optional, intent(in) :: config real(real64), optional, intent(in) :: penalty, gravity(3) type(IO_) :: f character(200) :: fn, conf, line integer(int32) :: blcount, rmc, id if (present(penalty)) then obj%penalty = penalty end if if (present(gravity)) then obj%gravity = gravity end if if (.not. present(config) .or. index(config, ".json") == 0) then print *, "New contact-configuration >> contact.json" call f%open("contact.json") write (f%fh, *) '{' write (f%fh, *) ' "type": "contact",' write (f%fh, *) ' "FrictionalCoefficient": 0.30,' write (f%fh, *) ' "PenaltyParameter": 1.0e+5,' write (f%fh, *) ' "Cohesion": 0.00,' write (f%fh, *) ' "TimeStep": 100,' write (f%fh, *) ' "Tolerance:":1.0e-10,' write (f%fh, *) ' "BiCG_ItrMax:":10000' write (f%fh, *) '}' conf = "contact.json" call f%close() else conf = config end if call f%open(conf) blcount = 0 do read (f%fh, '(a)') line print *, line if (adjustl(line) == "{") then blcount = 1 cycle end if if (adjustl(line) == "}") then exit end if if (blcount == 1) then if (index(line, "FrictionalCoefficient") /= 0) then rmc = index(line, ",") ! カンマがあれば除く if (rmc /= 0) then line(rmc:rmc) = " " end if id = index(line, ":") read (line(id + 1:), *) obj%FrictionalCoefficient end if if (index(line, "TimeStep") /= 0) then rmc = index(line, ",") ! カンマがあれば除く if (rmc /= 0) then line(rmc:rmc) = " " end if id = index(line, ":") read (line(id + 1:), *) obj%TimeStep end if if (index(line, "Tolerance") /= 0) then rmc = index(line, ",") ! カンマがあれば除く if (rmc /= 0) then line(rmc:rmc) = " " end if id = index(line, ":") read (line(id + 1:), *) obj%Tolerance end if if (index(line, "PenaltyParameter") /= 0) then rmc = index(line, ",") ! カンマがあれば除く if (rmc /= 0) then line(rmc:rmc) = " " end if id = index(line, ":") read (line(id + 1:), *) obj%penaltypara end if if (index(line, "Cohesion") /= 0) then rmc = index(line, ",") ! カンマがあれば除く if (rmc /= 0) then line(rmc:rmc) = " " end if id = index(line, ":") read (line(id + 1:), *) obj%Cohesion end if if (index(line, "BiCG_ItrMax") /= 0) then rmc = index(line, ",") ! カンマがあれば除く if (rmc /= 0) then line(rmc:rmc) = " " end if id = index(line, ":") read (line(id + 1:), *) obj%BiCG_ItrMax end if end if end do call f%close() if (allocated(obj%sur_inf_mat)) deallocate (obj%sur_inf_mat) if (allocated(obj%contact_mat)) deallocate (obj%contact_mat) if (allocated(obj%contact_mat_para)) deallocate (obj%contact_mat_para) allocate (obj%sur_inf_mat(1, 3)) allocate (obj%contact_mat(1, 1)) allocate (obj%contact_mat_para(1, 4)) ! from surface nod id obj%sur_inf_mat(1, 1) = 1 ! to obj%sur_inf_mat(1, 2) = size(obj%femdomain1%mesh%nodcoord, 1) + size(obj%femdomain2%mesh%nodcoord, 1) obj%sur_inf_mat(1, 3) = 1 !; material id = 1 obj%contact_mat(:, :) = 1 obj%contact_mat_para(1, 1) = obj%penaltypara ! eT obj%contact_mat_para(1, 2) = obj%penaltypara ! eN obj%contact_mat_para(1, 3) = obj%Cohesion ! c obj%contact_mat_para(1, 4) = atan(obj%FrictionalCoefficient) ! Φ end subroutine ! ##################################################### ! ##################################################### subroutine UpdateContactConfiguration(obj, WeakCoupling, StrongCoupling) class(ContactMechanics_), intent(inout)::obj logical, optional, intent(in) :: WeakCoupling, StrongCoupling !type(MPI_)::mpidata if (present(WeakCoupling)) then if (WeakCoupling .eqv. .true.) then ! only 3-D is supported. call obj%FEMIface%GetFEMIface() call obj%deploy(obj%FEMIface) call obj%setPenaltyParameter(dble(1.0e-4)) call obj%updateContactStress() call obj%updateTimeStep() ! debug :: Contact-Traction conversion has errors call obj%FEMDomain1%export(OptionalProjectName="1ontact_1_", FileHandle=120, SolverType="FiniteDeform_", MeshDimension=3) call obj%FEMDomain2%export(OptionalProjectName="2ontact_2_", FileHandle=121, SolverType="FiniteDeform_", MeshDimension=3) !call mpidata%end() stop "debug update contact" ! debug :: Contact-Traction conversion has errors return end if end if if (present(StrongCoupling)) then if (StrongCoupling .eqv. .true.) then ! only 2-D is supported. call obj%FEMIface%GetFEMIface() call obj%deploy(obj%FEMIface) call obj%setPenaltyParameter(dble(1.0e-4)) print *, "Debugging ls25" return call obj%updateContactStress() call obj%updateTimeStep() ! debug :: Contact-Traction conversion has errors call obj%FEMDomain1%export(OptionalProjectName="1ontact_1_", FileHandle=120, SolverType="FiniteDeform_", MeshDimension=2) call obj%FEMDomain2%export(OptionalProjectName="2ontact_2_", FileHandle=121, SolverType="FiniteDeform_", MeshDimension=2) ! debug :: Contact-Traction conversion has errors return end if end if end subroutine ! ##################################################### ! ##################################################### subroutine ImportContactMechanics(obj) class(ContactMechanics_), intent(inout)::obj end subroutine ! ##################################################### ! ##################################################### subroutine deployContactMechanics(obj, IfaceObj) class(ContactMechanics_), intent(inout)::obj class(FEMIface_), target, intent(in)::IfaceObj obj%FEMIface => IfaceObj end subroutine ! ##################################################### ! ##################################################### subroutine ContactSearch(obj) class(ContactMechanics_), intent(inout)::obj integer :: ierr, i, n call obj%FEMIface%GetFEMIface(obj%FEMDomain1, obj%FEMDomain2) call GetActiveContactElement(obj) end subroutine ! ##################################################### ! ##################################################### subroutine GetActiveContactElement(obj) class(ContactMechanics_), intent(inout)::obj ! Check Active/Incative of contact elements ! For Node-To-Segment call GetActiveNTS(obj) end subroutine ! ##################################################### ! ##################################################### subroutine GetActiveNTS(obj) class(ContactMechanics_), intent(inout)::obj !type(MPI_)::mpidata real(real64) :: gap real(real64), allocatable :: xs(:), xm(:, :) integer i, j, n, dim_num, mnod_num dim_num = size(obj%FEMDomain1%Mesh%NodCoord, 2) if (dim_num < 1 .or. dim_num > 4) then print *, "ContactMechanics_ >> GetActiveNTS >> dim_num should be 2 or 3 " stop end if mnod_num = size(obj%FEMIface%NTS_NodCoord, 2)/dim_num - 1 allocate (xs(dim_num), xm(mnod_num, dim_num)) do i = 1, size(obj%FEMIface%NTS_NodCoord, 1) ! NTS_NodeCoordID xs(1:dim_num) = obj%FEMIface%NTS_NodCoord(i, 1:dim_num) do j = 1, mnod_num if (dim_num*(j + 1) > size(obj%FEMIface%NTS_NodCoord, 2)) then print *, "ContactMechanics_ >> GetActiveNTS >> dim_num(j+1) > size(obj%FEMIface%NTS_NodCoord,2) " stop end if xm(j, 1:3) = obj%FEMIface%NTS_NodCoord(i, dim_num*j + 1:dim_num*(j + 1)) ! ### Bug is here ### ! end do call GetNormalGap(xs, xm, gap) end do end subroutine ! ##################################################### ! ##################################################### subroutine GetNormalGap(xs, xm, gap) real(real64), intent(in)::xs(:), xm(:, :) real(real64), intent(out)::gap real(real64), allocatable :: nm(:), am1(:), am2(:), mid(:), gvec(:) integer :: i, j, n, dim_num, ierr dim_num = size(xs) allocate (nm(3), am1(3), am2(3), mid(3), gvec(3)) if (dim_num == 1) then nm(:) = 1.0d0 elseif (dim_num == 2) then am1(1:2) = xm(1, 1:2) am2(1:2) = 0.0d0 am2(3) = 1.0d0 nm(:) = cross_product(am1, am2) nm(:) = nm(:)/dsqrt(dot_product(nm, nm)) gvec(:) = 0.0d0 gvec(:) = xs(:) - xm(1, :) gap = dot_product(gvec, nm) elseif (dim_num == 3) then am1(:) = xm(1, :) am2(:) = xm(2, :) nm(:) = cross_product(am1, am2) if (dot_product(nm, nm) == 0.0d0) then stop "df" end if nm(:) = nm(:)/dsqrt(dot_product(nm, nm)) gvec(:) = xs(:) - xm(1, :) gap = dot_product(gvec, nm) else print *, "Error >> GetNormalGap >> dim_num should be 1,2 or 3. " stop end if end subroutine ! ##################################################### ! ##################################################### subroutine getKcmat(obj, stick, StickSlip) class(ContactMechanics_), intent(inout) :: obj logical, optional, intent(in) :: Stick logical, optional, intent(in) :: StickSlip if (present(stick)) then if (stick .eqv. .true.) then call obj%getKcmatStick() end if end if if (present(StickSlip)) then if (stick .eqv. .true.) then call obj%getKcmatStickSlip() end if end if end subroutine ! ##################################################### ! ##################################################### subroutine getKcmatStick(obj) class(ContactMechanics_), intent(inout) :: obj real(real64), allocatable ::nts_amo(:, :), k_contact(:, :), fvec_contact(:) real(real64), allocatable :: old_nod_coord(:, :), uvec(:), contact_mat_para(:, :) integer :: elem_id, nod_max integer, allocatable :: nts_elem_nod(:, :), active_nts(:), nts_mat(:) integer, allocatable :: stick_slip(:) integer :: NumOfNode, NumOfNTSElem, i, nts_elem_id NumOfNTSElem = size(obj%FEMIface%NTS_ElemNod, 1) NumOfNode = size(obj%FEMDomain1%Mesh%NodCoord, 1) + size(obj%FEMDomain1%Mesh%NodCoord, 2) do i = 1, NumOfNTSElem nts_elem_id = i nod_max = NumOfNode call state_stick(nts_elem_id, nod_max, obj%GloNodCoord, obj%FEMIface%NTS_ElemNod, & obj%FEMIface%NTS_Active & , obj%NTSVariables, obj%KcontactGlo, obj%NTSMaterial, & obj%ContactMatPara, obj%DispVecGlo, obj%FcontactGlo, obj%StickOrSlip) end do end subroutine ! ##################################################### ! ##################################################### subroutine getKcmatStickSlip(obj) class(ContactMechanics_), intent(inout) :: obj end subroutine ! ##################################################### ! ##################################################### ! From here, imported from old library ! ##################################################### !============================================================= !itr =1 ;state stick !---------------------- subroutine state_stick(j, nod_max, old_nod_coord, nts_elem_nod, active_nts & , nts_amo, k_contact, nts_mat, contact_mat_para, uvec, fvec_contact, stick_slip) !現在のnts_elementについて、すべてstick状態としてk_contactの計算 real(real64), allocatable ::x2s(:), x11(:), x12(:), evec(:), avec(:), nvec(:) & , k_st(:, :), ns(:), n0s(:), ts(:), ts_st(:), t0s(:), ngz0(:), fvec_e(:), nod_coord(:, :), & nvec_(:), tvec_(:), x1(:), x2(:), x3(:), x4(:), x5(:), x6(:), tvec(:), mvec(:), yi(:), Dns(:, :), & ym(:), ys(:), nvec__(:), ovec(:), mvec_(:), mvec__(:), Dns_1(:), Dns_2(:), Dns_3(:), domega_mat(:), & Dns_1_1(:), Ivec(:), dtmat(:, :), dmmat(:, :), dnmat__(:, :), dgzivec(:), dalpha(:), dHvec(:), nt(:), & Dnt(:, :), dT0vec(:), dtmat_(:, :), dselvec(:), dmmat_(:, :), dgzi_hat_vec(:), dganma_hat_vec(:), & dganmavec_(:), dnmat_(:, :), dgzivec_(:), dsjkvec(:), dlamdavec_(:), Svec(:), Ft(:), yL(:), tvec__(:), & ye(:), yj(:), yk(:), c_nod_coord(:, :) real(real64), intent(inout)::nts_amo(:, :), k_contact(:, :), fvec_contact(:) real(real64), intent(in) :: old_nod_coord(:, :), uvec(:), contact_mat_para(:, :) integer, intent(in) :: j, nod_max, nts_elem_nod(:, :), active_nts(:), nts_mat(:) integer, intent(inout) :: stick_slip(:) real(real64) c, phy, en, ct, gns, gz, l, pn, tts, gt, gz0, alpha, omega, gns_, gz_, sjk, delta real(real64) gzi_hat, delta_hat, ganma_, kappa, S0, ganma, gzi_, ganma_hat, lamda_, T0, dfdtn, HH, sel integer i, ii, k, beta, i_1, ii_1, node_ID ! 0 duvecの格納,ξ,ｇN等諸量の格納 allocate (x2s(2), x11(2), x12(2), evec(3), avec(3), nvec(3), k_st(8, 8), & ns(8), n0s(8), ts(8), t0s(8), ngz0(8), ts_st(8), fvec_e(8), tvec(2), mvec(2)) allocate (nvec_(3), tvec_(3), x1(2), x2(2), x3(2), x4(2), x5(2), x6(2), yi(2)) allocate (ym(2), ys(2), nvec__(2), ovec(2), mvec_(2), mvec__(2), Dns(8, 8), Dns_1_1(8)) allocate (Dns_1(8), domega_mat(8), Ivec(2)) allocate (dtmat(2, 8), dmmat(2, 8), dnmat__(2, 8), dgzivec(8), dalpha(8), dHvec(8)) allocate (nod_coord(size(old_nod_coord, 1), size(old_nod_coord, 2))) allocate (nt(8), Dnt(8, 8), dT0vec(8), dtmat_(2, 8), dselvec(8), dmmat_(2, 8), dgzi_hat_vec(8)) allocate (dganma_hat_vec(8), dganmavec_(8), dnmat_(2, 8), dgzivec_(8), dsjkvec(8), dlamdavec_(8)) allocate (Svec(8), Ft(8), yL(2), tvec__(1:2)) allocate (ye(2), yj(2), yk(2), c_nod_coord(size(nod_coord, 1), size(nod_coord, 2))) do i = 1, size(nod_coord, 1) nod_coord(i, 1) = old_nod_coord(i, 1) nod_coord(i, 2) = old_nod_coord(i, 2) end do do i = 1, size(nod_coord, 1) c_nod_coord(i, 1) = nod_coord(i, 1) + uvec(2*i - 1) c_nod_coord(i, 2) = nod_coord(i, 2) + uvec(2*i) end do !-----材料パラメータの読み込み------ en = contact_mat_para(nts_mat(active_nts(j)), 2) ct = contact_mat_para(nts_mat(active_nts(j)), 1) c = contact_mat_para(nts_mat(active_nts(j)), 3) phy = contact_mat_para(nts_mat(active_nts(j)), 4) !-------------------------------- delta = 1.0e-5 tts = nts_amo(active_nts(j), 12) nts_amo(active_nts(j), 11) = tts !dfdtn=nts_amo(active_nts(j),10) if (tts >= 0.0d0) then dfdtn = 1.0d0 elseif (tts < 0.0d0) then dfdtn = -1.0d0 else stop "invalid tTs" end if !以下、初期座標＋変位により、位置ベクトルを更新し、諸量を更新 !gz更新 x1(1:2) = uvec(2*nts_elem_nod(active_nts(j), 1) - 1: & 2*nts_elem_nod(active_nts(j), 1)) + & nod_coord(nts_elem_nod(active_nts(j), 1), 1:2) x2(1:2) = uvec(2*nts_elem_nod(active_nts(j), 2) - 1: & 2*nts_elem_nod(active_nts(j), 2)) + & nod_coord(nts_elem_nod(active_nts(j), 2), 1:2) x3(1:2) = uvec(2*nts_elem_nod(active_nts(j), 3) - 1: & 2*nts_elem_nod(active_nts(j), 3)) + & nod_coord(nts_elem_nod(active_nts(j), 3), 1:2) x4(1:2) = uvec(2*nts_elem_nod(active_nts(j), 4) - 1: & 2*nts_elem_nod(active_nts(j), 4)) + & nod_coord(nts_elem_nod(active_nts(j), 4), 1:2) x5(1:2) = uvec(2*nts_elem_nod(active_nts(j), 5) - 1: & 2*nts_elem_nod(active_nts(j), 5)) + & nod_coord(nts_elem_nod(active_nts(j), 5), 1:2) x6(1:2) = uvec(2*nts_elem_nod(active_nts(j), 6) - 1: & 2*nts_elem_nod(active_nts(j), 6)) + & nod_coord(nts_elem_nod(active_nts(j), 6), 1:2) node_ID = active_nts(j) call get_beta_st_nts(node_ID, nts_elem_nod, c_nod_coord, beta) if (beta == 1) then x2s(1:2) = x1(:) x11(1:2) = x2(:) x12(1:2) = x3(:) yi(1:2) = x4(:) yj(1:2) = x2(1:2) yk(1:2) = x3(1:2) ys(1:2) = x1(1:2) ym(1:2) = x2(1:2) ye(1:2) = x3(1:2) else x2s(1:2) = x1(:) x11(1:2) = x4(:) x12(1:2) = x2(:) yi(1:2) = x3(:) yj(1:2) = x4(1:2) yk(1:2) = x2(1:2) ys(1:2) = x1(1:2) ym(1:2) = x2(1:2) ye(1:2) = x4(1:2) end if ! 0 duvecの格納,ξ,ｇN等諸量の格納 !----------------------------------------------------------------------- !----------------------------------------------------------------------- nvec(3) = 0.0d0 avec(3) = 0.0d0 evec(1) = 0.0d0 evec(2) = 0.0d0 evec(3) = 1.0d0 Ivec(1) = 1.0d0 Ivec(2) = 1.0d0 nvec_(3) = 0.0d0 tvec_(3) = 0.0d0 !---------------------------------- l = dot_product(yj(1:2) - yk(1:2), yj(1:2) - yk(1:2)) l = dsqrt(l) sjk = l if (l == 0.0d0) then print *, "l=0 at element No.", node_ID stop end if avec(1:2) = (yk(1:2) - yj(1:2))/l nvec(:) = cross_product(evec, avec) gz = 1.0d0/l*dot_product(ys(1:2) - yj(1:2), avec(1:2)) gns = dot_product((ys(:) - ym(:)), nvec(1:2)) !alpha=4.0d0*gz*(1.0d0-gz) !alpha=0.50d0*(1.0d0-cos(2.0d0*3.1415926535d0*gz) ) !alpha=exp( -delta*delta*(2.0d0*gz-1.0d0)**2.0d0 ) alpha = 1.0d0 !alpha=0.0d0 yL(:) = yi(:) + alpha*(ym(:) - yi(:)) sel = dsqrt(dot_product(ye - yL, ye - yL)) gz0 = gz - tts/ct/sel if (sel == 0.0d0) then stop "error check_gn" end if tvec_(1:2) = (ye(:) - yL(:))/sel nvec_(:) = cross_product(evec, tvec_) tvec(1:2) = avec(1:2) mvec(:) = gz*tvec(:) - gns/sjk*nvec(:) nvec__(1:2) = nvec_(1:2)*dble(beta) !gnsの計算と更新----------------------------------------------------- gns_ = dot_product((ys(:) - ym(:)), nvec__(1:2)) gz_ = 1.0d0/sel*dot_product(ys - ym, tvec_(1:2)) !get f_contact(normal),K_contact(normal) !compute common variables gzi_ = 1.0d0/sel*dot_product(ys - ym, tvec_(1:2)) ganma_hat = 1.0d0/sel*dot_product(ym - yi, nvec_(1:2)) !HH=4.0d0*(1.0d0-2.0d0*gz) !HH=-3.1415926535d0*cos(2.0d0*3.1415926535d0*gz) HH = alpha*(delta*delta)*(4.0d0 - 8.0d0*gz) HH = 0.0d0 omega = 1.0d0/sjk*HH*gz_*dot_product(ym - yi, nvec__(1:2)) gzi_hat = 1.0d0/sel*dot_product(ym - yi, tvec_(1:2)) delta_hat = dot_product(ym - yi, nvec_(1:2)) ganma_ = 1.0d0/sel*dot_product(ys - ym, nvec_(1:2)) ganma = gns/sjk ovec(1:2) = gz*nvec(1:2) + ganma*tvec(1:2) mvec_(1:2) = gzi_*tvec_(1:2) - ganma_*nvec_(1:2) mvec__(1:2) = gzi_*tvec_(1:2) - ganma_*nvec_(1:2) !kappa=-8.0d0 !kappa=-2.0d0*3.1415926535d0*3.1415926535d0*cos(2.0d0*3.1415926535d0*gz) !kappa=8.0d0 kappa = alpha*(delta)*(delta)*(delta)*(delta)*(4.0d0 - 8.0d0*gz) - 8.0d0*alpha*(delta*delta) kappa = 0.0d0 tvec__(1:2) = dble(beta)*tvec_(1:2) S0 = delta_hat*dble(beta)/sjk*(kappa*gzi_ + HH*HH*(2.0d0*gzi_*gzi_hat - ganma_*ganma_hat)) if (beta == 1) then !normal part >>> ns(1:2) = omega*(tvec(1:2)) ns(3:4) = omega*(mvec(1:2) - tvec(1:2))!!+- ns(5:6) = omega*(-mvec(1:2)) ns(7:8) = 0.0d0 ns(1:2) = ns(1:2) + nvec__(1:2) ns(3:4) = ns(3:4) - (1.0d0 - alpha*gz_)*nvec__(1:2) ns(5:6) = ns(5:6) - gz_*nvec__(1:2) ns(7:8) = ns(7:8) + (1.0d0 - alpha)*gz_*nvec__(1:2) Dns_1_1(1:2) = tvec(1:2) Dns_1_1(3:4) = mvec(1:2) - tvec(1:2) Dns_1_1(5:6) = -mvec(:) Dns_1_1(7:8) = 0.0d0 domega_mat(1:2) = 1.0d0/sjk*S0*tvec(:) domega_mat(3:4) = 1.0d0/sjk*(S0*(mvec(1:2) - tvec(1:2)) + omega*tvec(1:2))!!+- domega_mat(5:6) = 1.0d0/sjk*(-S0*mvec(1:2) - omega*tvec(1:2)) domega_mat(7:8) = 0.0d0 domega_mat(1:2) = domega_mat(1:2) + HH/sjk*ganma_hat*tvec__(1:2) domega_mat(3:4) = domega_mat(3:4) + HH/sjk*(ganma_hat*(alpha*mvec__(1:2) - tvec__(1:2)) + gzi_*(1.0d0 + alpha*gzi_hat)*nvec__(1:2)) domega_mat(5:6) = domega_mat(5:6) + HH/sjk*(-ganma_hat*mvec__(1:2) - gzi_*ganma_hat*nvec__(1:2)) domega_mat(7:8)=domega_mat(7:8)+HH/sjk*(gzi_*(-1.0d0+(1.0d0-alpha )*gzi_hat)*nvec__(1:2)+ganma_hat*(1.0d0-alpha)*mvec__(1:2) ) dtmat(1:2, 1:2) = 0.0d0 dtmat(1:2, 3:4) = -diadic(nvec(1:2), nvec(1:2))/sjk!!+- dtmat(1:2, 5:6) = diadic(nvec(1:2), nvec(1:2))/sjk dtmat(1:2, 7:8) = 0.0d0 dmmat(1:2, 1:2) = (diadic(tvec(1:2), tvec(1:2)) - diadic(nvec(1:2), nvec(1:2)))/sjk!!+- dmmat(1:2, 3:4) = (-diadic(tvec(1:2), tvec(1:2)) + diadic(nvec(1:2), nvec(1:2)) + diadic(tvec(1:2), mvec(1:2)) & - diadic(nvec(1:2), ovec(1:2)) - diadic(ovec(1:2), nvec(1:2)))/sjk dmmat(1:2, 5:6) = (-diadic(tvec(1:2), mvec(1:2)) & + diadic(nvec(1:2), ovec(1:2)) + diadic(ovec(1:2), nvec(1:2)))/sjk dmmat(1:2, 7:8) = 0.0d0 dnmat__(1:2, 1:2) = HH*ganma_hat/sjk*diadic(tvec__(1:2), tvec(1:2)) dnmat__(1:2, 3:4) = HH*ganma_hat/sjk*diadic(tvec__(1:2), mvec(1:2) - tvec(1:2))!!+- dnmat__(1:2, 5:6) = -HH*ganma_hat/sjk*diadic(tvec__(1:2), mvec(1:2)) dnmat__(1:2, 7:8) = 0.0d0 dnmat__(1:2, 1:2) = dnmat__(1:2, 1:2) + 0.0d0 dnmat__(1:2, 3:4) = dnmat__(1:2, 3:4) + 1.0d0/sel*alpha*diadic(tvec__(1:2), nvec_(1:2)) dnmat__(1:2, 5:6) = dnmat__(1:2, 5:6) - 1.0d0/sel*diadic(tvec__(1:2), nvec_(1:2)) dnmat__(1:2, 7:8) = dnmat__(1:2, 7:8) + 1.0d0/sel*(1.0d0 - alpha)*diadic(tvec__(1:2), nvec_(1:2)) dgzivec(1:2) = 1.0d0/sjk*tvec(1:2) dgzivec(3:4) = 1.0d0/sjk*(mvec(1:2) - tvec(1:2))!!+- dgzivec(5:6) = -1.0d0/sjk*mvec(1:2) dgzivec(7:8) = 0.0d0 dalpha(1:2) = HH/sjk*tvec(1:2) dalpha(3:4) = HH/sjk*(mvec(1:2) - tvec(1:2))!!+- dalpha(5:6) = -HH/sjk*mvec(1:2) dalpha(7:8) = 0.0d0 dHvec(1:2) = kappa/sjk*tvec(1:2) dHvec(3:4) = kappa/sjk*(mvec(1:2) - tvec(1:2))!!+- dHvec(5:6) = -kappa/sjk*mvec(1:2) dHvec(7:8) = 0.0d0 dgzivec_(1:2) = HH*(gzi_*gzi_hat - ganma_*ganma_hat)/sjk*tvec(1:2) dgzivec_(3:4) = HH*(gzi_*gzi_hat - ganma_*ganma_hat)/sjk*(mvec(1:2) - tvec(1:2))!!+- dgzivec_(5:6) = -HH*(gzi_*gzi_hat - ganma_*ganma_hat)/sjk*mvec(1:2) dgzivec_(7:8) = 0.0d0 dgzivec_(1:2) = dgzivec_(1:2) + 1.0d0/sel*tvec_(1:2) dgzivec_(3:4) = dgzivec_(3:4) + 1.0d0/sel*(alpha*mvec_(1:2) - tvec_(1:2)) dgzivec_(5:6) = dgzivec_(5:6) + 1.0d0/sel*(-1.0d0)*mvec_(1:2) dgzivec_(7:8) = dgzivec_(7:8) + 1.0d0/sel*(1.0d0 - alpha)*mvec_(1:2) Dns(1:8, 1:8) = diadic(Dns_1_1, domega_mat) Dns(1:2, 1:8) = Dns(1:2, 1:8) + omega*dtmat(1:2, 1:8) Dns(3:4, 1:8) = Dns(3:4, 1:8) + omega*(dmmat(1:2, 1:8) - dtmat(1:2, 1:8))!!+- Dns(5:6, 1:8) = Dns(5:6, 1:8) + omega*(-dmmat(1:2, 1:8)) Dns(7:8, 1:8) = Dns(7:8, 1:8) + 0.0d0 Dns(1:2, 1:8) = Dns(1:2, 1:8) + dnmat__(1:2, 1:8) Dns(3:4, 1:8) = Dns(3:4, 1:8) + diadic(nvec__(1:2), alpha*dgzivec_(1:8) + gzi_*dalpha(1:8)) - (1.0d0 - alpha*gzi_)*dnmat__(1:2, 1:8) Dns(5:6, 1:8) = Dns(5:6, 1:8) - diadic(nvec__(1:2), dgzivec_(1:8)) - gzi_*dnmat__(1:2, 1:8) Dns(7:8,1:8)=Dns(7:8,1:8)+diadic(nvec__(1:2),(1.0d0-alpha)*dgzivec_(1:8)-gzi_*dalpha(1:8) )+(1.0d0-alpha)*gzi_*dnmat__(1:2,1:8) fvec_e(1:8) = en*gns_*ns(1:8) K_st(1:8, 1:8) = en*(diadic(ns, ns) + gns_*Dns(1:8, 1:8)) ! note >> du(1),du(2),du(3),du(4) !tangential part>>> dnmat_(1:2, 1:2) = HH*ganma_hat/sjk*diadic(tvec_(1:2), tvec(1:2)) dnmat_(1:2, 3:4) = HH*ganma_hat/sjk*diadic(tvec_(1:2), mvec(1:2) - tvec(1:2))!!+- dnmat_(1:2, 5:6) = -HH*ganma_hat/sjk*diadic(tvec_(1:2), mvec(1:2)) dnmat_(1:2, 7:8) = 0.0d0 dnmat_(1:2, 1:2) = dnmat__(1:2, 1:2) + 0.0d0 dnmat_(1:2, 3:4) = dnmat__(1:2, 3:4) + 1.0d0/sel*alpha*diadic(tvec_(1:2), nvec_(1:2)) dnmat_(1:2, 5:6) = dnmat__(1:2, 5:6) - 1.0d0/sel*diadic(tvec_(1:2), nvec_(1:2)) dnmat_(1:2, 7:8) = dnmat__(1:2, 7:8) + 1.0d0/sel*(1.0d0 - alpha)*diadic(tvec_(1:2), nvec_(1:2)) dganmavec_(1:2) = HH*(gzi_*ganma_hat + gzi_hat*ganma_)/sjk*(tvec(1:2)) dganmavec_(3:4) = HH*(gzi_*ganma_hat + gzi_hat*ganma_)/sjk*(mvec(1:2) - tvec(1:2))!!+- dganmavec_(5:6) = HH*(gzi_*ganma_hat + gzi_hat*ganma_)/sjk*(-mvec(1:2)) dganmavec_(7:8) = 0.0d0 dganmavec_(1:2) = dganmavec_(1:2) + 1.0d0/sel*(nvec_(1:2)) dganmavec_(3:4) = dganmavec_(3:4) + 1.0d0/sel*(alpha*(gzi_*nvec_(1:2) + ganma_*tvec_(1:2)) - nvec_(1:2)) dganmavec_(5:6) = dganmavec_(5:6) + 1.0d0/sel*(-(gzi_*nvec_(1:2) + ganma_*tvec_(1:2))) dganmavec_(7:8) = dganmavec_(7:8) + 1.0d0/sel*((1.0d0 - alpha)*(gzi_*nvec_(1:2) + ganma_*tvec_(1:2))) dganma_hat_vec(1:2) = 2.0d0*HH*gzi_hat*ganma_hat/sjk*(tvec(1:2)) dganma_hat_vec(3:4) = 2.0d0*HH*gzi_hat*ganma_hat/sjk*(mvec(1:2) - tvec(1:2))!!+- dganma_hat_vec(5:6) = 2.0d0*HH*gzi_hat*ganma_hat/sjk*(-mvec(1:2)) dganma_hat_vec(7:8) = 0.0d0 dganma_hat_vec(1:2) = dganma_hat_vec(1:2) + 0.0d0 dganma_hat_vec(3:4) = dganma_hat_vec(3:4) + 1.0d0/sel*(alpha*(gzi_hat*nvec_(1:2) + ganma_hat*tvec_(1:2)) + nvec_(1:2)) dganma_hat_vec(5:6) = dganma_hat_vec(5:6) + 1.0d0/sel*(-(gzi_hat*nvec_(1:2) + ganma_hat*tvec_(1:2))) dganma_hat_vec(7:8) = dganma_hat_vec(7:8) + 1.0d0/sel*((1.0d0 - alpha)*(gzi_hat*nvec_(1:2) + ganma_hat*tvec_(1:2)) - nvec_(1:2)) dgzi_hat_vec(1:2) = HH*(gzi_hat*gzi_hat - ganma_hat*ganma_hat)/sjk*(tvec(1:2)) dgzi_hat_vec(3:4) = HH*(gzi_hat*gzi_hat - ganma_hat*ganma_hat)/sjk*(mvec(1:2) - tvec(1:2))!!+- dgzi_hat_vec(5:6) = HH*(gzi_hat*gzi_hat - ganma_hat*ganma_hat)/sjk*(-mvec(1:2)) dgzi_hat_vec(7:8) = 0.0d0 dgzi_hat_vec(1:2) = dgzi_hat_vec(1:2) + 0.0d0 dgzi_hat_vec(3:4) = dgzi_hat_vec(3:4) + 1.0d0/sel*((gzi_hat*tvec_(1:2) - ganma_hat*nvec_(1:2))*alpha + tvec_(1:2)) dgzi_hat_vec(5:6) = dgzi_hat_vec(5:6) + 1.0d0/sel*(-(gzi_hat*tvec_(1:2) - ganma_hat*nvec_(1:2))) dgzi_hat_vec(7:8) = dgzi_hat_vec(7:8) + 1.0d0/sel*((1.0d0 - alpha)*(gzi_hat*tvec_(1:2) - ganma_hat*nvec_(1:2)) - tvec_(1:2)) dtmat_(1:2, 1:2) = HH*ganma_hat/sjk*(-1.0d0)*(diadic(nvec_(1:2), tvec(1:2))) dtmat_(1:2, 3:4) = HH*ganma_hat/sjk*(-1.0d0)*(diadic(nvec_(1:2), mvec(1:2) - tvec(1:2)))!!+- dtmat_(1:2, 5:6) = HH*ganma_hat/sjk*(1.0d0)*(diadic(nvec_(1:2), mvec(1:2))) dtmat_(1:2, 7:8) = 0.0d0 dtmat_(1:2, 1:2) = dtmat_(1:2, 1:2) + 0.0d0 dtmat_(1:2, 3:4) = dtmat_(1:2, 3:4) + 1.0d0/sel*(-1.0d0)*alpha*diadic(nvec_(1:2), nvec_(1:2)) dtmat_(1:2, 5:6) = dtmat_(1:2, 5:6) + 1.0d0/sel*(1.0d0)*diadic(nvec_(1:2), nvec_(1:2)) dtmat_(1:2, 7:8) = dtmat_(1:2, 7:8) + 1.0d0/sel*(-1.0d0 + alpha)*diadic(nvec_(1:2), nvec_(1:2)) dmmat_(1:2, 1:8) = diadic(tvec_(1:2), dgzivec_(1:8)) dmmat_(1:2, 1:8) = dmmat_(1:2, 1:8) + gzi_*dtmat_(1:2, 1:8) dmmat_(1:2, 1:8) = dmmat_(1:2, 1:8) + diadic(nvec_(1:2), dganmavec_(1:8)) dmmat_(1:2, 1:8) = dmmat_(1:2, 1:8) + ganma_*dnmat_(1:2, 1:8) dselvec(1:2) = sel*HH*gzi_hat/sjk*(-1.0d0)*tvec(1:2) dselvec(3:4) = sel*HH*gzi_hat/sjk*(-1.0d0)*(mvec(1:2) - tvec(1:2)) dselvec(5:6) = sel*HH*gzi_hat/sjk*mvec(1:2) dselvec(7:8) = 0.0d0 dselvec(1:2) = dselvec(1:2) + 0.0d0 dselvec(3:4) = dselvec(3:4) + (-alpha)*tvec_(1:2) !!+- dselvec(5:6) = dselvec(5:6) + tvec_(1:2) dselvec(7:8) = dselvec(7:8) - (1.0d0 - alpha)*tvec_(1:2) dlamdavec_(1:8) = gzi_*dgzi_hat_vec(1:8) + gzi_hat*dgzivec_(1:8) & - ganma_hat*dganmavec_(1:8) - ganma_*dganma_hat_vec(1:8) !original part dsjkvec(1:2) = dble(beta)*0.0d0 dsjkvec(3:4) = dble(beta)*(-1.0d0)*tvec(1:2) dsjkvec(5:6) = dble(beta)*tvec(1:2) dsjkvec(7:8) = dble(beta)*0.0d0 lamda_ = gzi_*gzi_hat - ganma_*ganma_hat T0 = 1.0d0/sjk*HH*lamda_ dT0vec(1:8) = -HH*lamda_/sjk/sjk*dsjkvec(1:8) + HH/sjk*dlamdavec_(1:8) + lamda_/sjk*dHvec(1:8) Svec(1:2) = -sel*HH*gzi_hat/sjk*tvec(1:2) Svec(3:4) = -sel*HH*gzi_hat/sjk*mvec(1:2) - tvec(1:2)!!+- Svec(5:6) = -sel*HH*gzi_hat/sjk*(-mvec(1:2)) Svec(7:8) = 0.0d0 Svec(1:2) = Svec(1:2) + 0.0d0 Svec(3:4) = Svec(3:4) + (-alpha)*tvec_(1:2) Svec(5:6) = Svec(5:6) + tvec_(1:2) Svec(7:8) = Svec(7:8) - (1.0d0 - alpha)*tvec_(1:2) nt(1:2) = T0*tvec(1:2) nt(3:4) = T0*(mvec(1:2) - tvec(1:2))!!+- nt(5:6) = T0*(-mvec(1:2)) nt(7:8) = 0.0d0 nt(1:2) = nt(1:2) + 1.0d0/sel*tvec_(1:2) nt(3:4) = nt(3:4) + 1.0d0/sel*(alpha*mvec_(1:2) - tvec_(1:2)) nt(5:6) = nt(5:6) + 1.0d0/sel*(-mvec_(1:2)) nt(7:8) = nt(7:8) + 1.0d0/sel*(1.0d0 - alpha)*mvec_(1:2) Dnt(1:2, 1:8) = diadic(tvec(1:2), dT0vec(1:8)) + T0*dtmat(1:2, 1:8) Dnt(3:4, 1:8) = diadic(mvec(1:2) - tvec(1:2), dT0vec(1:8)) + T0*(dmmat(1:2, 1:8) - dtmat(1:2, 1:8))!!+- Dnt(5:6, 1:8) = -diadic(mvec(1:2), dT0vec(1:8)) - T0*dmmat(1:2, 1:8) Dnt(7:8, 1:8) = 0.0d0 Dnt(1:2, 1:8) = Dnt(1:2, 1:8) - 1.0d0/sel/sel*diadic(tvec_(1:2), dselvec(1:8)) Dnt(3:4, 1:8) = Dnt(3:4, 1:8) - 1.0d0/sel/sel*diadic(alpha*mvec_(1:2) - tvec_(1:2), dselvec(1:8)) !inverse original Dnt(5:6, 1:8) = Dnt(5:6, 1:8) - 1.0d0/sel/sel*diadic(-mvec_(1:2), dselvec(1:8)) Dnt(7:8, 1:8) = Dnt(7:8, 1:8) - 1.0d0/sel/sel*diadic((1.0d0 - alpha)*mvec_(1:2), dselvec(1:8)) Dnt(1:2, 1:8) = Dnt(1:2, 1:8) + 1.0d0/sel*dtmat_(1:2, 1:8) Dnt(3:4, 1:8) = Dnt(3:4, 1:8) + 1.0d0/sel*(diadic(mvec_(1:2), dalpha(1:8)) + alpha*dmmat_(1:2, 1:8) - dtmat_(1:2, 1:8))!inverse original Dnt(5:6, 1:8) = Dnt(5:6, 1:8) + 1.0d0/sel*(-dmmat_(1:2, 1:8)) Dnt(7:8, 1:8) = Dnt(7:8, 1:8) + 1.0d0/sel*(-diadic(mvec_(1:2), dalpha(1:8)) + (1.0d0 - alpha)*dmmat_(1:2, 1:8)) if (stick_slip(active_nts(j)) == 0) then Ft(1:8) = dble(beta)*ct*sel*nt(1:8) elseif (stick_slip(active_nts(j)) == 1) then Ft(1:8) = en*tan(phy)*ns(1:8) else stop "invalid stick_slip on contact.f95" end if fvec_e(1:8) = fvec_e(1:8) + dble(beta)*tts*sel*nt(1:8) K_st(1:8,1:8)=K_st(1:8,1:8)+dble(beta)*transpose( sel*diadic(Ft(1:8),nt(1:8))+tts*diadic(Svec(1:8),nt(1:8))+tts*sel*Dnt(1:8,1:8)) fvec_e(:) = fvec_e(:)*l !integration K_st(:, :) = K_st(:, :)*l !integration do i = 1, 4 do ii = 1, 4 k_contact(2*nts_elem_nod(active_nts(j), i) - 1, 2*nts_elem_nod(active_nts(j), ii) - 1) & = k_contact(2*nts_elem_nod(active_nts(j), i) - 1, 2*nts_elem_nod(active_nts(j), ii) - 1) & + k_st(2*i - 1, 2*ii - 1) k_contact(2*nts_elem_nod(active_nts(j), i) - 1, 2*nts_elem_nod(active_nts(j), ii)) & = k_contact(2*nts_elem_nod(active_nts(j), i) - 1, 2*nts_elem_nod(active_nts(j), ii)) & + k_st(2*i - 1, 2*ii) k_contact(2*nts_elem_nod(active_nts(j), i), 2*nts_elem_nod(active_nts(j), ii) - 1) & = k_contact(2*nts_elem_nod(active_nts(j), i), 2*nts_elem_nod(active_nts(j), ii) - 1) & + k_st(2*i, 2*ii - 1) k_contact(2*nts_elem_nod(active_nts(j), i), 2*nts_elem_nod(active_nts(j), ii)) & = k_contact(2*nts_elem_nod(active_nts(j), i), 2*nts_elem_nod(active_nts(j), ii)) & + k_st(2*i, 2*ii) end do end do do i = 1, 4 fvec_contact(2*nts_elem_nod(active_nts(j), i) - 1) & = fvec_contact(2*nts_elem_nod(active_nts(j), i) - 1) + fvec_e(2*i - 1) fvec_contact(2*nts_elem_nod(active_nts(j), i)) & = fvec_contact(2*nts_elem_nod(active_nts(j), i)) + fvec_e(2*i) end do elseif (beta == -1) then !normal part >>> !normal part >>> ns(1:2) = omega*(tvec(1:2)) ns(3:4) = omega*(-mvec(1:2)) ns(5:6) = omega*(mvec(1:2) - tvec(1:2))!!+- ns(7:8) = 0.0d0 ns(1:2) = ns(1:2) + nvec__(1:2) ns(3:4) = ns(3:4) - (1.0d0 - alpha*gz_)*nvec__(1:2) ns(5:6) = ns(5:6) - gz_*nvec__(1:2) ns(7:8) = ns(7:8) + (1.0d0 - alpha)*gz_*nvec__(1:2) Dns_1_1(1:2) = tvec(1:2) Dns_1_1(3:4) = -mvec(:) Dns_1_1(5:6) = mvec(1:2) - tvec(1:2)!!+- Dns_1_1(7:8) = 0.0d0 domega_mat(1:2) = 1.0d0/sjk*S0*tvec(:) domega_mat(3:4) = 1.0d0/sjk*(-S0*mvec(1:2) - omega*tvec(1:2)) domega_mat(5:6) = 1.0d0/sjk*(S0*(mvec(1:2) - tvec(1:2)) + omega*tvec(1:2))!!+- domega_mat(7:8) = 0.0d0 domega_mat(1:2) = domega_mat(1:2) + HH/sjk*ganma_hat*tvec__(1:2) domega_mat(3:4) = domega_mat(3:4) + HH/sjk*(ganma_hat*(alpha*mvec__(1:2) - tvec__(1:2)) + gzi_*(1.0d0 + alpha*gzi_hat)*nvec__(1:2)) domega_mat(5:6) = domega_mat(5:6) + HH/sjk*(-ganma_hat*mvec__(1:2) - gzi_*ganma_hat*nvec__(1:2)) domega_mat(7:8)=domega_mat(7:8)+HH/sjk*(gzi_*(-1.0d0+(1.0d0-alpha )*gzi_hat)*nvec__(1:2)+ganma_hat*(1.0d0-alpha)*mvec__(1:2) ) dtmat(1:2, 1:2) = 0.0d0 dtmat(1:2, 3:4) = diadic(nvec(1:2), nvec(1:2))/sjk dtmat(1:2, 5:6) = -diadic(nvec(1:2), nvec(1:2))/sjk!!+- dtmat(1:2, 7:8) = 0.0d0 dmmat(1:2, 1:2) = (diadic(tvec(1:2), tvec(1:2)) - diadic(nvec(1:2), nvec(1:2)))/sjk dmmat(1:2, 3:4) = (-diadic(tvec(1:2), mvec(1:2)) & + diadic(nvec(1:2), ovec(1:2)) + diadic(ovec(1:2), nvec(1:2)))/sjk dmmat(1:2, 5:6) = (-diadic(tvec(1:2), tvec(1:2)) + diadic(nvec(1:2), nvec(1:2)) + diadic(tvec(1:2), mvec(1:2)) & - diadic(nvec(1:2), ovec(1:2)) - diadic(ovec(1:2), nvec(1:2)))/sjk!!+- dmmat(1:2, 7:8) = 0.0d0 dnmat__(1:2, 1:2) = HH*ganma_hat/sjk*diadic(tvec__(1:2), tvec(1:2)) dnmat__(1:2, 3:4) = -HH*ganma_hat/sjk*diadic(tvec__(1:2), mvec(1:2)) dnmat__(1:2, 5:6) = HH*ganma_hat/sjk*diadic(tvec__(1:2), mvec(1:2) - tvec(1:2))!!+- dnmat__(1:2, 7:8) = 0.0d0 dnmat__(1:2, 1:2) = dnmat__(1:2, 1:2) + 0.0d0 dnmat__(1:2, 3:4) = dnmat__(1:2, 3:4) + 1.0d0/sel*alpha*diadic(tvec__(1:2), nvec_(1:2)) dnmat__(1:2, 5:6) = dnmat__(1:2, 5:6) - 1.0d0/sel*diadic(tvec__(1:2), nvec_(1:2)) dnmat__(1:2, 7:8) = dnmat__(1:2, 7:8) + 1.0d0/sel*(1.0d0 - alpha)*diadic(tvec__(1:2), nvec_(1:2)) dgzivec(1:2) = 1.0d0/sjk*tvec(1:2) dgzivec(3:4) = -1.0d0/sjk*mvec(1:2) dgzivec(5:6) = 1.0d0/sjk*(mvec(1:2) - tvec(1:2))!!+- dgzivec(7:8) = 0.0d0 dalpha(1:2) = HH/sjk*tvec(1:2) dalpha(3:4) = -HH/sjk*mvec(1:2) dalpha(5:6) = HH/sjk*(mvec(1:2) - tvec(1:2))!!+- dalpha(7:8) = 0.0d0 dHvec(1:2) = kappa/sjk*tvec(1:2) dHvec(3:4) = -kappa/sjk*mvec(1:2) dHvec(5:6) = kappa/sjk*(mvec(1:2) - tvec(1:2))!!+- dHvec(7:8) = 0.0d0 dgzivec_(1:2) = HH*(gzi_*gzi_hat - ganma_*ganma_hat)/sjk*tvec(1:2) dgzivec_(3:4) = -HH*(gzi_*gzi_hat - ganma_*ganma_hat)/sjk*mvec(1:2) dgzivec_(5:6) = HH*(gzi_*gzi_hat - ganma_*ganma_hat)/sjk*(mvec(1:2) - tvec(1:2))!!+- dgzivec_(7:8) = 0.0d0 dgzivec_(1:2) = dgzivec_(1:2) + 1.0d0/sel*tvec_(1:2) dgzivec_(3:4) = dgzivec_(3:4) + 1.0d0/sel*(alpha*mvec_(1:2) - tvec_(1:2)) dgzivec_(5:6) = dgzivec_(5:6) + 1.0d0/sel*(-1.0d0)*mvec_(1:2) dgzivec_(7:8) = dgzivec_(7:8) + 1.0d0/sel*(1.0d0 - alpha)*mvec_(1:2) Dns(1:8, 1:8) = diadic(Dns_1_1, domega_mat) Dns(1:2, 1:8) = Dns(1:2, 1:8) + omega*dtmat(1:2, 1:8) Dns(3:4, 1:8) = Dns(3:4, 1:8) + omega*(-dmmat(1:2, 1:8)) Dns(5:6, 1:8) = Dns(5:6, 1:8) + omega*(dmmat(1:2, 1:8) - dtmat(1:2, 1:8))!!+- Dns(7:8, 1:8) = Dns(7:8, 1:8) + 0.0d0 Dns(1:2, 1:8) = Dns(1:2, 1:8) + dnmat__(1:2, 1:8) Dns(3:4, 1:8) = Dns(3:4, 1:8) + diadic(nvec__(1:2), alpha*dgzivec_(1:8) + gzi_*dalpha(1:8)) - (1.0d0 - alpha*gzi_)*dnmat__(1:2, 1:8) Dns(5:6, 1:8) = Dns(5:6, 1:8) - diadic(nvec__(1:2), dgzivec_(1:8)) - gzi_*dnmat__(1:2, 1:8) Dns(7:8,1:8)=Dns(7:8,1:8)+diadic(nvec__(1:2),(1.0d0-alpha)*dgzivec_(1:8)-gzi_*dalpha(1:8) )+(1.0d0-alpha)*gzi_*dnmat__(1:2,1:8) fvec_e(1:8) = en*gns_*ns(1:8) K_st(1:8, 1:8) = en*(diadic(ns, ns) + gns_*Dns(1:8, 1:8)) ! note >> du(1),du(2),du(3),du(4) !tangential part>>> dnmat_(1:2, 1:2) = HH*ganma_hat/sjk*diadic(tvec_(1:2), tvec(1:2)) dnmat_(1:2, 3:4) = -HH*ganma_hat/sjk*diadic(tvec_(1:2), mvec(1:2)) dnmat_(1:2, 5:6) = HH*ganma_hat/sjk*diadic(tvec_(1:2), mvec(1:2) - tvec(1:2))!!+- dnmat_(1:2, 7:8) = 0.0d0 dnmat_(1:2, 1:2) = dnmat__(1:2, 1:2) + 0.0d0 dnmat_(1:2, 3:4) = dnmat__(1:2, 3:4) + 1.0d0/sel*alpha*diadic(tvec_(1:2), nvec_(1:2)) dnmat_(1:2, 5:6) = dnmat__(1:2, 5:6) - 1.0d0/sel*diadic(tvec_(1:2), nvec_(1:2)) dnmat_(1:2, 7:8) = dnmat__(1:2, 7:8) + 1.0d0/sel*(1.0d0 - alpha)*diadic(tvec_(1:2), nvec_(1:2)) dganmavec_(1:2) = HH*(gzi_*ganma_hat + gzi_hat*ganma_)/sjk*(tvec(1:2)) dganmavec_(3:4) = HH*(gzi_*ganma_hat + gzi_hat*ganma_)/sjk*(-mvec(1:2)) dganmavec_(5:6) = HH*(gzi_*ganma_hat + gzi_hat*ganma_)/sjk*(mvec(1:2) - tvec(1:2))!!+- dganmavec_(7:8) = 0.0d0 dganmavec_(1:2) = dganmavec_(1:2) + 1.0d0/sel*(nvec_(1:2)) dganmavec_(3:4) = dganmavec_(3:4) + 1.0d0/sel*(alpha*(gzi_*nvec_(1:2) + ganma_*tvec_(1:2)) - nvec_(1:2)) dganmavec_(5:6) = dganmavec_(5:6) + 1.0d0/sel*(-(gzi_*nvec_(1:2) + ganma_*tvec_(1:2))) dganmavec_(7:8) = dganmavec_(7:8) + 1.0d0/sel*((1.0d0 - alpha)*(gzi_*nvec_(1:2) + ganma_*tvec_(1:2))) dganma_hat_vec(1:2) = 2.0d0*HH*gzi_hat*ganma_hat/sjk*(tvec(1:2)) dganma_hat_vec(3:4) = 2.0d0*HH*gzi_hat*ganma_hat/sjk*(-mvec(1:2)) dganma_hat_vec(5:6) = 2.0d0*HH*gzi_hat*ganma_hat/sjk*(mvec(1:2) - tvec(1:2))!!+- dganma_hat_vec(7:8) = 0.0d0 dganma_hat_vec(1:2) = dganma_hat_vec(1:2) + 0.0d0 dganma_hat_vec(3:4) = dganma_hat_vec(3:4) + 1.0d0/sel*(alpha*(gzi_hat*nvec_(1:2) + ganma_hat*tvec_(1:2)) + nvec_(1:2)) dganma_hat_vec(5:6) = dganma_hat_vec(5:6) + 1.0d0/sel*(-(gzi_hat*nvec_(1:2) + ganma_hat*tvec_(1:2))) dganma_hat_vec(7:8) = dganma_hat_vec(7:8) + 1.0d0/sel*((1.0d0 - alpha)*(gzi_hat*nvec_(1:2) + ganma_hat*tvec_(1:2)) - nvec_(1:2)) dgzi_hat_vec(1:2) = HH*(gzi_hat*gzi_hat - ganma_hat*ganma_hat)/sjk*(tvec(1:2)) dgzi_hat_vec(3:4) = HH*(gzi_hat*gzi_hat - ganma_hat*ganma_hat)/sjk*(-mvec(1:2)) dgzi_hat_vec(5:6) = HH*(gzi_hat*gzi_hat - ganma_hat*ganma_hat)/sjk*(mvec(1:2) - tvec(1:2))!!+- dgzi_hat_vec(7:8) = 0.0d0 dgzi_hat_vec(1:2) = dgzi_hat_vec(1:2) + 0.0d0 dgzi_hat_vec(3:4) = dgzi_hat_vec(3:4) + 1.0d0/sel*((gzi_hat*tvec_(1:2) - ganma_hat*nvec_(1:2))*alpha + tvec_(1:2)) dgzi_hat_vec(5:6) = dgzi_hat_vec(5:6) + 1.0d0/sel*(-(gzi_hat*tvec_(1:2) - ganma_hat*nvec_(1:2))) dgzi_hat_vec(7:8) = dgzi_hat_vec(7:8) + 1.0d0/sel*((1.0d0 - alpha)*(gzi_hat*tvec_(1:2) - ganma_hat*nvec_(1:2)) - tvec_(1:2)) dtmat_(1:2, 1:2) = HH*ganma_hat/sjk*(-1.0d0)*(diadic(nvec_(1:2), tvec(1:2))) dtmat_(1:2, 3:4) = HH*ganma_hat/sjk*(1.0d0)*(diadic(nvec_(1:2), mvec(1:2))) dtmat_(1:2, 5:6) = HH*ganma_hat/sjk*(-1.0d0)*(diadic(nvec_(1:2), mvec(1:2) - tvec(1:2)))!!+- dtmat_(1:2, 7:8) = 0.0d0 dtmat_(1:2, 1:2) = dtmat_(1:2, 1:2) + 0.0d0 dtmat_(1:2, 3:4) = dtmat_(1:2, 3:4) + 1.0d0/sel*(-1.0d0)*alpha*diadic(nvec_(1:2), nvec_(1:2)) dtmat_(1:2, 5:6) = dtmat_(1:2, 5:6) + 1.0d0/sel*(1.0d0)*diadic(nvec_(1:2), nvec_(1:2)) dtmat_(1:2, 7:8) = dtmat_(1:2, 7:8) + 1.0d0/sel*(-1.0d0 + alpha)*diadic(nvec_(1:2), nvec_(1:2)) dmmat_(1:2, 1:8) = diadic(tvec_(1:2), dgzivec_(1:8)) dmmat_(1:2, 1:8) = dmmat_(1:2, 1:8) + gzi_*dtmat_(1:2, 1:8) dmmat_(1:2, 1:8) = dmmat_(1:2, 1:8) + diadic(nvec_(1:2), dganmavec_(1:8)) dmmat_(1:2, 1:8) = dmmat_(1:2, 1:8) + ganma_*dnmat_(1:2, 1:8) dselvec(1:2) = sel*HH*gzi_hat/sjk*(-1.0d0)*tvec(1:2) dselvec(3:4) = sel*HH*gzi_hat/sjk*(-1.0d0)*(mvec(1:2) - tvec(1:2)) dselvec(5:6) = sel*HH*gzi_hat/sjk*mvec(1:2) dselvec(7:8) = 0.0d0 dselvec(1:2) = dselvec(1:2) + 0.0d0 dselvec(3:4) = dselvec(3:4) + tvec_(1:2) dselvec(5:6) = dselvec(5:6) + (-alpha)*tvec_(1:2) !!+- dselvec(7:8) = dselvec(7:8) - (1.0d0 - alpha)*tvec_(1:2) dlamdavec_(1:8) = gzi_*dgzi_hat_vec(1:8) + gzi_hat*dgzivec_(1:8) & - ganma_hat*dganmavec_(1:8) - ganma_*dganma_hat_vec(1:8) !original part dsjkvec(1:2) = dble(beta)*0.0d0 dsjkvec(3:4) = dble(beta)*(-1.0d0)*tvec(1:2) dsjkvec(5:6) = dble(beta)*tvec(1:2) dsjkvec(7:8) = dble(beta)*0.0d0 lamda_ = gzi_*gzi_hat - ganma_*ganma_hat T0 = 1.0d0/sjk*HH*lamda_ dT0vec(1:8) = -HH*lamda_/sjk/sjk*dsjkvec(1:8) + HH/sjk*dlamdavec_(1:8) + lamda_/sjk*dHvec(1:8) Svec(1:2) = -sel*HH*gzi_hat/sjk*tvec(1:2) Svec(3:4) = -sel*HH*gzi_hat/sjk*(-mvec(1:2)) Svec(5:6) = -sel*HH*gzi_hat/sjk*mvec(1:2) - tvec(1:2)!!+- Svec(7:8) = 0.0d0 Svec(1:2) = Svec(1:2) + 0.0d0 Svec(3:4) = Svec(3:4) + (-alpha)*tvec_(1:2) Svec(5:6) = Svec(5:6) + tvec_(1:2) Svec(7:8) = Svec(7:8) - (1.0d0 - alpha)*tvec_(1:2) nt(1:2) = T0*tvec(1:2) nt(3:4) = T0*(-mvec(1:2)) nt(5:6) = T0*(mvec(1:2) - tvec(1:2))!!+- nt(7:8) = 0.0d0 nt(1:2) = nt(1:2) + 1.0d0/sel*tvec_(1:2) nt(3:4) = nt(3:4) + 1.0d0/sel*(alpha*mvec_(1:2) - tvec_(1:2)) nt(5:6) = nt(5:6) + 1.0d0/sel*(-mvec_(1:2)) nt(7:8) = nt(7:8) + 1.0d0/sel*(1.0d0 - alpha)*mvec_(1:2) Dnt(1:2, 1:8) = diadic(tvec(1:2), dT0vec(1:8)) + T0*dtmat(1:2, 1:8) Dnt(3:4, 1:8) = -diadic(mvec(1:2), dT0vec(1:8)) - T0*dmmat(1:2, 1:8) Dnt(5:6, 1:8) = diadic(mvec(1:2) - tvec(1:2), dT0vec(1:8)) + T0*(dmmat(1:2, 1:8) - dtmat(1:2, 1:8))!!+- Dnt(7:8, 1:8) = 0.0d0 Dnt(1:2, 1:8) = Dnt(1:2, 1:8) - 1.0d0/sel/sel*diadic(tvec_(1:2), dselvec(1:8)) Dnt(3:4, 1:8) = Dnt(3:4, 1:8) - 1.0d0/sel/sel*diadic(alpha*mvec_(1:2) - tvec_(1:2), dselvec(1:8)) !inverse original Dnt(5:6, 1:8) = Dnt(5:6, 1:8) - 1.0d0/sel/sel*diadic(-mvec_(1:2), dselvec(1:8)) Dnt(7:8, 1:8) = Dnt(7:8, 1:8) - 1.0d0/sel/sel*diadic((1.0d0 - alpha)*mvec_(1:2), dselvec(1:8)) Dnt(1:2, 1:8) = Dnt(1:2, 1:8) + 1.0d0/sel*dtmat_(1:2, 1:8) Dnt(3:4, 1:8) = Dnt(3:4, 1:8) + 1.0d0/sel*(diadic(mvec_(1:2), dalpha(1:8)) + alpha*dmmat_(1:2, 1:8) - dtmat_(1:2, 1:8))!inverse original Dnt(5:6, 1:8) = Dnt(5:6, 1:8) + 1.0d0/sel*(-dmmat_(1:2, 1:8)) Dnt(7:8, 1:8) = Dnt(7:8, 1:8) + 1.0d0/sel*(-diadic(mvec_(1:2), dalpha(1:8)) + (1.0d0 - alpha)*dmmat_(1:2, 1:8)) if (stick_slip(active_nts(j)) == 0) then Ft(1:8) = dble(beta)*ct*sel*nt(1:8) elseif (stick_slip(active_nts(j)) == 1) then Ft(1:8) = en*tan(phy)*ns(1:8) else stop "invalid stick_slip on contact.f95" end if fvec_e(1:8) = fvec_e(1:8) + dble(beta)*tts*sel*nt(1:8) K_st(1:8,1:8)=K_st(1:8,1:8)+dble(beta)*transpose( sel*diadic(Ft(1:8),nt(1:8))+tts*diadic(Svec(1:8),nt(1:8))+tts*sel*Dnt(1:8,1:8)) fvec_e(:) = fvec_e(:)*l !integration K_st(:, :) = K_st(:, :)*l !integration do i = 1, 4 do ii = 1, 4 if (i == 3) then i_1 = 4 elseif (i == 4) then i_1 = 3 else i_1 = i end if if (ii == 3) then ii_1 = 4 elseif (ii == 4) then ii_1 = 3 else ii_1 = ii end if k_contact(2*nts_elem_nod(active_nts(j), i_1) - 1, 2*nts_elem_nod(active_nts(j), ii_1) - 1) & = k_contact(2*nts_elem_nod(active_nts(j), i_1) - 1, 2*nts_elem_nod(active_nts(j), ii_1) - 1) & + k_st(2*i_1 - 1, 2*ii_1 - 1) k_contact(2*nts_elem_nod(active_nts(j), i_1) - 1, 2*nts_elem_nod(active_nts(j), ii_1)) & = k_contact(2*nts_elem_nod(active_nts(j), i_1) - 1, 2*nts_elem_nod(active_nts(j), ii_1)) & + k_st(2*i_1 - 1, 2*ii_1) k_contact(2*nts_elem_nod(active_nts(j), i_1), 2*nts_elem_nod(active_nts(j), ii_1) - 1) & = k_contact(2*nts_elem_nod(active_nts(j), i_1), 2*nts_elem_nod(active_nts(j), ii_1) - 1) & + k_st(2*i_1, 2*ii_1 - 1) k_contact(2*nts_elem_nod(active_nts(j), i_1), 2*nts_elem_nod(active_nts(j), ii_1)) & = k_contact(2*nts_elem_nod(active_nts(j), i_1), 2*nts_elem_nod(active_nts(j), ii_1)) & + k_st(2*i_1, 2*ii_1) end do end do do i = 1, 4 if (i == 3) then i_1 = 4 elseif (i == 4) then i_1 = 3 else i_1 = i end if fvec_contact(2*nts_elem_nod(active_nts(j), i_1) - 1) & = fvec_contact(2*nts_elem_nod(active_nts(j), i_1) - 1) + fvec_e(2*i_1 - 1) fvec_contact(2*nts_elem_nod(active_nts(j), i_1)) & = fvec_contact(2*nts_elem_nod(active_nts(j), i_1)) + fvec_e(2*i_1) end do else stop "error :: invalid beta" end if !諸量の更新 nts_amo(active_nts(j), 1) = gz0 !trial gzi0 on current timestep nts_amo(active_nts(j), 2) = dble(beta) !trial beta on current timestep !nts_amo(active_nts(j),10) =gz !converged gzi at last timestep !nts_amo(active_nts(j),11) =pn !inactive end subroutine state_stick !============================================================ !check for contact: gn<0 → active NTS-element---------------- subroutine ls_check_active_CM(obj) class(ContactMechanics_), intent(inout) :: obj real(real64), allocatable::nod_coord(:, :) integer, allocatable ::check_active_nts(:) integer active_nts_max, i, j allocate (nod_coord(size(obj%old_nod_coord, 1), size(obj%old_nod_coord, 2))) do i = 1, size(nod_coord, 1) nod_coord(i, 1) = obj%old_nod_coord(i, 1) + obj%uvec(2*i - 1) + obj%duvec(2*i - 1) nod_coord(i, 2) = obj%old_nod_coord(i, 2) + obj%uvec(2*i) + obj%duvec(2*i) end do allocate (check_active_nts(size(obj%nts_elem_nod, 1))) do i = 1, size(obj%nts_elem_nod, 1) call check_gn(i, obj%nts_elem_nod, check_active_nts, nod_coord) end do active_nts_max = 0 do i = 1, size(obj%nts_elem_nod, 1) if (check_active_nts(i) == 1) then active_nts_max = active_nts_max + 1 !active elseif (check_active_nts(i) == 0) then cycle else stop "something wrong at check_active_nts" end if end do if (allocated(obj%active_nts)) deallocate (obj%active_nts) !print *, "active nts= ",active_nts_max,"/",size(obj%nts_elem_nod,1) allocate (obj%active_nts(active_nts_max)) j = 0 do i = 1, size(obj%nts_elem_nod, 1) if (check_active_nts(i) == 1) then j = j + 1 obj%active_nts(j) = i else cycle end if end do end subroutine ls_check_active_CM !============================================================= !check gn !------------------- subroutine check_gn(j, nts_elem_nod, check_active_nts, nod_coord) real(real64), allocatable ::x2s(:), x11(:), x12(:), avec(:), nvec(:), evec(:), yL(:), tvec_(:), nvec_(:) real(real64), intent(in) :: nod_coord(:, :) integer, intent(in) :: j, nts_elem_nod(:, :) real(real64) gz, l, gns, alpha, sel, delta integer i, beta integer:: check_active_nts(:) delta = 1.0e-5 !get beta to determine the case (cf. W.N. Liu et al., 2003) call get_beta_st_nts(j, nts_elem_nod, nod_coord, beta) allocate (x2s(2), x11(2), x12(2), yL(2), tvec_(3), nvec_(3), avec(3), nvec(3), evec(3)) if (beta == 1) then x2s(1:2) = nod_coord(nts_elem_nod(j, 1), 1:2) x11(1:2) = nod_coord(nts_elem_nod(j, 2), 1:2) x12(1:2) = nod_coord(nts_elem_nod(j, 3), 1:2) else x2s(1:2) = nod_coord(nts_elem_nod(j, 1), 1:2) x11(1:2) = nod_coord(nts_elem_nod(j, 4), 1:2) x12(1:2) = nod_coord(nts_elem_nod(j, 2), 1:2) end if ! 0 duvecの格納,ξ,ｇN等諸量の格納 !----------------------------------------------------------------------- !----------------------------------------------------------------------- nvec(3) = 0.0d0 avec(3) = 0.0d0 evec(1) = 0.0d0 evec(2) = 0.0d0 evec(3) = 1.0d0 nvec_(3) = 0.0d0 tvec_(3) = 0.0d0 !---------------------------------- l = dot_product(x12(1:2) - x11(1:2), x12(1:2) - x11(1:2)) l = dsqrt(l) if (l == 0.0d0) then print *, "l=0 at element No.", j stop end if avec(1:2) = (x12(1:2) - x11(1:2))/l nvec(:) = cross_product(evec, avec) gz = 1.0d0/l*dot_product(x2s(1:2) - x11(1:2), avec(1:2)) if (beta == 1) then !alpha=4.0d0*gz*(1.0d0-gz) !alpha=0.50d0*(1.0d0-cos(2.0d0*3.1415926535d0*gz) ) !alpha=exp( -delta*delta*(2.0d0*gz-1.0d0)**2.0d0 ) alpha = 1.0d0 !alpha=0.0d0 yL(:) = nod_coord(nts_elem_nod(j, 4), 1:2) + alpha* & (nod_coord(nts_elem_nod(j, 2), 1:2) - nod_coord(nts_elem_nod(j, 4), 1:2)) sel = dsqrt(dot_product(x12 - yL, x12 - yL)) if (sel == 0.0d0) then stop "error check_gn" end if tvec_(1:2) = (x12(:) - yL(:))/sel nvec_(:) = cross_product(evec, tvec_) nvec_(:) = nvec_(:)*dble(beta) gns = dot_product((x2s(:) - x11(:)), nvec_(1:2)) else !alpha=4.0d0*gz*(1.0d0-gz) !alpha=0.50d0*(1.0d0-cos(2.0d0*3.1415926535d0*gz) ) !alpha=exp( -delta*delta*(2.0d0*gz-1.0d0)**2.0d0 ) alpha = 1.0d0 !alpha=0.0d0 yL(:) = nod_coord(nts_elem_nod(j, 3), 1:2) + alpha* & (nod_coord(nts_elem_nod(j, 2), 1:2) - nod_coord(nts_elem_nod(j, 3), 1:2)) sel = dsqrt(dot_product(x11 - yL, x11 - yL)) if (sel == 0.0d0) then stop "error check_gn" end if tvec_(1:2) = (x11(:) - yL(:))/sel nvec_(:) = cross_product(evec, tvec_) nvec_(:) = nvec_(:)*dble(beta) gns = dot_product((x2s(:) - x12(:)), nvec_(1:2)) end if !gnsの計算と更新----------------------------------------------------- !--------------------------------------------------------------------- if (gns > 0.0d0) then check_active_nts(j) = 0 elseif (gns <= 0.0d0) then check_active_nts(j) = 1 else stop 'invalid No. on check_active_nts' end if deallocate (x2s, x11, x12, avec, nvec, evec) end subroutine check_gn !============================================================= !update friction !------------------- subroutine update_friction(j, nod_max, nod_coord, nts_elem_nod, active_nts, surface_nod, sur_nod_inf & , nts_amo, k_contact, uvec, duvec, fvec_contact, stick_slip, contact_mat_para, nts_mat, itr_contact) real(real64), allocatable ::x2s(:), dgt(:), tt_tr(:), gslt(:), & n_t(:), K_st(:, :), ns(:), n0s(:), ts(:), t0s(:), ngz0(:), & x11(:), x12(:), evec(:), gt(:), avec(:), & nvec(:), k_sl(:, :), n_tr(:), ts_st(:), ts_sl(:), fvec_e(:), & x1(:), x2(:), x3(:), x4(:), x5(:), x6(:), & x1_0(:), x2_0(:), x3_0(:), x4_0(:), x5_0(:), x6_0(:), c_nod_coord(:, :), & tvec_(:), nvec_(:), xe(:), xL(:), xs_1(:), xs_2(:), xs_0(:) real(real64), intent(inout) ::nts_amo(:, :), k_contact(:, :), fvec_contact(:) real(real64), intent(in) :: nod_coord(:, :), uvec(:), duvec(:), contact_mat_para(:, :) integer, intent(in) :: j, nod_max, nts_elem_nod(:, :), active_nts(:), nts_mat(:), itr_contact integer, intent(in) :: surface_nod(:), sur_nod_inf(:, :) integer, intent(inout) ::stick_slip(:) real(real64) c,phy,en,ct,f_tr,Lamda,gns,gz0,gz,l,pn,f_tr0,x,tts,tol_rmm,signm,beta_0,alpha,sel,gz0_,gz_,c_num,delta real(real64) l_s1, l_s2, ls_ave integer i, ii, k, ss, itr_rm, z, gzn, node_ID, beta, shift, old_slave, slave1, slave2 ! 0 duvecの格納,ξ,ｇN等諸量の格納 tol_rmm = 1.0e-12 delta = 1.0e-5 allocate (x2s(2), x11(2), x12(2), evec(3), & dgt(2), gt(2), gslt(2), tt_tr(2), avec(3), nvec(3), k_st(6, 6), k_sl(6, 6), & ns(6), n0s(6), ts(6), t0s(6), ngz0(6), ts_st(6), ts_sl(6), fvec_e(6)) allocate (x1(2), x2(2), x3(2), x4(2), x5(2), x6(2)) allocate (x1_0(2), x2_0(2), x3_0(2), x4_0(2), x5_0(2), x6_0(2)) allocate (c_nod_coord(size(nod_coord, 1), size(nod_coord, 2)), tvec_(3), nvec_(3)) allocate (xe(2), xL(2), xs_1(2), xs_2(2), xs_0(2)) tvec_(3) = 0.0d0 nvec_(3) = 0.0d0 !-----諸量の読み込み------ !tts = nts_amo(active_nts(j),12)!初期または全ステップ終了時のξ !gt(1:2)=nts_amo(active_nts(j),2:3) !gslt(1:2)=nts_amo(active_nts(j),4:5) !en=nts_amo(active_nts(j),6) ! ct = nts_amo(active_nts(j),7) !c = nts_amo(active_nts(j),8) ! gslt(1:2)=nts_amo(active_nts(j),4:5) tts = nts_amo(active_nts(j), 11) !previous step !tts = nts_amo(active_nts(j),12) !converged gz0 at last timestep !beta_0 = nts_amo(active_nts(j),2) !converged gz0 at last timestep !-------------------------- !-----材料パラメータの読み込み------ en = contact_mat_para(nts_mat(active_nts(j)), 2) ct = contact_mat_para(nts_mat(active_nts(j)), 1) c = contact_mat_para(nts_mat(active_nts(j)), 3) phy = contact_mat_para(nts_mat(active_nts(j)), 4) !-------------------------- do i = 1, size(nod_coord, 1) c_nod_coord(i, 1) = nod_coord(i, 1) + uvec(2*i - 1) + duvec(2*i - 1) c_nod_coord(i, 2) = nod_coord(i, 2) + uvec(2*i) + duvec(2*i) end do !以下、初期座標＋変位により、位置ベクトルを更新し、諸量を更新 !gz更新 x1(1:2) = uvec(2*nts_elem_nod(active_nts(j), 1) - 1: & 2*nts_elem_nod(active_nts(j), 1)) + & duvec(2*nts_elem_nod(active_nts(j), 1) - 1: & 2*nts_elem_nod(active_nts(j), 1)) + & nod_coord(nts_elem_nod(active_nts(j), 1), 1:2) x2(1:2) = uvec(2*nts_elem_nod(active_nts(j), 2) - 1: & 2*nts_elem_nod(active_nts(j), 2)) + & duvec(2*nts_elem_nod(active_nts(j), 2) - 1: & 2*nts_elem_nod(active_nts(j), 2)) + & nod_coord(nts_elem_nod(active_nts(j), 2), 1:2) x3(1:2) = uvec(2*nts_elem_nod(active_nts(j), 3) - 1: & 2*nts_elem_nod(active_nts(j), 3)) + & duvec(2*nts_elem_nod(active_nts(j), 3) - 1: & 2*nts_elem_nod(active_nts(j), 3)) + & nod_coord(nts_elem_nod(active_nts(j), 3), 1:2) x4(1:2) = uvec(2*nts_elem_nod(active_nts(j), 4) - 1: & 2*nts_elem_nod(active_nts(j), 4)) + & duvec(2*nts_elem_nod(active_nts(j), 4) - 1: & 2*nts_elem_nod(active_nts(j), 4)) + & nod_coord(nts_elem_nod(active_nts(j), 4), 1:2) x5(1:2) = uvec(2*nts_elem_nod(active_nts(j), 5) - 1: & 2*nts_elem_nod(active_nts(j), 5)) + & duvec(2*nts_elem_nod(active_nts(j), 5) - 1: & 2*nts_elem_nod(active_nts(j), 5)) + & nod_coord(nts_elem_nod(active_nts(j), 5), 1:2) x6(1:2) = uvec(2*nts_elem_nod(active_nts(j), 6) - 1: & 2*nts_elem_nod(active_nts(j), 6)) + & duvec(2*nts_elem_nod(active_nts(j), 6) - 1: & 2*nts_elem_nod(active_nts(j), 6)) + & nod_coord(nts_elem_nod(active_nts(j), 6), 1:2) x1_0(1:2) = uvec(2*nts_elem_nod(active_nts(j), 1) - 1: & 2*nts_elem_nod(active_nts(j), 1)) + & nod_coord(nts_elem_nod(active_nts(j), 1), 1:2) x2_0(1:2) = uvec(2*nts_elem_nod(active_nts(j), 2) - 1: & 2*nts_elem_nod(active_nts(j), 2)) + & nod_coord(nts_elem_nod(active_nts(j), 2), 1:2) x3_0(1:2) = uvec(2*nts_elem_nod(active_nts(j), 3) - 1: & 2*nts_elem_nod(active_nts(j), 3)) + & nod_coord(nts_elem_nod(active_nts(j), 3), 1:2) x4_0(1:2) = uvec(2*nts_elem_nod(active_nts(j), 4) - 1: & 2*nts_elem_nod(active_nts(j), 4)) + & nod_coord(nts_elem_nod(active_nts(j), 4), 1:2) x5_0(1:2) = uvec(2*nts_elem_nod(active_nts(j), 5) - 1: & 2*nts_elem_nod(active_nts(j), 5)) + & nod_coord(nts_elem_nod(active_nts(j), 5), 1:2) x6_0(1:2) = uvec(2*nts_elem_nod(active_nts(j), 6) - 1: & 2*nts_elem_nod(active_nts(j), 6)) + & nod_coord(nts_elem_nod(active_nts(j), 6), 1:2) node_ID = active_nts(j) call get_beta_st_nts(node_ID, nts_elem_nod, c_nod_coord, beta) !============================ !compute gzi_0 if (beta == 1) then x2s(1:2) = x1_0(:) x11(1:2) = x2_0(:) x12(1:2) = x3_0(:) else x2s(1:2) = x1_0(:) x11(1:2) = x4_0(:) x12(1:2) = x2_0(:) end if nvec(3) = 0.0d0 avec(3) = 0.0d0 evec(1) = 0.0d0 evec(2) = 0.0d0 evec(3) = 1.0d0 !---------------------------------- l = dot_product(x12(1:2) - x11(1:2), & x12(1:2) - x11(1:2)) l = dsqrt(l) if (l == 0.0d0) then print *, "l=0 at element No.", j stop end if if (ct == 0.0d0) then print *, "ct=0 at element No.", j stop end if avec(1:2) = (x12(1:2) - x11(1:2))/l nvec(:) = cross_product(evec, avec) nvec(:) = nvec(:)/sqrt(dot_product(nvec, nvec)) gz0 = 1.0d0/l*dot_product(x2s(1:2) - x11(1:2), avec(1:2)) !alpha=0.50d0*(1.0d0-cos(2.0d0*3.1415926535d0*gz0) ) !alpha=exp( -delta*delta*(2.0d0*gz0-1.0d0)**2.0d0 ) !alpha=1.0d0 !alpha=0.0d0 if (beta == 1) then xe(1:2) = x3_0(1:2) xL(1:2) = x4_0(1:2) + alpha*(x2_0(1:2) - x4_0(1:2)) tvec_(1:2) = (xe(1:2) - xL(1:2))/dsqrt(dot_product(xe - xL, xe - xL)) nvec_(1:3) = cross_product(evec, tvec_) nvec_(1:2) = nvec_(1:2)*dble(beta) gns = dot_product(x1_0(1:2) - x2_0(1:2), nvec_(1:2)) else xe(1:2) = x4_0(1:2) xL(1:2) = x3_0(1:2) + alpha*(x2_0(1:2) - x3_0(1:2)) tvec_(1:2) = (xe(1:2) - xL(1:2))/dsqrt(dot_product(xe - xL, xe - xL)) nvec_(1:3) = cross_product(evec, tvec_) nvec_(1:2) = nvec_(1:2)*dble(beta) gns = dot_product(x1_0(1:2) - x2_0(1:2), nvec_(1:2)) end if sel = dsqrt(dot_product(xL(1:2) - xe(1:2), xL(1:2) - xe(1:2))) gz0_ = 1.0d0/sel*dot_product(x1_0(:) - x2_0(:), dble(beta)*tvec_(1:2)) !===================== !compute gzi if (beta == 1) then x2s(1:2) = x1(:) x11(1:2) = x2(:) x12(1:2) = x3(:) else x2s(1:2) = x1(:) x11(1:2) = x4(:) x12(1:2) = x2(:) end if nvec(3) = 0.0d0 avec(3) = 0.0d0 evec(1) = 0.0d0 evec(2) = 0.0d0 evec(3) = 1.0d0 !---------------------------------- l = dot_product(x12(1:2) - x11(1:2), & x12(1:2) - x11(1:2)) l = dsqrt(l) if (l == 0.0d0) then print *, "l=0 at element No.", j stop end if if (ct == 0.0d0) then print *, "ct=0 at element No.", j stop end if avec(1:2) = (x12(1:2) - x11(1:2))/l nvec(:) = cross_product(evec, avec) nvec(:) = nvec(:)/dsqrt(dot_product(nvec, nvec)) gz = 1.0d0/l*dot_product(x2s(1:2) - x11(1:2), avec(1:2)) !alpha=4.0d0*gz*(1.0d0-gz) !alpha=0.50d0*(1.0d0-cos(2.0d0*3.1415926535d0*gz) ) !alpha=exp( -delta*delta*(2.0d0*gz-1.0d0)**2.0d0 ) alpha = 1.0d0 !alpha=0.0d0 !gz0=gz-tts/ct/l !gnsの計算と更新----------------------------------------------------- if (beta == 1) then xe(1:2) = x3(1:2) xL(1:2) = x4(1:2) + alpha*(x2(1:2) - x4(1:2)) tvec_(1:2) = (xe(1:2) - xL(1:2))/dsqrt(dot_product(xe - xL, xe - xL)) nvec_(1:3) = cross_product(evec, tvec_) nvec_(1:2) = nvec_(1:2)*dble(beta) gns = dot_product(x1(1:2) - x2(1:2), nvec_(1:2)) else xe(1:2) = x4(1:2) xL(1:2) = x3(1:2) + alpha*(x2(1:2) - x3(1:2)) tvec_(1:2) = (xe(1:2) - xL(1:2))/dsqrt(dot_product(xe - xL, xe - xL)) nvec_(1:3) = cross_product(evec, tvec_) nvec_(1:2) = nvec_(1:2)*dble(beta) gns = dot_product(x1(1:2) - x2(1:2), nvec_(1:2)) end if !gns = dot_product((x2s(:)-(1.0d0-gz)*x11(:)-gz*x12(:)),nvec(1:2)) sel = dsqrt(dot_product(xL(1:2) - xe(1:2), xL(1:2) - xe(1:2))) gz_ = 1.0d0/sel*dot_product(x1(:) - x2(:), dble(beta)*tvec_(1:2)) pn = en*gns !--------------------------------------------------------------------- !trial tTs(frictional force) gz0_ = gz0_ - tts/ct/sel !gzi_0の補正(現時点でのfrictional stress を考慮) tts = ct*(gz_ - gz0_)*sel ! compute trial tts !------降伏関数の計算------------------------ !compute numerical c (kPa) shift = 1 old_slave = nts_elem_nod(active_nts(j), 4) call get_next_segment(surface_nod, sur_nod_inf, shift, old_slave, slave1, slave2) shift = -1 old_slave = nts_elem_nod(active_nts(j), 4) call get_next_segment(surface_nod, sur_nod_inf, shift, old_slave, slave2, slave1) xs_0(1:2) = uvec(2*old_slave - 1:2*old_slave) + & duvec(2*old_slave - 1:2*old_slave) + & nod_coord(old_slave, 1:2) xs_1(1:2) = uvec(2*slave1 - 1:2*slave1) + & duvec(2*slave1 - 1:2*slave1) + & nod_coord(slave1, 1:2) xs_2(1:2) = uvec(2*slave2 - 1:2*slave2) + & duvec(2*slave2 - 1:2*slave2) + & nod_coord(slave2, 1:2) l_s1 = dsqrt(dot_product(xs_0 - xs_1, xs_0 - xs_1)) l_s2 = dsqrt(dot_product(xs_0 - xs_2, xs_0 - xs_2)) ls_ave = 0.50d0*(l_s1 + l_s2) c_num = c*ls_ave/l ! print *,"tts=",tts,pn,sel,l,c,c_num,alpha f_tr0 = abs(tts) - ((tan(phy))*abs(pn) + c_num) !------------------------------ itr_rm = 1 !----------------------降伏関数の値による場合わけ-------------------- if (f_tr0 <= 0.0d0) then !print *, "stick" stick_slip(active_nts(j)) = 0 elseif (f_tr0 > 0.0d0) then !--------------------plastic------------------------------! !ss=1 !allocate(n_tr(2)) !do !---繰り返し回数計測用変数の更新------- ! itr_rm=itr_rm+1 !------デバッグ用--itr_rm=5で停止---- ! if(itr_rm==5)then ! stop 'itr_rm=5' ! endif !write(1000,*)"slip" !print *, "slip" !------Return Mapping Calculation ----------------------------- !------降伏曲面の法線ベクトルnの計算---------------------- if (tts >= 0.0d0) then signm = 1.0d0 elseif (tts < 0.0d0) then signm = -1.0d0 else stop "invalid tTs" end if stick_slip(active_nts(j)) = 1 tts = ((tan(phy))*abs(pn) + c_num)*signm !gz0=gz-tts/ct/l ! n_tr(:)=1.0d0/dsqrt((dot_product(tt_tr,tt_tr)))*tt_tr(:) !塑性指数Lamda,tt_tr,gsltの更新(Computational contact mechanics !Lamda=1.0d0/ct*(dsqrt(dot_product(tt_tr,tt_tr))& ! -(abs(pn)*tan(phy)+c) ) !pnは負、cは正 !gslt(:)=gslt(:)+Lamda*n_tr(:) !tt_tr(:) =ct*( gt(:)-gslt(:) ) !------debug !write(1000,*)'RM itr=',ss !------- !f_tr = dsqrt(dot_product(tt_tr,tt_tr))-((tan(phy))*abs(pn)+c) !--------------------------------------------------------------- !収束判定 ! if( abs(f_tr)< tol_rmm*abs(f_tr0))then ! tts=ct*dot_product((gt-gslt),avec) ! deallocate(n_tr) ! stop ' stop return mapping' ! exit ! else ! ss=ss+1 ! cycle ! endif !enddo else stop 'something wrong about f_tr0' end if !諸量の更新 !gz0=gz-tts/ct/l ! nts_amo(active_nts(j),2:3) =gt(1:2) ! nts_amo(active_nts(j),4:5)=gslt(1:2) nts_amo(active_nts(j), 12) = tts nts_amo(active_nts(j), 10) = signm deallocate (x2s, x11, x12, evec, & gt, gslt, tt_tr, avec, nvec, k_st, k_sl, & ns, n0s, ts, t0s, ngz0, ts_sl, fvec_e) end subroutine update_friction !============================================================== subroutine update_res_grad_c_i(j, nod_max, old_nod_coord, nts_elem_nod, active_nts & , nts_amo, k_contact, uvec, duvec, fvec_contact, stick_slip, contact_mat_para, nts_mat) real(real64), allocatable ::x2s(:), x11(:), x12(:), evec(:), avec(:), nvec(:) & , k_st(:, :), ns(:), n0s(:), ts(:), ts_st(:), t0s(:), ngz0(:), fvec_e(:), nod_coord(:, :), & nvec_(:), tvec_(:), x1(:), x2(:), x3(:), x4(:), x5(:), x6(:), tvec(:), mvec(:), yi(:), Dns(:, :), & ym(:), ys(:), nvec__(:), ovec(:), mvec_(:), mvec__(:), Dns_1(:), Dns_2(:), Dns_3(:), domega_mat(:), & Dns_1_1(:), Ivec(:), dtmat(:, :), dmmat(:, :), dnmat__(:, :), dgzivec(:), dalpha(:), dHvec(:), nt(:), & Dnt(:, :), dT0vec(:), dtmat_(:, :), dselvec(:), dmmat_(:, :), dgzi_hat_vec(:), dganma_hat_vec(:), & dganmavec_(:), dnmat_(:, :), dgzivec_(:), dsjkvec(:), dlamdavec_(:), Svec(:), Ft(:), yL(:), tvec__(:), & ye(:), yj(:), yk(:), c_nod_coord(:, :) real(real64), intent(inout)::nts_amo(:, :), k_contact(:, :), fvec_contact(:) real(real64), intent(in) :: old_nod_coord(:, :), uvec(:), contact_mat_para(:, :), duvec(:) integer, intent(in) :: j, nod_max, nts_elem_nod(:, :), active_nts(:), nts_mat(:) integer, intent(inout) :: stick_slip(:) real(real64) c, phy, en, ct, gns, gz, l, pn, tts, gt, gz0, alpha, omega, gns_, gz_, sjk, delta real(real64) gzi_hat, delta_hat, ganma_, kappa, S0, ganma, gzi_, ganma_hat, lamda_, T0, dfdtn, HH, sel integer i, ii, k, beta, i_1, ii_1, node_ID ! 0 duvecの格納,ξ,ｇN等諸量の格納 allocate (x2s(2), x11(2), x12(2), evec(3), avec(3), nvec(3), k_st(8, 8), & ns(8), n0s(8), ts(8), t0s(8), ngz0(8), ts_st(8), fvec_e(8), tvec(2), mvec(2)) allocate (nvec_(3), tvec_(3), x1(2), x2(2), x3(2), x4(2), x5(2), x6(2), yi(2)) allocate (ym(2), ys(2), nvec__(2), ovec(2), mvec_(2), mvec__(2), Dns(8, 8), Dns_1_1(8)) allocate (Dns_1(8), domega_mat(8), Ivec(2)) allocate (dtmat(2, 8), dmmat(2, 8), dnmat__(2, 8), dgzivec(8), dalpha(8), dHvec(8)) allocate (nod_coord(size(old_nod_coord, 1), size(old_nod_coord, 2))) allocate (nt(8), Dnt(8, 8), dT0vec(8), dtmat_(2, 8), dselvec(8), dmmat_(2, 8), dgzi_hat_vec(8)) allocate (dganma_hat_vec(8), dganmavec_(8), dnmat_(2, 8), dgzivec_(8), dsjkvec(8), dlamdavec_(8)) allocate (Svec(8), Ft(8), yL(1:2), tvec__(1:2)) allocate (ye(2), yj(2), yk(2), c_nod_coord(size(nod_coord, 1), size(nod_coord, 2))) do i = 1, size(nod_coord, 1) nod_coord(i, 1) = old_nod_coord(i, 1) nod_coord(i, 2) = old_nod_coord(i, 2) end do do i = 1, size(nod_coord, 1) c_nod_coord(i, 1) = nod_coord(i, 1) + uvec(2*i - 1) c_nod_coord(i, 2) = nod_coord(i, 2) + uvec(2*i) end do nvec_(3) = 0.0d0 tvec_(3) = 0.0d0 delta = 1.0e-5 !-----材料パラメータの読み込み------ en = contact_mat_para(nts_mat(active_nts(j)), 2) ct = contact_mat_para(nts_mat(active_nts(j)), 1) c = contact_mat_para(nts_mat(active_nts(j)), 3) phy = contact_mat_para(nts_mat(active_nts(j)), 4) !-------------------------------- tts = nts_amo(active_nts(j), 12) !dfdtn=nts_amo(active_nts(j),10) if (tts >= 0.0d0) then dfdtn = 1.0d0 elseif (tts < 0.0d0) then dfdtn = -1.0d0 else stop "invalid tTs" end if !以下、初期座標＋変位により、位置ベクトルを更新し、諸量を更新 !gz更新 x1(1:2) = uvec(2*nts_elem_nod(active_nts(j), 1) - 1: & 2*nts_elem_nod(active_nts(j), 1)) + & duvec(2*nts_elem_nod(active_nts(j), 1) - 1: & 2*nts_elem_nod(active_nts(j), 1)) + & nod_coord(nts_elem_nod(active_nts(j), 1), 1:2) x2(1:2) = uvec(2*nts_elem_nod(active_nts(j), 2) - 1: & 2*nts_elem_nod(active_nts(j), 2)) + & duvec(2*nts_elem_nod(active_nts(j), 2) - 1: & 2*nts_elem_nod(active_nts(j), 2)) + & nod_coord(nts_elem_nod(active_nts(j), 2), 1:2) x3(1:2) = uvec(2*nts_elem_nod(active_nts(j), 3) - 1: & 2*nts_elem_nod(active_nts(j), 3)) + & duvec(2*nts_elem_nod(active_nts(j), 3) - 1: & 2*nts_elem_nod(active_nts(j), 3)) + & nod_coord(nts_elem_nod(active_nts(j), 3), 1:2) x4(1:2) = uvec(2*nts_elem_nod(active_nts(j), 4) - 1: & 2*nts_elem_nod(active_nts(j), 4)) + & duvec(2*nts_elem_nod(active_nts(j), 4) - 1: & 2*nts_elem_nod(active_nts(j), 4)) + & nod_coord(nts_elem_nod(active_nts(j), 4), 1:2) x5(1:2) = uvec(2*nts_elem_nod(active_nts(j), 5) - 1: & 2*nts_elem_nod(active_nts(j), 5)) + & duvec(2*nts_elem_nod(active_nts(j), 5) - 1: & 2*nts_elem_nod(active_nts(j), 5)) + & nod_coord(nts_elem_nod(active_nts(j), 5), 1:2) x6(1:2) = uvec(2*nts_elem_nod(active_nts(j), 6) - 1: & 2*nts_elem_nod(active_nts(j), 6)) + & duvec(2*nts_elem_nod(active_nts(j), 6) - 1: & 2*nts_elem_nod(active_nts(j), 6)) + & nod_coord(nts_elem_nod(active_nts(j), 6), 1:2) node_ID = active_nts(j) call get_beta_st_nts(node_ID, nts_elem_nod, c_nod_coord, beta) if (beta == 1) then x2s(1:2) = x1(:) x11(1:2) = x2(:) x12(1:2) = x3(:) yi(1:2) = x4(:) yj(1:2) = x2(1:2) yk(1:2) = x3(1:2) ys(1:2) = x1(1:2) ym(1:2) = x2(1:2) ye(1:2) = x3(1:2) else x2s(1:2) = x1(:) x11(1:2) = x4(:) x12(1:2) = x2(:) yi(1:2) = x3(:) yj(1:2) = x4(1:2) yk(1:2) = x2(1:2) ys(1:2) = x1(1:2) ym(1:2) = x2(1:2) ye(1:2) = x4(1:2) end if !----------------------------------------------------------------------- nvec(3) = 0.0d0 avec(3) = 0.0d0 evec(1) = 0.0d0 evec(2) = 0.0d0 evec(3) = 1.0d0 Ivec(1) = 1.0d0 Ivec(2) = 1.0d0 nvec_(3) = 0.0d0 tvec_(3) = 0.0d0 !---------------------------------- l = dot_product(yj(1:2) - yk(1:2), yj(1:2) - yk(1:2)) l = dsqrt(l) sjk = l if (l == 0.0d0) then print *, "l=0 at element No.", node_ID stop end if avec(1:2) = (yk(1:2) - yj(1:2))/l nvec(:) = cross_product(evec, avec) gz = 1.0d0/l*dot_product(ys(1:2) - yj(1:2), avec(1:2)) gns = dot_product((ys(:) - ym(:)), nvec(1:2)) ! alpha=4.0d0*gz*(1.0d0-gz) !alpha=0.50d0*(1.0d0-cos(2.0d0*3.1415926535d0*gz) ) !alpha=exp( -delta*delta*(2.0d0*gz-1.0d0)**2.0d0 ) alpha = 1.0d0 !alpha=0.0d0 yL(:) = yi(:) + alpha*(ym(:) - yi(:)) sel = dsqrt(dot_product(ye - yL, ye - yL)) gz0 = gz - tts/ct/sel if (sel == 0.0d0) then stop "error check_gn" end if tvec_(1:2) = (ye(:) - yL(:))/sel nvec_(:) = cross_product(evec, tvec_) tvec(1:2) = avec(1:2) mvec(:) = gz*tvec(:) - gns/sjk*nvec(:) nvec__(1:2) = nvec_(1:2)*dble(beta) !gnsの計算と更新----------------------------------------------------- gns_ = dot_product((ys(:) - ym(:)), nvec__(1:2)) gz_ = 1.0d0/sel*dot_product(ys - ym, tvec_(1:2)) !get f_contact(normal),K_contact(normal) !compute common variables gzi_ = 1.0d0/sel*dot_product(ys - ym, tvec_(1:2)) ganma_hat = 1.0d0/sel*dot_product(ym - yi, nvec_(1:2)) !HH=4.0d0*(1.0d0-2.0d0*gz) !HH=-3.1415926535d0*cos(2.0d0*3.1415926535d0*gz) HH = alpha*(delta*delta)*(4.0d0 - 8.0d0*gz) HH = 0.0d0 omega = 1.0d0/sjk*HH*gz_*dot_product(ym - yi, nvec__(1:2)) gzi_hat = 1.0d0/sel*dot_product(ym - yi, tvec_(1:2)) delta_hat = dot_product(ym - yi, nvec_(1:2)) ganma_ = 1.0d0/sel*dot_product(ys - ym, nvec_(1:2)) ganma = gns/sjk ovec(1:2) = gz*nvec(1:2) + ganma*tvec(1:2) mvec_(1:2) = gzi_*tvec_(1:2) - ganma_*nvec_(1:2) mvec__(1:2) = gzi_*tvec_(1:2) - ganma_*nvec_(1:2) !kappa=-8.0d0 !kappa=-2.0d0*3.1415926535d0*3.1415926535d0*cos(2.0d0*3.1415926535d0*gz) kappa = alpha*(delta)*(delta)*(delta)*(delta)*(4.0d0 - 8.0d0*gz) - 8.0d0*alpha*(delta*delta) kappa = 0.0d0 !kappa=8.0d0 tvec__(1:2) = dble(beta)*tvec_(1:2) S0 = delta_hat*dble(beta)/sjk*(kappa*gzi_ + HH*HH*(2.0d0*gzi_*gzi_hat - ganma_*ganma_hat)) if (beta == 1) then !normal part >>> ns(1:2) = omega*(tvec(1:2)) ns(3:4) = omega*(mvec(1:2) - tvec(1:2))!!+- ns(5:6) = omega*(-mvec(1:2)) ns(7:8) = 0.0d0 ns(1:2) = ns(1:2) + nvec__(1:2) ns(3:4) = ns(3:4) - (1.0d0 - alpha*gz_)*nvec__(1:2) ns(5:6) = ns(5:6) - gz_*nvec__(1:2) ns(7:8) = ns(7:8) + (1.0d0 - alpha)*gz_*nvec__(1:2) Dns_1_1(1:2) = tvec(1:2) Dns_1_1(3:4) = mvec(1:2) - tvec(1:2) Dns_1_1(5:6) = -mvec(:) Dns_1_1(7:8) = 0.0d0 domega_mat(1:2) = 1.0d0/sjk*S0*tvec(:) domega_mat(3:4) = 1.0d0/sjk*(S0*(mvec(1:2) - tvec(1:2)) + omega*tvec(1:2))!!+- domega_mat(5:6) = 1.0d0/sjk*(-S0*mvec(1:2) - omega*tvec(1:2)) domega_mat(7:8) = 0.0d0 domega_mat(1:2) = domega_mat(1:2) + HH/sjk*ganma_hat*tvec__(1:2) domega_mat(3:4) = domega_mat(3:4) + HH/sjk*(ganma_hat*(alpha*mvec__(1:2) - tvec__(1:2)) + gzi_*(1.0d0 + alpha*gzi_hat)*nvec__(1:2)) domega_mat(5:6) = domega_mat(5:6) + HH/sjk*(-ganma_hat*mvec__(1:2) - gzi_*ganma_hat*nvec__(1:2)) domega_mat(7:8)=domega_mat(7:8)+HH/sjk*(gzi_*(-1.0d0+(1.0d0-alpha )*gzi_hat)*nvec__(1:2)+ganma_hat*(1.0d0-alpha)*mvec__(1:2) ) dtmat(1:2, 1:2) = 0.0d0 dtmat(1:2, 3:4) = -diadic(nvec(1:2), nvec(1:2))/sjk!!+- dtmat(1:2, 5:6) = diadic(nvec(1:2), nvec(1:2))/sjk dtmat(1:2, 7:8) = 0.0d0 dmmat(1:2, 1:2) = (diadic(tvec(1:2), tvec(1:2)) - diadic(nvec(1:2), nvec(1:2)))/sjk!!+- dmmat(1:2, 3:4) = (-diadic(tvec(1:2), tvec(1:2)) + diadic(nvec(1:2), nvec(1:2)) + diadic(tvec(1:2), mvec(1:2)) & - diadic(nvec(1:2), ovec(1:2)) - diadic(ovec(1:2), nvec(1:2)))/sjk dmmat(1:2, 5:6) = (-diadic(tvec(1:2), mvec(1:2)) & + diadic(nvec(1:2), ovec(1:2)) + diadic(ovec(1:2), nvec(1:2)))/sjk dmmat(1:2, 7:8) = 0.0d0 dnmat__(1:2, 1:2) = HH*ganma_hat/sjk*diadic(tvec__(1:2), tvec(1:2)) dnmat__(1:2, 3:4) = HH*ganma_hat/sjk*diadic(tvec__(1:2), mvec(1:2) - tvec(1:2))!!+- dnmat__(1:2, 5:6) = -HH*ganma_hat/sjk*diadic(tvec__(1:2), mvec(1:2)) dnmat__(1:2, 7:8) = 0.0d0 dnmat__(1:2, 1:2) = dnmat__(1:2, 1:2) + 0.0d0 dnmat__(1:2, 3:4) = dnmat__(1:2, 3:4) + 1.0d0/sel*alpha*diadic(tvec__(1:2), nvec_(1:2)) dnmat__(1:2, 5:6) = dnmat__(1:2, 5:6) - 1.0d0/sel*diadic(tvec__(1:2), nvec_(1:2)) dnmat__(1:2, 7:8) = dnmat__(1:2, 7:8) + 1.0d0/sel*(1.0d0 - alpha)*diadic(tvec__(1:2), nvec_(1:2)) dgzivec(1:2) = 1.0d0/sjk*tvec(1:2) dgzivec(3:4) = 1.0d0/sjk*(mvec(1:2) - tvec(1:2))!!+- dgzivec(5:6) = -1.0d0/sjk*mvec(1:2) dgzivec(7:8) = 0.0d0 dalpha(1:2) = HH/sjk*tvec(1:2) dalpha(3:4) = HH/sjk*(mvec(1:2) - tvec(1:2))!!+- dalpha(5:6) = -HH/sjk*mvec(1:2) dalpha(7:8) = 0.0d0 dHvec(1:2) = kappa/sjk*tvec(1:2) dHvec(3:4) = kappa/sjk*(mvec(1:2) - tvec(1:2))!!+- dHvec(5:6) = -kappa/sjk*mvec(1:2) dHvec(7:8) = 0.0d0 dgzivec_(1:2) = HH*(gzi_*gzi_hat - ganma_*ganma_hat)/sjk*tvec(1:2) dgzivec_(3:4) = HH*(gzi_*gzi_hat - ganma_*ganma_hat)/sjk*(mvec(1:2) - tvec(1:2))!!+- dgzivec_(5:6) = -HH*(gzi_*gzi_hat - ganma_*ganma_hat)/sjk*mvec(1:2) dgzivec_(7:8) = 0.0d0 dgzivec_(1:2) = dgzivec_(1:2) + 1.0d0/sel*tvec_(1:2) dgzivec_(3:4) = dgzivec_(3:4) + 1.0d0/sel*(alpha*mvec_(1:2) - tvec_(1:2)) dgzivec_(5:6) = dgzivec_(5:6) + 1.0d0/sel*(-1.0d0)*mvec_(1:2) dgzivec_(7:8) = dgzivec_(7:8) + 1.0d0/sel*(1.0d0 - alpha)*mvec_(1:2) Dns(1:8, 1:8) = diadic(Dns_1_1, domega_mat) Dns(1:2, 1:8) = Dns(1:2, 1:8) + omega*dtmat(1:2, 1:8) Dns(3:4, 1:8) = Dns(3:4, 1:8) + omega*(dmmat(1:2, 1:8) - dtmat(1:2, 1:8))!!+- Dns(5:6, 1:8) = Dns(5:6, 1:8) + omega*(-dmmat(1:2, 1:8)) Dns(7:8, 1:8) = Dns(7:8, 1:8) + 0.0d0 Dns(1:2, 1:8) = Dns(1:2, 1:8) + dnmat__(1:2, 1:8) Dns(3:4, 1:8) = Dns(3:4, 1:8) + diadic(nvec__(1:2), alpha*dgzivec_(1:8) + gzi_*dalpha(1:8)) - (1.0d0 - alpha*gzi_)*dnmat__(1:2, 1:8) Dns(5:6, 1:8) = Dns(5:6, 1:8) - diadic(nvec__(1:2), dgzivec_(1:8)) - gzi_*dnmat__(1:2, 1:8) Dns(7:8,1:8)=Dns(7:8,1:8)+diadic(nvec__(1:2),(1.0d0-alpha)*dgzivec_(1:8)-gzi_*dalpha(1:8) )+(1.0d0-alpha)*gzi_*dnmat__(1:2,1:8) fvec_e(1:8) = en*gns_*ns(1:8) K_st(1:8, 1:8) = en*(diadic(ns, ns) + gns_*Dns(1:8, 1:8)) ! note >> du(1),du(2),du(3),du(4) !tangential part>>> dnmat_(1:2, 1:2) = HH*ganma_hat/sjk*diadic(tvec_(1:2), tvec(1:2)) dnmat_(1:2, 3:4) = HH*ganma_hat/sjk*diadic(tvec_(1:2), mvec(1:2) - tvec(1:2))!!+- dnmat_(1:2, 5:6) = -HH*ganma_hat/sjk*diadic(tvec_(1:2), mvec(1:2)) dnmat_(1:2, 7:8) = 0.0d0 dnmat_(1:2, 1:2) = dnmat__(1:2, 1:2) + 0.0d0 dnmat_(1:2, 3:4) = dnmat__(1:2, 3:4) + 1.0d0/sel*alpha*diadic(tvec_(1:2), nvec_(1:2)) dnmat_(1:2, 5:6) = dnmat__(1:2, 5:6) - 1.0d0/sel*diadic(tvec_(1:2), nvec_(1:2)) dnmat_(1:2, 7:8) = dnmat__(1:2, 7:8) + 1.0d0/sel*(1.0d0 - alpha)*diadic(tvec_(1:2), nvec_(1:2)) dganmavec_(1:2) = HH*(gzi_*ganma_hat + gzi_hat*ganma_)/sjk*(tvec(1:2)) dganmavec_(3:4) = HH*(gzi_*ganma_hat + gzi_hat*ganma_)/sjk*(mvec(1:2) - tvec(1:2))!!+- dganmavec_(5:6) = HH*(gzi_*ganma_hat + gzi_hat*ganma_)/sjk*(-mvec(1:2)) dganmavec_(7:8) = 0.0d0 dganmavec_(1:2) = dganmavec_(1:2) + 1.0d0/sel*(nvec_(1:2)) dganmavec_(3:4) = dganmavec_(3:4) + 1.0d0/sel*(alpha*(gzi_*nvec_(1:2) + ganma_*tvec_(1:2)) - nvec_(1:2)) dganmavec_(5:6) = dganmavec_(5:6) + 1.0d0/sel*(-(gzi_*nvec_(1:2) + ganma_*tvec_(1:2))) dganmavec_(7:8) = dganmavec_(7:8) + 1.0d0/sel*((1.0d0 - alpha)*(gzi_*nvec_(1:2) + ganma_*tvec_(1:2))) dganma_hat_vec(1:2) = 2.0d0*HH*gzi_hat*ganma_hat/sjk*(tvec(1:2)) dganma_hat_vec(3:4) = 2.0d0*HH*gzi_hat*ganma_hat/sjk*(mvec(1:2) - tvec(1:2))!!+- dganma_hat_vec(5:6) = 2.0d0*HH*gzi_hat*ganma_hat/sjk*(-mvec(1:2)) dganma_hat_vec(7:8) = 0.0d0 dganma_hat_vec(1:2) = dganma_hat_vec(1:2) + 0.0d0 dganma_hat_vec(3:4) = dganma_hat_vec(3:4) + 1.0d0/sel*(alpha*(gzi_hat*nvec_(1:2) + ganma_hat*tvec_(1:2)) + nvec_(1:2)) dganma_hat_vec(5:6) = dganma_hat_vec(5:6) + 1.0d0/sel*(-(gzi_hat*nvec_(1:2) + ganma_hat*tvec_(1:2))) dganma_hat_vec(7:8) = dganma_hat_vec(7:8) + 1.0d0/sel*((1.0d0 - alpha)*(gzi_hat*nvec_(1:2) + ganma_hat*tvec_(1:2)) - nvec_(1:2)) dgzi_hat_vec(1:2) = HH*(gzi_hat*gzi_hat - ganma_hat*ganma_hat)/sjk*(tvec(1:2)) dgzi_hat_vec(3:4) = HH*(gzi_hat*gzi_hat - ganma_hat*ganma_hat)/sjk*(mvec(1:2) - tvec(1:2))!!+- dgzi_hat_vec(5:6) = HH*(gzi_hat*gzi_hat - ganma_hat*ganma_hat)/sjk*(-mvec(1:2)) dgzi_hat_vec(7:8) = 0.0d0 dgzi_hat_vec(1:2) = dgzi_hat_vec(1:2) + 0.0d0 dgzi_hat_vec(3:4) = dgzi_hat_vec(3:4) + 1.0d0/sel*((gzi_hat*tvec_(1:2) - ganma_hat*nvec_(1:2))*alpha + tvec_(1:2)) dgzi_hat_vec(5:6) = dgzi_hat_vec(5:6) + 1.0d0/sel*(-(gzi_hat*tvec_(1:2) - ganma_hat*nvec_(1:2))) dgzi_hat_vec(7:8) = dgzi_hat_vec(7:8) + 1.0d0/sel*((1.0d0 - alpha)*(gzi_hat*tvec_(1:2) - ganma_hat*nvec_(1:2)) - tvec_(1:2)) dtmat_(1:2, 1:2) = HH*ganma_hat/sjk*(-1.0d0)*(diadic(nvec_(1:2), tvec(1:2))) dtmat_(1:2, 3:4) = HH*ganma_hat/sjk*(-1.0d0)*(diadic(nvec_(1:2), mvec(1:2) - tvec(1:2)))!!+- dtmat_(1:2, 5:6) = HH*ganma_hat/sjk*(1.0d0)*(diadic(nvec_(1:2), mvec(1:2))) dtmat_(1:2, 7:8) = 0.0d0 dtmat_(1:2, 1:2) = dtmat_(1:2, 1:2) + 0.0d0 dtmat_(1:2, 3:4) = dtmat_(1:2, 3:4) + 1.0d0/sel*(-1.0d0)*alpha*diadic(nvec_(1:2), nvec_(1:2)) dtmat_(1:2, 5:6) = dtmat_(1:2, 5:6) + 1.0d0/sel*(1.0d0)*diadic(nvec_(1:2), nvec_(1:2)) dtmat_(1:2, 7:8) = dtmat_(1:2, 7:8) + 1.0d0/sel*(-1.0d0 + alpha)*diadic(nvec_(1:2), nvec_(1:2)) dmmat_(1:2, 1:8) = diadic(tvec_(1:2), dgzivec_(1:8)) dmmat_(1:2, 1:8) = dmmat_(1:2, 1:8) + gzi_*dtmat_(1:2, 1:8) dmmat_(1:2, 1:8) = dmmat_(1:2, 1:8) + diadic(nvec_(1:2), dganmavec_(1:8)) dmmat_(1:2, 1:8) = dmmat_(1:2, 1:8) + ganma_*dnmat_(1:2, 1:8) dselvec(1:2) = sel*HH*gzi_hat/sjk*(-1.0d0)*tvec(1:2) dselvec(3:4) = sel*HH*gzi_hat/sjk*(-1.0d0)*(mvec(1:2) - tvec(1:2)) dselvec(5:6) = sel*HH*gzi_hat/sjk*mvec(1:2) dselvec(7:8) = 0.0d0 dselvec(1:2) = dselvec(1:2) + 0.0d0 dselvec(3:4) = dselvec(3:4) + (-alpha)*tvec_(1:2) !!+- dselvec(5:6) = dselvec(5:6) + tvec_(1:2) dselvec(7:8) = dselvec(7:8) - (1.0d0 - alpha)*tvec_(1:2) dlamdavec_(1:8) = gzi_*dgzi_hat_vec(1:8) + gzi_hat*dgzivec_(1:8) & - ganma_hat*dganmavec_(1:8) - ganma_*dganma_hat_vec(1:8) !original part dsjkvec(1:2) = dble(beta)*0.0d0 dsjkvec(3:4) = dble(beta)*(-1.0d0)*tvec(1:2) dsjkvec(5:6) = dble(beta)*tvec(1:2) dsjkvec(7:8) = dble(beta)*0.0d0 lamda_ = gzi_*gzi_hat - ganma_*ganma_hat T0 = 1.0d0/sjk*HH*lamda_ dT0vec(1:8) = -HH*lamda_/sjk/sjk*dsjkvec(1:8) + HH/sjk*dlamdavec_(1:8) + lamda_/sjk*dHvec(1:8) Svec(1:2) = -sel*HH*gzi_hat/sjk*tvec(1:2) Svec(3:4) = -sel*HH*gzi_hat/sjk*mvec(1:2) - tvec(1:2)!!+- Svec(5:6) = -sel*HH*gzi_hat/sjk*(-mvec(1:2)) Svec(7:8) = 0.0d0 Svec(1:2) = Svec(1:2) + 0.0d0 Svec(3:4) = Svec(3:4) + (-alpha)*tvec_(1:2) Svec(5:6) = Svec(5:6) + tvec_(1:2) Svec(7:8) = Svec(7:8) - (1.0d0 - alpha)*tvec_(1:2) nt(1:2) = T0*tvec(1:2) nt(3:4) = T0*(mvec(1:2) - tvec(1:2))!!+- nt(5:6) = T0*(-mvec(1:2)) nt(7:8) = 0.0d0 nt(1:2) = nt(1:2) + 1.0d0/sel*tvec_(1:2) nt(3:4) = nt(3:4) + 1.0d0/sel*(alpha*mvec_(1:2) - tvec_(1:2)) nt(5:6) = nt(5:6) + 1.0d0/sel*(-mvec_(1:2)) nt(7:8) = nt(7:8) + 1.0d0/sel*(1.0d0 - alpha)*mvec_(1:2) Dnt(1:2, 1:8) = diadic(tvec(1:2), dT0vec(1:8)) + T0*dtmat(1:2, 1:8) Dnt(3:4, 1:8) = diadic(mvec(1:2) - tvec(1:2), dT0vec(1:8)) + T0*(dmmat(1:2, 1:8) - dtmat(1:2, 1:8))!!+- Dnt(5:6, 1:8) = -diadic(mvec(1:2), dT0vec(1:8)) - T0*dmmat(1:2, 1:8) Dnt(7:8, 1:8) = 0.0d0 Dnt(1:2, 1:8) = Dnt(1:2, 1:8) - 1.0d0/sel/sel*diadic(tvec_(1:2), dselvec(1:8)) Dnt(3:4, 1:8) = Dnt(3:4, 1:8) - 1.0d0/sel/sel*diadic(alpha*mvec_(1:2) - tvec_(1:2), dselvec(1:8)) !inverse original Dnt(5:6, 1:8) = Dnt(5:6, 1:8) - 1.0d0/sel/sel*diadic(-mvec_(1:2), dselvec(1:8)) Dnt(7:8, 1:8) = Dnt(7:8, 1:8) - 1.0d0/sel/sel*diadic((1.0d0 - alpha)*mvec_(1:2), dselvec(1:8)) Dnt(1:2, 1:8) = Dnt(1:2, 1:8) + 1.0d0/sel*dtmat_(1:2, 1:8) Dnt(3:4, 1:8) = Dnt(3:4, 1:8) + 1.0d0/sel*(diadic(mvec_(1:2), dalpha(1:8)) + alpha*dmmat_(1:2, 1:8) - dtmat_(1:2, 1:8))!inverse original Dnt(5:6, 1:8) = Dnt(5:6, 1:8) + 1.0d0/sel*(-dmmat_(1:2, 1:8)) Dnt(7:8, 1:8) = Dnt(7:8, 1:8) + 1.0d0/sel*(-diadic(mvec_(1:2), dalpha(1:8)) + (1.0d0 - alpha)*dmmat_(1:2, 1:8)) if (stick_slip(active_nts(j)) == 0) then Ft(1:8) = dble(beta)*ct*sel*nt(1:8) elseif (stick_slip(active_nts(j)) == 1) then Ft(1:8) = en*tan(phy)*ns(1:8) else stop "invalid stick_slip on contact.f95" end if fvec_e(1:8) = fvec_e(1:8) + dble(beta)*tts*sel*nt(1:8) K_st(1:8,1:8)=K_st(1:8,1:8)+dble(beta)*transpose( sel*diadic(Ft(1:8),nt(1:8))+tts*diadic(Svec(1:8),nt(1:8))+tts*sel*Dnt(1:8,1:8)) fvec_e(:) = fvec_e(:)*l !integration K_st(:, :) = K_st(:, :)*l !integration do i = 1, 4 do ii = 1, 4 k_contact(2*nts_elem_nod(active_nts(j), i) - 1, 2*nts_elem_nod(active_nts(j), ii) - 1) & = k_contact(2*nts_elem_nod(active_nts(j), i) - 1, 2*nts_elem_nod(active_nts(j), ii) - 1) & + k_st(2*i - 1, 2*ii - 1) k_contact(2*nts_elem_nod(active_nts(j), i) - 1, 2*nts_elem_nod(active_nts(j), ii)) & = k_contact(2*nts_elem_nod(active_nts(j), i) - 1, 2*nts_elem_nod(active_nts(j), ii)) & + k_st(2*i - 1, 2*ii) k_contact(2*nts_elem_nod(active_nts(j), i), 2*nts_elem_nod(active_nts(j), ii) - 1) & = k_contact(2*nts_elem_nod(active_nts(j), i), 2*nts_elem_nod(active_nts(j), ii) - 1) & + k_st(2*i, 2*ii - 1) k_contact(2*nts_elem_nod(active_nts(j), i), 2*nts_elem_nod(active_nts(j), ii)) & = k_contact(2*nts_elem_nod(active_nts(j), i), 2*nts_elem_nod(active_nts(j), ii)) & + k_st(2*i, 2*ii) end do end do do i = 1, 4 fvec_contact(2*nts_elem_nod(active_nts(j), i) - 1) & = fvec_contact(2*nts_elem_nod(active_nts(j), i) - 1) + fvec_e(2*i - 1) fvec_contact(2*nts_elem_nod(active_nts(j), i)) & = fvec_contact(2*nts_elem_nod(active_nts(j), i)) + fvec_e(2*i) end do elseif (beta == -1) then !normal part >>> !normal part >>> ns(1:2) = omega*(tvec(1:2)) ns(3:4) = omega*(-mvec(1:2)) ns(5:6) = omega*(mvec(1:2) - tvec(1:2))!!+- ns(7:8) = 0.0d0 ns(1:2) = ns(1:2) + nvec__(1:2) ns(3:4) = ns(3:4) - (1.0d0 - alpha*gz_)*nvec__(1:2) ns(5:6) = ns(5:6) - gz_*nvec__(1:2) ns(7:8) = ns(7:8) + (1.0d0 - alpha)*gz_*nvec__(1:2) Dns_1_1(1:2) = tvec(1:2) Dns_1_1(3:4) = -mvec(:) Dns_1_1(5:6) = mvec(1:2) - tvec(1:2)!!+- Dns_1_1(7:8) = 0.0d0 domega_mat(1:2) = 1.0d0/sjk*S0*tvec(:) domega_mat(3:4) = 1.0d0/sjk*(-S0*mvec(1:2) - omega*tvec(1:2)) domega_mat(5:6) = 1.0d0/sjk*(S0*(mvec(1:2) - tvec(1:2)) + omega*tvec(1:2))!!+- domega_mat(7:8) = 0.0d0 domega_mat(1:2) = domega_mat(1:2) + HH/sjk*ganma_hat*tvec__(1:2) domega_mat(3:4) = domega_mat(3:4) + HH/sjk*(ganma_hat*(alpha*mvec__(1:2) - tvec__(1:2)) + gzi_*(1.0d0 + alpha*gzi_hat)*nvec__(1:2)) domega_mat(5:6) = domega_mat(5:6) + HH/sjk*(-ganma_hat*mvec__(1:2) - gzi_*ganma_hat*nvec__(1:2)) domega_mat(7:8)=domega_mat(7:8)+HH/sjk*(gzi_*(-1.0d0+(1.0d0-alpha )*gzi_hat)*nvec__(1:2)+ganma_hat*(1.0d0-alpha)*mvec__(1:2) ) dtmat(1:2, 1:2) = 0.0d0 dtmat(1:2, 3:4) = diadic(nvec(1:2), nvec(1:2))/sjk dtmat(1:2, 5:6) = -diadic(nvec(1:2), nvec(1:2))/sjk!!+- dtmat(1:2, 7:8) = 0.0d0 dmmat(1:2, 1:2) = (diadic(tvec(1:2), tvec(1:2)) - diadic(nvec(1:2), nvec(1:2)))/sjk dmmat(1:2, 3:4) = (-diadic(tvec(1:2), mvec(1:2)) & + diadic(nvec(1:2), ovec(1:2)) + diadic(ovec(1:2), nvec(1:2)))/sjk dmmat(1:2, 5:6) = (-diadic(tvec(1:2), tvec(1:2)) + diadic(nvec(1:2), nvec(1:2)) + diadic(tvec(1:2), mvec(1:2)) & - diadic(nvec(1:2), ovec(1:2)) - diadic(ovec(1:2), nvec(1:2)))/sjk!!+- dmmat(1:2, 7:8) = 0.0d0 dnmat__(1:2, 1:2) = HH*ganma_hat/sjk*diadic(tvec__(1:2), tvec(1:2)) dnmat__(1:2, 3:4) = -HH*ganma_hat/sjk*diadic(tvec__(1:2), mvec(1:2)) dnmat__(1:2, 5:6) = HH*ganma_hat/sjk*diadic(tvec__(1:2), mvec(1:2) - tvec(1:2))!!+- dnmat__(1:2, 7:8) = 0.0d0 dnmat__(1:2, 1:2) = dnmat__(1:2, 1:2) + 0.0d0 dnmat__(1:2, 3:4) = dnmat__(1:2, 3:4) + 1.0d0/sel*alpha*diadic(tvec__(1:2), nvec_(1:2)) dnmat__(1:2, 5:6) = dnmat__(1:2, 5:6) - 1.0d0/sel*diadic(tvec__(1:2), nvec_(1:2)) dnmat__(1:2, 7:8) = dnmat__(1:2, 7:8) + 1.0d0/sel*(1.0d0 - alpha)*diadic(tvec__(1:2), nvec_(1:2)) dgzivec(1:2) = 1.0d0/sjk*tvec(1:2) dgzivec(3:4) = -1.0d0/sjk*mvec(1:2) dgzivec(5:6) = 1.0d0/sjk*(mvec(1:2) - tvec(1:2))!!+- dgzivec(7:8) = 0.0d0 dalpha(1:2) = HH/sjk*tvec(1:2) dalpha(3:4) = -HH/sjk*mvec(1:2) dalpha(5:6) = HH/sjk*(mvec(1:2) - tvec(1:2))!!+- dalpha(7:8) = 0.0d0 dHvec(1:2) = kappa/sjk*tvec(1:2) dHvec(3:4) = -kappa/sjk*mvec(1:2) dHvec(5:6) = kappa/sjk*(mvec(1:2) - tvec(1:2))!!+- dHvec(7:8) = 0.0d0 dgzivec_(1:2) = HH*(gzi_*gzi_hat - ganma_*ganma_hat)/sjk*tvec(1:2) dgzivec_(3:4) = -HH*(gzi_*gzi_hat - ganma_*ganma_hat)/sjk*mvec(1:2) dgzivec_(5:6) = HH*(gzi_*gzi_hat - ganma_*ganma_hat)/sjk*(mvec(1:2) - tvec(1:2))!!+- dgzivec_(7:8) = 0.0d0 dgzivec_(1:2) = dgzivec_(1:2) + 1.0d0/sel*tvec_(1:2) dgzivec_(3:4) = dgzivec_(3:4) + 1.0d0/sel*(alpha*mvec_(1:2) - tvec_(1:2)) dgzivec_(5:6) = dgzivec_(5:6) + 1.0d0/sel*(-1.0d0)*mvec_(1:2) dgzivec_(7:8) = dgzivec_(7:8) + 1.0d0/sel*(1.0d0 - alpha)*mvec_(1:2) Dns(1:8, 1:8) = diadic(Dns_1_1, domega_mat) Dns(1:2, 1:8) = Dns(1:2, 1:8) + omega*dtmat(1:2, 1:8) Dns(3:4, 1:8) = Dns(3:4, 1:8) + omega*(-dmmat(1:2, 1:8)) Dns(5:6, 1:8) = Dns(5:6, 1:8) + omega*(dmmat(1:2, 1:8) - dtmat(1:2, 1:8))!!+- Dns(7:8, 1:8) = Dns(7:8, 1:8) + 0.0d0 Dns(1:2, 1:8) = Dns(1:2, 1:8) + dnmat__(1:2, 1:8) Dns(3:4, 1:8) = Dns(3:4, 1:8) + diadic(nvec__(1:2), alpha*dgzivec_(1:8) + gzi_*dalpha(1:8)) - (1.0d0 - alpha*gzi_)*dnmat__(1:2, 1:8) Dns(5:6, 1:8) = Dns(5:6, 1:8) - diadic(nvec__(1:2), dgzivec_(1:8)) - gzi_*dnmat__(1:2, 1:8) Dns(7:8,1:8)=Dns(7:8,1:8)+diadic(nvec__(1:2),(1.0d0-alpha)*dgzivec_(1:8)-gzi_*dalpha(1:8) )+(1.0d0-alpha)*gzi_*dnmat__(1:2,1:8) fvec_e(1:8) = en*gns_*ns(1:8) K_st(1:8, 1:8) = en*(diadic(ns, ns) + gns_*Dns(1:8, 1:8)) ! note >> du(1),du(2),du(3),du(4) !tangential part>>> dnmat_(1:2, 1:2) = HH*ganma_hat/sjk*diadic(tvec_(1:2), tvec(1:2)) dnmat_(1:2, 3:4) = -HH*ganma_hat/sjk*diadic(tvec_(1:2), mvec(1:2)) dnmat_(1:2, 5:6) = HH*ganma_hat/sjk*diadic(tvec_(1:2), mvec(1:2) - tvec(1:2))!!+- dnmat_(1:2, 7:8) = 0.0d0 dnmat_(1:2, 1:2) = dnmat__(1:2, 1:2) + 0.0d0 dnmat_(1:2, 3:4) = dnmat__(1:2, 3:4) + 1.0d0/sel*alpha*diadic(tvec_(1:2), nvec_(1:2)) dnmat_(1:2, 5:6) = dnmat__(1:2, 5:6) - 1.0d0/sel*diadic(tvec_(1:2), nvec_(1:2)) dnmat_(1:2, 7:8) = dnmat__(1:2, 7:8) + 1.0d0/sel*(1.0d0 - alpha)*diadic(tvec_(1:2), nvec_(1:2)) dganmavec_(1:2) = HH*(gzi_*ganma_hat + gzi_hat*ganma_)/sjk*(tvec(1:2)) dganmavec_(3:4) = HH*(gzi_*ganma_hat + gzi_hat*ganma_)/sjk*(-mvec(1:2)) dganmavec_(5:6) = HH*(gzi_*ganma_hat + gzi_hat*ganma_)/sjk*(mvec(1:2) - tvec(1:2))!!+- dganmavec_(7:8) = 0.0d0 dganmavec_(1:2) = dganmavec_(1:2) + 1.0d0/sel*(nvec_(1:2)) dganmavec_(3:4) = dganmavec_(3:4) + 1.0d0/sel*(alpha*(gzi_*nvec_(1:2) + ganma_*tvec_(1:2)) - nvec_(1:2)) dganmavec_(5:6) = dganmavec_(5:6) + 1.0d0/sel*(-(gzi_*nvec_(1:2) + ganma_*tvec_(1:2))) dganmavec_(7:8) = dganmavec_(7:8) + 1.0d0/sel*((1.0d0 - alpha)*(gzi_*nvec_(1:2) + ganma_*tvec_(1:2))) dganma_hat_vec(1:2) = 2.0d0*HH*gzi_hat*ganma_hat/sjk*(tvec(1:2)) dganma_hat_vec(3:4) = 2.0d0*HH*gzi_hat*ganma_hat/sjk*(-mvec(1:2)) dganma_hat_vec(5:6) = 2.0d0*HH*gzi_hat*ganma_hat/sjk*(mvec(1:2) - tvec(1:2))!!+- dganma_hat_vec(7:8) = 0.0d0 dganma_hat_vec(1:2) = dganma_hat_vec(1:2) + 0.0d0 dganma_hat_vec(3:4) = dganma_hat_vec(3:4) + 1.0d0/sel*(alpha*(gzi_hat*nvec_(1:2) + ganma_hat*tvec_(1:2)) + nvec_(1:2)) dganma_hat_vec(5:6) = dganma_hat_vec(5:6) + 1.0d0/sel*(-(gzi_hat*nvec_(1:2) + ganma_hat*tvec_(1:2))) dganma_hat_vec(7:8) = dganma_hat_vec(7:8) + 1.0d0/sel*((1.0d0 - alpha)*(gzi_hat*nvec_(1:2) + ganma_hat*tvec_(1:2)) - nvec_(1:2)) dgzi_hat_vec(1:2) = HH*(gzi_hat*gzi_hat - ganma_hat*ganma_hat)/sjk*(tvec(1:2)) dgzi_hat_vec(3:4) = HH*(gzi_hat*gzi_hat - ganma_hat*ganma_hat)/sjk*(-mvec(1:2)) dgzi_hat_vec(5:6) = HH*(gzi_hat*gzi_hat - ganma_hat*ganma_hat)/sjk*(mvec(1:2) - tvec(1:2))!!+- dgzi_hat_vec(7:8) = 0.0d0 dgzi_hat_vec(1:2) = dgzi_hat_vec(1:2) + 0.0d0 dgzi_hat_vec(3:4) = dgzi_hat_vec(3:4) + 1.0d0/sel*((gzi_hat*tvec_(1:2) - ganma_hat*nvec_(1:2))*alpha + tvec_(1:2)) dgzi_hat_vec(5:6) = dgzi_hat_vec(5:6) + 1.0d0/sel*(-(gzi_hat*tvec_(1:2) - ganma_hat*nvec_(1:2))) dgzi_hat_vec(7:8) = dgzi_hat_vec(7:8) + 1.0d0/sel*((1.0d0 - alpha)*(gzi_hat*tvec_(1:2) - ganma_hat*nvec_(1:2)) - tvec_(1:2)) dtmat_(1:2, 1:2) = HH*ganma_hat/sjk*(-1.0d0)*(diadic(nvec_(1:2), tvec(1:2))) dtmat_(1:2, 3:4) = HH*ganma_hat/sjk*(1.0d0)*(diadic(nvec_(1:2), mvec(1:2))) dtmat_(1:2, 5:6) = HH*ganma_hat/sjk*(-1.0d0)*(diadic(nvec_(1:2), mvec(1:2) - tvec(1:2)))!!+- dtmat_(1:2, 7:8) = 0.0d0 dtmat_(1:2, 1:2) = dtmat_(1:2, 1:2) + 0.0d0 dtmat_(1:2, 3:4) = dtmat_(1:2, 3:4) + 1.0d0/sel*(-1.0d0)*alpha*diadic(nvec_(1:2), nvec_(1:2)) dtmat_(1:2, 5:6) = dtmat_(1:2, 5:6) + 1.0d0/sel*(1.0d0)*diadic(nvec_(1:2), nvec_(1:2)) dtmat_(1:2, 7:8) = dtmat_(1:2, 7:8) + 1.0d0/sel*(-1.0d0 + alpha)*diadic(nvec_(1:2), nvec_(1:2)) dmmat_(1:2, 1:8) = diadic(tvec_(1:2), dgzivec_(1:8)) dmmat_(1:2, 1:8) = dmmat_(1:2, 1:8) + gzi_*dtmat_(1:2, 1:8) dmmat_(1:2, 1:8) = dmmat_(1:2, 1:8) + diadic(nvec_(1:2), dganmavec_(1:8)) dmmat_(1:2, 1:8) = dmmat_(1:2, 1:8) + ganma_*dnmat_(1:2, 1:8) dselvec(1:2) = sel*HH*gzi_hat/sjk*(-1.0d0)*tvec(1:2) dselvec(3:4) = sel*HH*gzi_hat/sjk*(-1.0d0)*(mvec(1:2) - tvec(1:2)) dselvec(5:6) = sel*HH*gzi_hat/sjk*mvec(1:2) dselvec(7:8) = 0.0d0 dselvec(1:2) = dselvec(1:2) + 0.0d0 dselvec(3:4) = dselvec(3:4) + tvec_(1:2) dselvec(5:6) = dselvec(5:6) + (-alpha)*tvec_(1:2) !!+- dselvec(7:8) = dselvec(7:8) - (1.0d0 - alpha)*tvec_(1:2) dlamdavec_(1:8) = gzi_*dgzi_hat_vec(1:8) + gzi_hat*dgzivec_(1:8) & - ganma_hat*dganmavec_(1:8) - ganma_*dganma_hat_vec(1:8) !original part dsjkvec(1:2) = dble(beta)*0.0d0 dsjkvec(3:4) = dble(beta)*(-1.0d0)*tvec(1:2) dsjkvec(5:6) = dble(beta)*tvec(1:2) dsjkvec(7:8) = dble(beta)*0.0d0 lamda_ = gzi_*gzi_hat - ganma_*ganma_hat T0 = 1.0d0/sjk*HH*lamda_ dT0vec(1:8) = -HH*lamda_/sjk/sjk*dsjkvec(1:8) + HH/sjk*dlamdavec_(1:8) + lamda_/sjk*dHvec(1:8) Svec(1:2) = -sel*HH*gzi_hat/sjk*tvec(1:2) Svec(3:4) = -sel*HH*gzi_hat/sjk*(-mvec(1:2)) Svec(5:6) = -sel*HH*gzi_hat/sjk*mvec(1:2) - tvec(1:2)!!+- Svec(7:8) = 0.0d0 Svec(1:2) = Svec(1:2) + 0.0d0 Svec(3:4) = Svec(3:4) + (-alpha)*tvec_(1:2) Svec(5:6) = Svec(5:6) + tvec_(1:2) Svec(7:8) = Svec(7:8) - (1.0d0 - alpha)*tvec_(1:2) nt(1:2) = T0*tvec(1:2) nt(3:4) = T0*(-mvec(1:2)) nt(5:6) = T0*(mvec(1:2) - tvec(1:2))!!+- nt(7:8) = 0.0d0 nt(1:2) = nt(1:2) + 1.0d0/sel*tvec_(1:2) nt(3:4) = nt(3:4) + 1.0d0/sel*(alpha*mvec_(1:2) - tvec_(1:2)) nt(5:6) = nt(5:6) + 1.0d0/sel*(-mvec_(1:2)) nt(7:8) = nt(7:8) + 1.0d0/sel*(1.0d0 - alpha)*mvec_(1:2) Dnt(1:2, 1:8) = diadic(tvec(1:2), dT0vec(1:8)) + T0*dtmat(1:2, 1:8) Dnt(3:4, 1:8) = -diadic(mvec(1:2), dT0vec(1:8)) - T0*dmmat(1:2, 1:8) Dnt(5:6, 1:8) = diadic(mvec(1:2) - tvec(1:2), dT0vec(1:8)) + T0*(dmmat(1:2, 1:8) - dtmat(1:2, 1:8))!!+- Dnt(7:8, 1:8) = 0.0d0 Dnt(1:2, 1:8) = Dnt(1:2, 1:8) - 1.0d0/sel/sel*diadic(tvec_(1:2), dselvec(1:8)) Dnt(3:4, 1:8) = Dnt(3:4, 1:8) - 1.0d0/sel/sel*diadic(alpha*mvec_(1:2) - tvec_(1:2), dselvec(1:8)) !inverse original Dnt(5:6, 1:8) = Dnt(5:6, 1:8) - 1.0d0/sel/sel*diadic(-mvec_(1:2), dselvec(1:8)) Dnt(7:8, 1:8) = Dnt(7:8, 1:8) - 1.0d0/sel/sel*diadic((1.0d0 - alpha)*mvec_(1:2), dselvec(1:8)) Dnt(1:2, 1:8) = Dnt(1:2, 1:8) + 1.0d0/sel*dtmat_(1:2, 1:8) Dnt(3:4, 1:8) = Dnt(3:4, 1:8) + 1.0d0/sel*(diadic(mvec_(1:2), dalpha(1:8)) + alpha*dmmat_(1:2, 1:8) - dtmat_(1:2, 1:8))!inverse original Dnt(5:6, 1:8) = Dnt(5:6, 1:8) + 1.0d0/sel*(-dmmat_(1:2, 1:8)) Dnt(7:8, 1:8) = Dnt(7:8, 1:8) + 1.0d0/sel*(-diadic(mvec_(1:2), dalpha(1:8)) + (1.0d0 - alpha)*dmmat_(1:2, 1:8)) if (stick_slip(active_nts(j)) == 0) then Ft(1:8) = dble(beta)*ct*sel*nt(1:8) elseif (stick_slip(active_nts(j)) == 1) then Ft(1:8) = en*tan(phy)*ns(1:8) else stop "invalid stick_slip on contact.f95" end if fvec_e(1:8) = fvec_e(1:8) + dble(beta)*tts*sel*nt(1:8) K_st(1:8,1:8)=K_st(1:8,1:8)+dble(beta)*transpose( sel*diadic(Ft(1:8),nt(1:8))+tts*diadic(Svec(1:8),nt(1:8))+tts*sel*Dnt(1:8,1:8)) fvec_e(:) = fvec_e(:)*l !integration K_st(:, :) = K_st(:, :)*l !integration do i = 1, 4 do ii = 1, 4 if (i == 3) then i_1 = 4 elseif (i == 4) then i_1 = 3 else i_1 = i end if if (ii == 3) then ii_1 = 4 elseif (ii == 4) then ii_1 = 3 else ii_1 = ii end if k_contact(2*nts_elem_nod(active_nts(j), i_1) - 1, 2*nts_elem_nod(active_nts(j), ii_1) - 1) & = k_contact(2*nts_elem_nod(active_nts(j), i_1) - 1, 2*nts_elem_nod(active_nts(j), ii_1) - 1) & + k_st(2*i_1 - 1, 2*ii_1 - 1) k_contact(2*nts_elem_nod(active_nts(j), i_1) - 1, 2*nts_elem_nod(active_nts(j), ii_1)) & = k_contact(2*nts_elem_nod(active_nts(j), i_1) - 1, 2*nts_elem_nod(active_nts(j), ii_1)) & + k_st(2*i_1 - 1, 2*ii_1) k_contact(2*nts_elem_nod(active_nts(j), i_1), 2*nts_elem_nod(active_nts(j), ii_1) - 1) & = k_contact(2*nts_elem_nod(active_nts(j), i_1), 2*nts_elem_nod(active_nts(j), ii_1) - 1) & + k_st(2*i_1, 2*ii_1 - 1) k_contact(2*nts_elem_nod(active_nts(j), i_1), 2*nts_elem_nod(active_nts(j), ii_1)) & = k_contact(2*nts_elem_nod(active_nts(j), i_1), 2*nts_elem_nod(active_nts(j), ii_1)) & + k_st(2*i_1, 2*ii_1) end do end do do i = 1, 4 if (i == 3) then i_1 = 4 elseif (i == 4) then i_1 = 3 else i_1 = i end if fvec_contact(2*nts_elem_nod(active_nts(j), i_1) - 1) & = fvec_contact(2*nts_elem_nod(active_nts(j), i_1) - 1) + fvec_e(2*i_1 - 1) fvec_contact(2*nts_elem_nod(active_nts(j), i_1)) & = fvec_contact(2*nts_elem_nod(active_nts(j), i_1)) + fvec_e(2*i_1) end do else stop "error :: invalid beta" end if do k = 1, size(fvec_contact) if (fvec_contact(k) >= 0.0d0 .or. fvec_contact(k) < 0.0d0) then cycle else stop "NaN ct !!" end if end do !諸量の更新 nts_amo(active_nts(j), 1) = gz0 !trial gzi0 on current timestep !nts_amo(active_nts(j),10) =gz !converged gzi at last timestep nts_amo(active_nts(j), 2) = dble(beta) !trial beta on current timestep !nts_amo(active_nts(j),11) =pn !inactive end subroutine update_res_grad_c_i !============================================================== subroutine update_res_grad_c(j, nod_max, old_nod_coord, nts_elem_nod, active_nts & , nts_amo, k_contact, uvec, duvec, fvec_contact, stick_slip, contact_mat_para, nts_mat) real(real64), allocatable ::x2s(:), x11(:), x12(:), evec(:), avec(:), nvec(:) & , k_st(:, :), ns(:), n0s(:), ts(:), ts_st(:), t0s(:), ngz0(:), fvec_e(:), nod_coord(:, :), & nvec_(:), tvec_(:), x1(:), x2(:), x3(:), x4(:), x5(:), x6(:), tvec(:), mvec(:), yi(:), Dns(:, :), & ym(:), ys(:), nvec__(:), ovec(:), mvec_(:), mvec__(:), Dns_1(:), Dns_2(:), Dns_3(:), domega_mat(:), & Dns_1_1(:), Ivec(:), dtmat(:, :), dmmat(:, :), dnmat__(:, :), dgzivec(:), dalpha(:), dHvec(:), nt(:), & Dnt(:, :), dT0vec(:), dtmat_(:, :), dselvec(:), dmmat_(:, :), dgzi_hat_vec(:), dganma_hat_vec(:), & dganmavec_(:), dnmat_(:, :), dgzivec_(:), dsjkvec(:), dlamdavec_(:), Svec(:), Ft(:), yL(:), tvec__(:), & ye(:), yj(:), yk(:), c_nod_coord(:, :) real(real64), intent(inout)::nts_amo(:, :), k_contact(:, :), fvec_contact(:) real(real64), intent(in) :: old_nod_coord(:, :), uvec(:), contact_mat_para(:, :), duvec(:) integer, intent(in) :: j, nod_max, nts_elem_nod(:, :), active_nts(:), nts_mat(:) integer, intent(inout) :: stick_slip(:) real(real64) c, phy, en, ct, gns, gz, l, pn, tts, gt, gz0, alpha, omega, gns_, gz_, sjk, delta real(real64) gzi_hat, delta_hat, ganma_, kappa, S0, ganma, gzi_, ganma_hat, lamda_, T0, dfdtn, HH, sel integer i, ii, k, beta, i_1, ii_1, node_ID ! 0 duvecの格納,ξ,ｇN等諸量の格納 allocate (x2s(2), x11(2), x12(2), evec(3), avec(3), nvec(3), k_st(8, 8), & ns(8), n0s(8), ts(8), t0s(8), ngz0(8), ts_st(8), fvec_e(8), tvec(2), mvec(2)) allocate (nvec_(3), tvec_(3), x1(2), x2(2), x3(2), x4(2), x5(2), x6(2), yi(2)) allocate (ym(2), ys(2), nvec__(2), ovec(2), mvec_(2), mvec__(2), Dns(8, 8), Dns_1_1(8)) allocate (Dns_1(8), domega_mat(8), Ivec(2)) allocate (dtmat(2, 8), dmmat(2, 8), dnmat__(2, 8), dgzivec(8), dalpha(8), dHvec(8)) allocate (nod_coord(size(old_nod_coord, 1), size(old_nod_coord, 2))) allocate (nt(8), Dnt(8, 8), dT0vec(8), dtmat_(2, 8), dselvec(8), dmmat_(2, 8), dgzi_hat_vec(8)) allocate (dganma_hat_vec(8), dganmavec_(8), dnmat_(2, 8), dgzivec_(8), dsjkvec(8), dlamdavec_(8)) allocate (Svec(8), Ft(8), yL(2), tvec__(1:2)) allocate (ye(2), yj(2), yk(2), c_nod_coord(size(nod_coord, 1), size(nod_coord, 2))) do i = 1, size(nod_coord, 1) nod_coord(i, 1) = old_nod_coord(i, 1) nod_coord(i, 2) = old_nod_coord(i, 2) end do do i = 1, size(nod_coord, 1) c_nod_coord(i, 1) = nod_coord(i, 1) + uvec(2*i - 1) c_nod_coord(i, 2) = nod_coord(i, 2) + uvec(2*i) end do !-----材料パラメータの読み込み------ en = contact_mat_para(nts_mat(active_nts(j)), 2) ct = contact_mat_para(nts_mat(active_nts(j)), 1) c = contact_mat_para(nts_mat(active_nts(j)), 3) phy = contact_mat_para(nts_mat(active_nts(j)), 4) !-------------------------------- delta = 1.0e-5 tts = nts_amo(active_nts(j), 12) !dfdtn=nts_amo(active_nts(j),10) if (tts >= 0.0d0) then dfdtn = 1.0d0 elseif (tts < 0.0d0) then dfdtn = -1.0d0 else stop "invalid tTs" end if !以下、初期座標＋変位により、位置ベクトルを更新し、諸量を更新 !gz更新 x1(1:2) = uvec(2*nts_elem_nod(active_nts(j), 1) - 1: & 2*nts_elem_nod(active_nts(j), 1)) + & duvec(2*nts_elem_nod(active_nts(j), 1) - 1: & 2*nts_elem_nod(active_nts(j), 1)) + & nod_coord(nts_elem_nod(active_nts(j), 1), 1:2) x2(1:2) = uvec(2*nts_elem_nod(active_nts(j), 2) - 1: & 2*nts_elem_nod(active_nts(j), 2)) + & duvec(2*nts_elem_nod(active_nts(j), 2) - 1: & 2*nts_elem_nod(active_nts(j), 2)) + & nod_coord(nts_elem_nod(active_nts(j), 2), 1:2) x3(1:2) = uvec(2*nts_elem_nod(active_nts(j), 3) - 1: & 2*nts_elem_nod(active_nts(j), 3)) + & duvec(2*nts_elem_nod(active_nts(j), 3) - 1: & 2*nts_elem_nod(active_nts(j), 3)) + & nod_coord(nts_elem_nod(active_nts(j), 3), 1:2) x4(1:2) = uvec(2*nts_elem_nod(active_nts(j), 4) - 1: & 2*nts_elem_nod(active_nts(j), 4)) + & duvec(2*nts_elem_nod(active_nts(j), 4) - 1: & 2*nts_elem_nod(active_nts(j), 4)) + & nod_coord(nts_elem_nod(active_nts(j), 4), 1:2) x5(1:2) = uvec(2*nts_elem_nod(active_nts(j), 5) - 1: & 2*nts_elem_nod(active_nts(j), 5)) + & duvec(2*nts_elem_nod(active_nts(j), 5) - 1: & 2*nts_elem_nod(active_nts(j), 5)) + & nod_coord(nts_elem_nod(active_nts(j), 5), 1:2) x6(1:2) = uvec(2*nts_elem_nod(active_nts(j), 6) - 1: & 2*nts_elem_nod(active_nts(j), 6)) + & duvec(2*nts_elem_nod(active_nts(j), 6) - 1: & 2*nts_elem_nod(active_nts(j), 6)) + & nod_coord(nts_elem_nod(active_nts(j), 6), 1:2) node_ID = active_nts(j) call get_beta_st_nts(node_ID, nts_elem_nod, c_nod_coord, beta) if (beta == 1) then x2s(1:2) = x1(:) x11(1:2) = x2(:) x12(1:2) = x3(:) yi(1:2) = x4(:) yj(1:2) = x2(1:2) yk(1:2) = x3(1:2) ys(1:2) = x1(1:2) ym(1:2) = x2(1:2) ye(1:2) = x3(1:2) else x2s(1:2) = x1(:) x11(1:2) = x4(:) x12(1:2) = x2(:) yi(1:2) = x3(:) yj(1:2) = x4(1:2) yk(1:2) = x2(1:2) ys(1:2) = x1(1:2) ym(1:2) = x2(1:2) ye(1:2) = x4(1:2) end if ! 0 duvecの格納,ξ,ｇN等諸量の格納 !----------------------------------------------------------------------- !----------------------------------------------------------------------- nvec(3) = 0.0d0 avec(3) = 0.0d0 evec(1) = 0.0d0 evec(2) = 0.0d0 evec(3) = 1.0d0 Ivec(1) = 1.0d0 Ivec(2) = 1.0d0 nvec_(3) = 0.0d0 tvec_(3) = 0.0d0 !---------------------------------- l = dot_product(yj(1:2) - yk(1:2), yj(1:2) - yk(1:2)) l = dsqrt(l) sjk = l if (l == 0.0d0) then print *, "l=0 at element No.", node_ID stop end if avec(1:2) = (yk(1:2) - yj(1:2))/l nvec(:) = cross_product(evec, avec) gz = 1.0d0/l*dot_product(ys(1:2) - yj(1:2), avec(1:2)) gns = dot_product((ys(:) - ym(:)), nvec(1:2)) !alpha=4.0d0*gz*(1.0d0-gz) !alpha=0.50d0*(1.0d0-cos(2.0d0*3.1415926535d0*gz) ) !alpha=exp( -delta*delta*(2.0d0*gz-1.0d0)**2.0d0 ) alpha = 1.0d0 !alpha=0.0d0 yL(:) = yi(:) + alpha*(ym(:) - yi(:)) sel = dsqrt(dot_product(ye - yL, ye - yL)) gz0 = gz - tts/ct/sel if (sel == 0.0d0) then stop "error check_gn" end if tvec_(1:2) = (ye(:) - yL(:))/sel nvec_(:) = cross_product(evec, tvec_) tvec(1:2) = avec(1:2) mvec(:) = gz*tvec(:) - gns/sjk*nvec(:) nvec__(1:2) = nvec_(1:2)*dble(beta) !gnsの計算と更新----------------------------------------------------- gns_ = dot_product((ys(:) - ym(:)), nvec__(1:2)) gz_ = 1.0d0/sel*dot_product(ys - ym, tvec_(1:2)) !get f_contact(normal),K_contact(normal) !compute common variables gzi_ = 1.0d0/sel*dot_product(ys - ym, tvec_(1:2)) ganma_hat = 1.0d0/sel*dot_product(ym - yi, nvec_(1:2)) !HH=4.0d0*(1.0d0-2.0d0*gz) !HH=-3.1415926535d0*cos(2.0d0*3.1415926535d0*gz) HH = alpha*(delta*delta)*(4.0d0 - 8.0d0*gz) HH = 0.0d0 omega = 1.0d0/sjk*HH*gz_*dot_product(ym - yi, nvec__(1:2)) gzi_hat = 1.0d0/sel*dot_product(ym - yi, tvec_(1:2)) delta_hat = dot_product(ym - yi, nvec_(1:2)) ganma_ = 1.0d0/sel*dot_product(ys - ym, nvec_(1:2)) ganma = gns/sjk ovec(1:2) = gz*nvec(1:2) + ganma*tvec(1:2) mvec_(1:2) = gzi_*tvec_(1:2) - ganma_*nvec_(1:2) mvec__(1:2) = gzi_*tvec_(1:2) - ganma_*nvec_(1:2) !kappa=-8.0d0 !kappa=-2.0d0*3.1415926535d0*3.1415926535d0*cos(2.0d0*3.1415926535d0*gz) kappa = alpha*(delta)*(delta)*(delta)*(delta)*(4.0d0 - 8.0d0*gz) - 8.0d0*alpha*(delta*delta) kappa = 0.0d0 !kappa=8.0d0 tvec__(1:2) = dble(beta)*tvec_(1:2) S0 = delta_hat*dble(beta)/sjk*(kappa*gzi_ + HH*HH*(2.0d0*gzi_*gzi_hat - ganma_*ganma_hat)) if (beta == 1) then !normal part >>> ns(1:2) = omega*(tvec(1:2)) ns(3:4) = omega*(mvec(1:2) - tvec(1:2))!!+- ns(5:6) = omega*(-mvec(1:2)) ns(7:8) = 0.0d0 ns(1:2) = ns(1:2) + nvec__(1:2) ns(3:4) = ns(3:4) - (1.0d0 - alpha*gz_)*nvec__(1:2) ns(5:6) = ns(5:6) - gz_*nvec__(1:2) ns(7:8) = ns(7:8) + (1.0d0 - alpha)*gz_*nvec__(1:2) Dns_1_1(1:2) = tvec(1:2) Dns_1_1(3:4) = mvec(1:2) - tvec(1:2) Dns_1_1(5:6) = -mvec(:) Dns_1_1(7:8) = 0.0d0 domega_mat(1:2) = 1.0d0/sjk*S0*tvec(:) domega_mat(3:4) = 1.0d0/sjk*(S0*(mvec(1:2) - tvec(1:2)) + omega*tvec(1:2))!!+- domega_mat(5:6) = 1.0d0/sjk*(-S0*mvec(1:2) - omega*tvec(1:2)) domega_mat(7:8) = 0.0d0 domega_mat(1:2) = domega_mat(1:2) + HH/sjk*ganma_hat*tvec__(1:2) domega_mat(3:4) = domega_mat(3:4) + HH/sjk*(ganma_hat*(alpha*mvec__(1:2) - tvec__(1:2)) + gzi_*(1.0d0 + alpha*gzi_hat)*nvec__(1:2)) domega_mat(5:6) = domega_mat(5:6) + HH/sjk*(-ganma_hat*mvec__(1:2) - gzi_*ganma_hat*nvec__(1:2)) domega_mat(7:8)=domega_mat(7:8)+HH/sjk*(gzi_*(-1.0d0+(1.0d0-alpha )*gzi_hat)*nvec__(1:2)+ganma_hat*(1.0d0-alpha)*mvec__(1:2) ) dtmat(1:2, 1:2) = 0.0d0 dtmat(1:2, 3:4) = -diadic(nvec(1:2), nvec(1:2))/sjk!!+- dtmat(1:2, 5:6) = diadic(nvec(1:2), nvec(1:2))/sjk dtmat(1:2, 7:8) = 0.0d0 dmmat(1:2, 1:2) = (diadic(tvec(1:2), tvec(1:2)) - diadic(nvec(1:2), nvec(1:2)))/sjk!!+- dmmat(1:2, 3:4) = (-diadic(tvec(1:2), tvec(1:2)) + diadic(nvec(1:2), nvec(1:2)) + diadic(tvec(1:2), mvec(1:2)) & - diadic(nvec(1:2), ovec(1:2)) - diadic(ovec(1:2), nvec(1:2)))/sjk dmmat(1:2, 5:6) = (-diadic(tvec(1:2), mvec(1:2)) & + diadic(nvec(1:2), ovec(1:2)) + diadic(ovec(1:2), nvec(1:2)))/sjk dmmat(1:2, 7:8) = 0.0d0 dnmat__(1:2, 1:2) = HH*ganma_hat/sjk*diadic(tvec__(1:2), tvec(1:2)) dnmat__(1:2, 3:4) = HH*ganma_hat/sjk*diadic(tvec__(1:2), mvec(1:2) - tvec(1:2))!!+- dnmat__(1:2, 5:6) = -HH*ganma_hat/sjk*diadic(tvec__(1:2), mvec(1:2)) dnmat__(1:2, 7:8) = 0.0d0 dnmat__(1:2, 1:2) = dnmat__(1:2, 1:2) + 0.0d0 dnmat__(1:2, 3:4) = dnmat__(1:2, 3:4) + 1.0d0/sel*alpha*diadic(tvec__(1:2), nvec_(1:2)) dnmat__(1:2, 5:6) = dnmat__(1:2, 5:6) - 1.0d0/sel*diadic(tvec__(1:2), nvec_(1:2)) dnmat__(1:2, 7:8) = dnmat__(1:2, 7:8) + 1.0d0/sel*(1.0d0 - alpha)*diadic(tvec__(1:2), nvec_(1:2)) dgzivec(1:2) = 1.0d0/sjk*tvec(1:2) dgzivec(3:4) = 1.0d0/sjk*(mvec(1:2) - tvec(1:2))!!+- dgzivec(5:6) = -1.0d0/sjk*mvec(1:2) dgzivec(7:8) = 0.0d0 dalpha(1:2) = HH/sjk*tvec(1:2) dalpha(3:4) = HH/sjk*(mvec(1:2) - tvec(1:2))!!+- dalpha(5:6) = -HH/sjk*mvec(1:2) dalpha(7:8) = 0.0d0 dHvec(1:2) = kappa/sjk*tvec(1:2) dHvec(3:4) = kappa/sjk*(mvec(1:2) - tvec(1:2))!!+- dHvec(5:6) = -kappa/sjk*mvec(1:2) dHvec(7:8) = 0.0d0 dgzivec_(1:2) = HH*(gzi_*gzi_hat - ganma_*ganma_hat)/sjk*tvec(1:2) dgzivec_(3:4) = HH*(gzi_*gzi_hat - ganma_*ganma_hat)/sjk*(mvec(1:2) - tvec(1:2))!!+- dgzivec_(5:6) = -HH*(gzi_*gzi_hat - ganma_*ganma_hat)/sjk*mvec(1:2) dgzivec_(7:8) = 0.0d0 dgzivec_(1:2) = dgzivec_(1:2) + 1.0d0/sel*tvec_(1:2) dgzivec_(3:4) = dgzivec_(3:4) + 1.0d0/sel*(alpha*mvec_(1:2) - tvec_(1:2)) dgzivec_(5:6) = dgzivec_(5:6) + 1.0d0/sel*(-1.0d0)*mvec_(1:2) dgzivec_(7:8) = dgzivec_(7:8) + 1.0d0/sel*(1.0d0 - alpha)*mvec_(1:2) Dns(1:8, 1:8) = diadic(Dns_1_1, domega_mat) Dns(1:2, 1:8) = Dns(1:2, 1:8) + omega*dtmat(1:2, 1:8) Dns(3:4, 1:8) = Dns(3:4, 1:8) + omega*(dmmat(1:2, 1:8) - dtmat(1:2, 1:8))!!+- Dns(5:6, 1:8) = Dns(5:6, 1:8) + omega*(-dmmat(1:2, 1:8)) Dns(7:8, 1:8) = Dns(7:8, 1:8) + 0.0d0 Dns(1:2, 1:8) = Dns(1:2, 1:8) + dnmat__(1:2, 1:8) Dns(3:4, 1:8) = Dns(3:4, 1:8) + diadic(nvec__(1:2), alpha*dgzivec_(1:8) + gzi_*dalpha(1:8)) - (1.0d0 - alpha*gzi_)*dnmat__(1:2, 1:8) Dns(5:6, 1:8) = Dns(5:6, 1:8) - diadic(nvec__(1:2), dgzivec_(1:8)) - gzi_*dnmat__(1:2, 1:8) Dns(7:8,1:8)=Dns(7:8,1:8)+diadic(nvec__(1:2),(1.0d0-alpha)*dgzivec_(1:8)-gzi_*dalpha(1:8) )+(1.0d0-alpha)*gzi_*dnmat__(1:2,1:8) fvec_e(1:8) = en*gns_*ns(1:8) K_st(1:8, 1:8) = en*(diadic(ns, ns) + gns_*Dns(1:8, 1:8)) ! note >> du(1),du(2),du(3),du(4) !tangential part>>> dnmat_(1:2, 1:2) = HH*ganma_hat/sjk*diadic(tvec_(1:2), tvec(1:2)) dnmat_(1:2, 3:4) = HH*ganma_hat/sjk*diadic(tvec_(1:2), mvec(1:2) - tvec(1:2))!!+- dnmat_(1:2, 5:6) = -HH*ganma_hat/sjk*diadic(tvec_(1:2), mvec(1:2)) dnmat_(1:2, 7:8) = 0.0d0 dnmat_(1:2, 1:2) = dnmat__(1:2, 1:2) + 0.0d0 dnmat_(1:2, 3:4) = dnmat__(1:2, 3:4) + 1.0d0/sel*alpha*diadic(tvec_(1:2), nvec_(1:2)) dnmat_(1:2, 5:6) = dnmat__(1:2, 5:6) - 1.0d0/sel*diadic(tvec_(1:2), nvec_(1:2)) dnmat_(1:2, 7:8) = dnmat__(1:2, 7:8) + 1.0d0/sel*(1.0d0 - alpha)*diadic(tvec_(1:2), nvec_(1:2)) dganmavec_(1:2) = HH*(gzi_*ganma_hat + gzi_hat*ganma_)/sjk*(tvec(1:2)) dganmavec_(3:4) = HH*(gzi_*ganma_hat + gzi_hat*ganma_)/sjk*(mvec(1:2) - tvec(1:2))!!+- dganmavec_(5:6) = HH*(gzi_*ganma_hat + gzi_hat*ganma_)/sjk*(-mvec(1:2)) dganmavec_(7:8) = 0.0d0 dganmavec_(1:2) = dganmavec_(1:2) + 1.0d0/sel*(nvec_(1:2)) dganmavec_(3:4) = dganmavec_(3:4) + 1.0d0/sel*(alpha*(gzi_*nvec_(1:2) + ganma_*tvec_(1:2)) - nvec_(1:2)) dganmavec_(5:6) = dganmavec_(5:6) + 1.0d0/sel*(-(gzi_*nvec_(1:2) + ganma_*tvec_(1:2))) dganmavec_(7:8) = dganmavec_(7:8) + 1.0d0/sel*((1.0d0 - alpha)*(gzi_*nvec_(1:2) + ganma_*tvec_(1:2))) dganma_hat_vec(1:2) = 2.0d0*HH*gzi_hat*ganma_hat/sjk*(tvec(1:2)) dganma_hat_vec(3:4) = 2.0d0*HH*gzi_hat*ganma_hat/sjk*(mvec(1:2) - tvec(1:2))!!+- dganma_hat_vec(5:6) = 2.0d0*HH*gzi_hat*ganma_hat/sjk*(-mvec(1:2)) dganma_hat_vec(7:8) = 0.0d0 dganma_hat_vec(1:2) = dganma_hat_vec(1:2) + 0.0d0 dganma_hat_vec(3:4) = dganma_hat_vec(3:4) + 1.0d0/sel*(alpha*(gzi_hat*nvec_(1:2) + ganma_hat*tvec_(1:2)) + nvec_(1:2)) dganma_hat_vec(5:6) = dganma_hat_vec(5:6) + 1.0d0/sel*(-(gzi_hat*nvec_(1:2) + ganma_hat*tvec_(1:2))) dganma_hat_vec(7:8) = dganma_hat_vec(7:8) + 1.0d0/sel*((1.0d0 - alpha)*(gzi_hat*nvec_(1:2) + ganma_hat*tvec_(1:2)) - nvec_(1:2)) dgzi_hat_vec(1:2) = HH*(gzi_hat*gzi_hat - ganma_hat*ganma_hat)/sjk*(tvec(1:2)) dgzi_hat_vec(3:4) = HH*(gzi_hat*gzi_hat - ganma_hat*ganma_hat)/sjk*(mvec(1:2) - tvec(1:2))!!+- dgzi_hat_vec(5:6) = HH*(gzi_hat*gzi_hat - ganma_hat*ganma_hat)/sjk*(-mvec(1:2)) dgzi_hat_vec(7:8) = 0.0d0 dgzi_hat_vec(1:2) = dgzi_hat_vec(1:2) + 0.0d0 dgzi_hat_vec(3:4) = dgzi_hat_vec(3:4) + 1.0d0/sel*((gzi_hat*tvec_(1:2) - ganma_hat*nvec_(1:2))*alpha + tvec_(1:2)) dgzi_hat_vec(5:6) = dgzi_hat_vec(5:6) + 1.0d0/sel*(-(gzi_hat*tvec_(1:2) - ganma_hat*nvec_(1:2))) dgzi_hat_vec(7:8) = dgzi_hat_vec(7:8) + 1.0d0/sel*((1.0d0 - alpha)*(gzi_hat*tvec_(1:2) - ganma_hat*nvec_(1:2)) - tvec_(1:2)) dtmat_(1:2, 1:2) = HH*ganma_hat/sjk*(-1.0d0)*(diadic(nvec_(1:2), tvec(1:2))) dtmat_(1:2, 3:4) = HH*ganma_hat/sjk*(-1.0d0)*(diadic(nvec_(1:2), mvec(1:2) - tvec(1:2)))!!+- dtmat_(1:2, 5:6) = HH*ganma_hat/sjk*(1.0d0)*(diadic(nvec_(1:2), mvec(1:2))) dtmat_(1:2, 7:8) = 0.0d0 dtmat_(1:2, 1:2) = dtmat_(1:2, 1:2) + 0.0d0 dtmat_(1:2, 3:4) = dtmat_(1:2, 3:4) + 1.0d0/sel*(-1.0d0)*alpha*diadic(nvec_(1:2), nvec_(1:2)) dtmat_(1:2, 5:6) = dtmat_(1:2, 5:6) + 1.0d0/sel*(1.0d0)*diadic(nvec_(1:2), nvec_(1:2)) dtmat_(1:2, 7:8) = dtmat_(1:2, 7:8) + 1.0d0/sel*(-1.0d0 + alpha)*diadic(nvec_(1:2), nvec_(1:2)) dmmat_(1:2, 1:8) = diadic(tvec_(1:2), dgzivec_(1:8)) dmmat_(1:2, 1:8) = dmmat_(1:2, 1:8) + gzi_*dtmat_(1:2, 1:8) dmmat_(1:2, 1:8) = dmmat_(1:2, 1:8) + diadic(nvec_(1:2), dganmavec_(1:8)) dmmat_(1:2, 1:8) = dmmat_(1:2, 1:8) + ganma_*dnmat_(1:2, 1:8) dselvec(1:2) = sel*HH*gzi_hat/sjk*(-1.0d0)*tvec(1:2) dselvec(3:4) = sel*HH*gzi_hat/sjk*(-1.0d0)*(mvec(1:2) - tvec(1:2)) dselvec(5:6) = sel*HH*gzi_hat/sjk*mvec(1:2) dselvec(7:8) = 0.0d0 dselvec(1:2) = dselvec(1:2) + 0.0d0 dselvec(3:4) = dselvec(3:4) + (-alpha)*tvec_(1:2) !!+- dselvec(5:6) = dselvec(5:6) + tvec_(1:2) dselvec(7:8) = dselvec(7:8) - (1.0d0 - alpha)*tvec_(1:2) dlamdavec_(1:8) = gzi_*dgzi_hat_vec(1:8) + gzi_hat*dgzivec_(1:8) & - ganma_hat*dganmavec_(1:8) - ganma_*dganma_hat_vec(1:8) !original part dsjkvec(1:2) = dble(beta)*0.0d0 dsjkvec(3:4) = dble(beta)*(-1.0d0)*tvec(1:2) dsjkvec(5:6) = dble(beta)*tvec(1:2) dsjkvec(7:8) = dble(beta)*0.0d0 lamda_ = gzi_*gzi_hat - ganma_*ganma_hat T0 = 1.0d0/sjk*HH*lamda_ dT0vec(1:8) = -HH*lamda_/sjk/sjk*dsjkvec(1:8) + HH/sjk*dlamdavec_(1:8) + lamda_/sjk*dHvec(1:8) Svec(1:2) = -sel*HH*gzi_hat/sjk*tvec(1:2) Svec(3:4) = -sel*HH*gzi_hat/sjk*mvec(1:2) - tvec(1:2)!!+- Svec(5:6) = -sel*HH*gzi_hat/sjk*(-mvec(1:2)) Svec(7:8) = 0.0d0 Svec(1:2) = Svec(1:2) + 0.0d0 Svec(3:4) = Svec(3:4) + (-alpha)*tvec_(1:2) Svec(5:6) = Svec(5:6) + tvec_(1:2) Svec(7:8) = Svec(7:8) - (1.0d0 - alpha)*tvec_(1:2) nt(1:2) = T0*tvec(1:2) nt(3:4) = T0*(mvec(1:2) - tvec(1:2))!!+- nt(5:6) = T0*(-mvec(1:2)) nt(7:8) = 0.0d0 nt(1:2) = nt(1:2) + 1.0d0/sel*tvec_(1:2) nt(3:4) = nt(3:4) + 1.0d0/sel*(alpha*mvec_(1:2) - tvec_(1:2)) nt(5:6) = nt(5:6) + 1.0d0/sel*(-mvec_(1:2)) nt(7:8) = nt(7:8) + 1.0d0/sel*(1.0d0 - alpha)*mvec_(1:2) Dnt(1:2, 1:8) = diadic(tvec(1:2), dT0vec(1:8)) + T0*dtmat(1:2, 1:8) Dnt(3:4, 1:8) = diadic(mvec(1:2) - tvec(1:2), dT0vec(1:8)) + T0*(dmmat(1:2, 1:8) - dtmat(1:2, 1:8))!!+- Dnt(5:6, 1:8) = -diadic(mvec(1:2), dT0vec(1:8)) - T0*dmmat(1:2, 1:8) Dnt(7:8, 1:8) = 0.0d0 Dnt(1:2, 1:8) = Dnt(1:2, 1:8) - 1.0d0/sel/sel*diadic(tvec_(1:2), dselvec(1:8)) Dnt(3:4, 1:8) = Dnt(3:4, 1:8) - 1.0d0/sel/sel*diadic(alpha*mvec_(1:2) - tvec_(1:2), dselvec(1:8)) !inverse original Dnt(5:6, 1:8) = Dnt(5:6, 1:8) - 1.0d0/sel/sel*diadic(-mvec_(1:2), dselvec(1:8)) Dnt(7:8, 1:8) = Dnt(7:8, 1:8) - 1.0d0/sel/sel*diadic((1.0d0 - alpha)*mvec_(1:2), dselvec(1:8)) Dnt(1:2, 1:8) = Dnt(1:2, 1:8) + 1.0d0/sel*dtmat_(1:2, 1:8) Dnt(3:4, 1:8) = Dnt(3:4, 1:8) + 1.0d0/sel*(diadic(mvec_(1:2), dalpha(1:8)) + alpha*dmmat_(1:2, 1:8) - dtmat_(1:2, 1:8))!inverse original Dnt(5:6, 1:8) = Dnt(5:6, 1:8) + 1.0d0/sel*(-dmmat_(1:2, 1:8)) Dnt(7:8, 1:8) = Dnt(7:8, 1:8) + 1.0d0/sel*(-diadic(mvec_(1:2), dalpha(1:8)) + (1.0d0 - alpha)*dmmat_(1:2, 1:8)) if (stick_slip(active_nts(j)) == 0) then Ft(1:8) = dble(beta)*ct*sel*nt(1:8) elseif (stick_slip(active_nts(j)) == 1) then Ft(1:8) = en*tan(phy)*ns(1:8) else stop "invalid stick_slip on contact.f95" end if fvec_e(1:8) = fvec_e(1:8) + dble(beta)*tts*sel*nt(1:8) K_st(1:8,1:8)=K_st(1:8,1:8)+dble(beta)*transpose( sel*diadic(Ft(1:8),nt(1:8))+tts*diadic(Svec(1:8),nt(1:8))+tts*sel*Dnt(1:8,1:8)) fvec_e(:) = fvec_e(:)*l !integration K_st(:, :) = K_st(:, :)*l !integration do i = 1, 4 do ii = 1, 4 k_contact(2*nts_elem_nod(active_nts(j), i) - 1, 2*nts_elem_nod(active_nts(j), ii) - 1) & = k_contact(2*nts_elem_nod(active_nts(j), i) - 1, 2*nts_elem_nod(active_nts(j), ii) - 1) & + k_st(2*i - 1, 2*ii - 1) k_contact(2*nts_elem_nod(active_nts(j), i) - 1, 2*nts_elem_nod(active_nts(j), ii)) & = k_contact(2*nts_elem_nod(active_nts(j), i) - 1, 2*nts_elem_nod(active_nts(j), ii)) & + k_st(2*i - 1, 2*ii) k_contact(2*nts_elem_nod(active_nts(j), i), 2*nts_elem_nod(active_nts(j), ii) - 1) & = k_contact(2*nts_elem_nod(active_nts(j), i), 2*nts_elem_nod(active_nts(j), ii) - 1) & + k_st(2*i, 2*ii - 1) k_contact(2*nts_elem_nod(active_nts(j), i), 2*nts_elem_nod(active_nts(j), ii)) & = k_contact(2*nts_elem_nod(active_nts(j), i), 2*nts_elem_nod(active_nts(j), ii)) & + k_st(2*i, 2*ii) end do end do do i = 1, 4 fvec_contact(2*nts_elem_nod(active_nts(j), i) - 1) & = fvec_contact(2*nts_elem_nod(active_nts(j), i) - 1) + fvec_e(2*i - 1) fvec_contact(2*nts_elem_nod(active_nts(j), i)) & = fvec_contact(2*nts_elem_nod(active_nts(j), i)) + fvec_e(2*i) end do elseif (beta == -1) then !normal part >>> !normal part >>> ns(1:2) = omega*(tvec(1:2)) ns(3:4) = omega*(-mvec(1:2)) ns(5:6) = omega*(mvec(1:2) - tvec(1:2))!!+- ns(7:8) = 0.0d0 ns(1:2) = ns(1:2) + nvec__(1:2) ns(3:4) = ns(3:4) - (1.0d0 - alpha*gz_)*nvec__(1:2) ns(5:6) = ns(5:6) - gz_*nvec__(1:2) ns(7:8) = ns(7:8) + (1.0d0 - alpha)*gz_*nvec__(1:2) Dns_1_1(1:2) = tvec(1:2) Dns_1_1(3:4) = -mvec(:) Dns_1_1(5:6) = mvec(1:2) - tvec(1:2)!!+- Dns_1_1(7:8) = 0.0d0 domega_mat(1:2) = 1.0d0/sjk*S0*tvec(:) domega_mat(3:4) = 1.0d0/sjk*(-S0*mvec(1:2) - omega*tvec(1:2)) domega_mat(5:6) = 1.0d0/sjk*(S0*(mvec(1:2) - tvec(1:2)) + omega*tvec(1:2))!!+- domega_mat(7:8) = 0.0d0 domega_mat(1:2) = domega_mat(1:2) + HH/sjk*ganma_hat*tvec__(1:2) domega_mat(3:4) = domega_mat(3:4) + HH/sjk*(ganma_hat*(alpha*mvec__(1:2) - tvec__(1:2)) + gzi_*(1.0d0 + alpha*gzi_hat)*nvec__(1:2)) domega_mat(5:6) = domega_mat(5:6) + HH/sjk*(-ganma_hat*mvec__(1:2) - gzi_*ganma_hat*nvec__(1:2)) domega_mat(7:8)=domega_mat(7:8)+HH/sjk*(gzi_*(-1.0d0+(1.0d0-alpha )*gzi_hat)*nvec__(1:2)+ganma_hat*(1.0d0-alpha)*mvec__(1:2) ) dtmat(1:2, 1:2) = 0.0d0 dtmat(1:2, 3:4) = diadic(nvec(1:2), nvec(1:2))/sjk dtmat(1:2, 5:6) = -diadic(nvec(1:2), nvec(1:2))/sjk!!+- dtmat(1:2, 7:8) = 0.0d0 dmmat(1:2, 1:2) = (diadic(tvec(1:2), tvec(1:2)) - diadic(nvec(1:2), nvec(1:2)))/sjk dmmat(1:2, 3:4) = (-diadic(tvec(1:2), mvec(1:2)) & + diadic(nvec(1:2), ovec(1:2)) + diadic(ovec(1:2), nvec(1:2)))/sjk dmmat(1:2, 5:6) = (-diadic(tvec(1:2), tvec(1:2)) + diadic(nvec(1:2), nvec(1:2)) + diadic(tvec(1:2), mvec(1:2)) & - diadic(nvec(1:2), ovec(1:2)) - diadic(ovec(1:2), nvec(1:2)))/sjk!!+- dmmat(1:2, 7:8) = 0.0d0 dnmat__(1:2, 1:2) = HH*ganma_hat/sjk*diadic(tvec__(1:2), tvec(1:2)) dnmat__(1:2, 3:4) = -HH*ganma_hat/sjk*diadic(tvec__(1:2), mvec(1:2)) dnmat__(1:2, 5:6) = HH*ganma_hat/sjk*diadic(tvec__(1:2), mvec(1:2) - tvec(1:2))!!+- dnmat__(1:2, 7:8) = 0.0d0 dnmat__(1:2, 1:2) = dnmat__(1:2, 1:2) + 0.0d0 dnmat__(1:2, 3:4) = dnmat__(1:2, 3:4) + 1.0d0/sel*alpha*diadic(tvec__(1:2), nvec_(1:2)) dnmat__(1:2, 5:6) = dnmat__(1:2, 5:6) - 1.0d0/sel*diadic(tvec__(1:2), nvec_(1:2)) dnmat__(1:2, 7:8) = dnmat__(1:2, 7:8) + 1.0d0/sel*(1.0d0 - alpha)*diadic(tvec__(1:2), nvec_(1:2)) dgzivec(1:2) = 1.0d0/sjk*tvec(1:2) dgzivec(3:4) = -1.0d0/sjk*mvec(1:2) dgzivec(5:6) = 1.0d0/sjk*(mvec(1:2) - tvec(1:2))!!+- dgzivec(7:8) = 0.0d0 dalpha(1:2) = HH/sjk*tvec(1:2) dalpha(3:4) = -HH/sjk*mvec(1:2) dalpha(5:6) = HH/sjk*(mvec(1:2) - tvec(1:2))!!+- dalpha(7:8) = 0.0d0 dHvec(1:2) = kappa/sjk*tvec(1:2) dHvec(3:4) = -kappa/sjk*mvec(1:2) dHvec(5:6) = kappa/sjk*(mvec(1:2) - tvec(1:2))!!+- dHvec(7:8) = 0.0d0 dgzivec_(1:2) = HH*(gzi_*gzi_hat - ganma_*ganma_hat)/sjk*tvec(1:2) dgzivec_(3:4) = -HH*(gzi_*gzi_hat - ganma_*ganma_hat)/sjk*mvec(1:2) dgzivec_(5:6) = HH*(gzi_*gzi_hat - ganma_*ganma_hat)/sjk*(mvec(1:2) - tvec(1:2))!!+- dgzivec_(7:8) = 0.0d0 dgzivec_(1:2) = dgzivec_(1:2) + 1.0d0/sel*tvec_(1:2) dgzivec_(3:4) = dgzivec_(3:4) + 1.0d0/sel*(alpha*mvec_(1:2) - tvec_(1:2)) dgzivec_(5:6) = dgzivec_(5:6) + 1.0d0/sel*(-1.0d0)*mvec_(1:2) dgzivec_(7:8) = dgzivec_(7:8) + 1.0d0/sel*(1.0d0 - alpha)*mvec_(1:2) Dns(1:8, 1:8) = diadic(Dns_1_1, domega_mat) Dns(1:2, 1:8) = Dns(1:2, 1:8) + omega*dtmat(1:2, 1:8) Dns(3:4, 1:8) = Dns(3:4, 1:8) + omega*(-dmmat(1:2, 1:8)) Dns(5:6, 1:8) = Dns(5:6, 1:8) + omega*(dmmat(1:2, 1:8) - dtmat(1:2, 1:8))!!+- Dns(7:8, 1:8) = Dns(7:8, 1:8) + 0.0d0 Dns(1:2, 1:8) = Dns(1:2, 1:8) + dnmat__(1:2, 1:8) Dns(3:4, 1:8) = Dns(3:4, 1:8) + diadic(nvec__(1:2), alpha*dgzivec_(1:8) + gzi_*dalpha(1:8)) - (1.0d0 - alpha*gzi_)*dnmat__(1:2, 1:8) Dns(5:6, 1:8) = Dns(5:6, 1:8) - diadic(nvec__(1:2), dgzivec_(1:8)) - gzi_*dnmat__(1:2, 1:8) Dns(7:8,1:8)=Dns(7:8,1:8)+diadic(nvec__(1:2),(1.0d0-alpha)*dgzivec_(1:8)-gzi_*dalpha(1:8) )+(1.0d0-alpha)*gzi_*dnmat__(1:2,1:8) fvec_e(1:8) = en*gns_*ns(1:8) K_st(1:8, 1:8) = en*(diadic(ns, ns) + gns_*Dns(1:8, 1:8)) ! note >> du(1),du(2),du(3),du(4) !tangential part>>> dnmat_(1:2, 1:2) = HH*ganma_hat/sjk*diadic(tvec_(1:2), tvec(1:2)) dnmat_(1:2, 3:4) = -HH*ganma_hat/sjk*diadic(tvec_(1:2), mvec(1:2)) dnmat_(1:2, 5:6) = HH*ganma_hat/sjk*diadic(tvec_(1:2), mvec(1:2) - tvec(1:2))!!+- dnmat_(1:2, 7:8) = 0.0d0 dnmat_(1:2, 1:2) = dnmat__(1:2, 1:2) + 0.0d0 dnmat_(1:2, 3:4) = dnmat__(1:2, 3:4) + 1.0d0/sel*alpha*diadic(tvec_(1:2), nvec_(1:2)) dnmat_(1:2, 5:6) = dnmat__(1:2, 5:6) - 1.0d0/sel*diadic(tvec_(1:2), nvec_(1:2)) dnmat_(1:2, 7:8) = dnmat__(1:2, 7:8) + 1.0d0/sel*(1.0d0 - alpha)*diadic(tvec_(1:2), nvec_(1:2)) dganmavec_(1:2) = HH*(gzi_*ganma_hat + gzi_hat*ganma_)/sjk*(tvec(1:2)) dganmavec_(3:4) = HH*(gzi_*ganma_hat + gzi_hat*ganma_)/sjk*(-mvec(1:2)) dganmavec_(5:6) = HH*(gzi_*ganma_hat + gzi_hat*ganma_)/sjk*(mvec(1:2) - tvec(1:2))!!+- dganmavec_(7:8) = 0.0d0 dganmavec_(1:2) = dganmavec_(1:2) + 1.0d0/sel*(nvec_(1:2)) dganmavec_(3:4) = dganmavec_(3:4) + 1.0d0/sel*(alpha*(gzi_*nvec_(1:2) + ganma_*tvec_(1:2)) - nvec_(1:2)) dganmavec_(5:6) = dganmavec_(5:6) + 1.0d0/sel*(-(gzi_*nvec_(1:2) + ganma_*tvec_(1:2))) dganmavec_(7:8) = dganmavec_(7:8) + 1.0d0/sel*((1.0d0 - alpha)*(gzi_*nvec_(1:2) + ganma_*tvec_(1:2))) dganma_hat_vec(1:2) = 2.0d0*HH*gzi_hat*ganma_hat/sjk*(tvec(1:2)) dganma_hat_vec(3:4) = 2.0d0*HH*gzi_hat*ganma_hat/sjk*(-mvec(1:2)) dganma_hat_vec(5:6) = 2.0d0*HH*gzi_hat*ganma_hat/sjk*(mvec(1:2) - tvec(1:2))!!+- dganma_hat_vec(7:8) = 0.0d0 dganma_hat_vec(1:2) = dganma_hat_vec(1:2) + 0.0d0 dganma_hat_vec(3:4) = dganma_hat_vec(3:4) + 1.0d0/sel*(alpha*(gzi_hat*nvec_(1:2) + ganma_hat*tvec_(1:2)) + nvec_(1:2)) dganma_hat_vec(5:6) = dganma_hat_vec(5:6) + 1.0d0/sel*(-(gzi_hat*nvec_(1:2) + ganma_hat*tvec_(1:2))) dganma_hat_vec(7:8) = dganma_hat_vec(7:8) + 1.0d0/sel*((1.0d0 - alpha)*(gzi_hat*nvec_(1:2) + ganma_hat*tvec_(1:2)) - nvec_(1:2)) dgzi_hat_vec(1:2) = HH*(gzi_hat*gzi_hat - ganma_hat*ganma_hat)/sjk*(tvec(1:2)) dgzi_hat_vec(3:4) = HH*(gzi_hat*gzi_hat - ganma_hat*ganma_hat)/sjk*(-mvec(1:2)) dgzi_hat_vec(5:6) = HH*(gzi_hat*gzi_hat - ganma_hat*ganma_hat)/sjk*(mvec(1:2) - tvec(1:2))!!+- dgzi_hat_vec(7:8) = 0.0d0 dgzi_hat_vec(1:2) = dgzi_hat_vec(1:2) + 0.0d0 dgzi_hat_vec(3:4) = dgzi_hat_vec(3:4) + 1.0d0/sel*((gzi_hat*tvec_(1:2) - ganma_hat*nvec_(1:2))*alpha + tvec_(1:2)) dgzi_hat_vec(5:6) = dgzi_hat_vec(5:6) + 1.0d0/sel*(-(gzi_hat*tvec_(1:2) - ganma_hat*nvec_(1:2))) dgzi_hat_vec(7:8) = dgzi_hat_vec(7:8) + 1.0d0/sel*((1.0d0 - alpha)*(gzi_hat*tvec_(1:2) - ganma_hat*nvec_(1:2)) - tvec_(1:2)) dtmat_(1:2, 1:2) = HH*ganma_hat/sjk*(-1.0d0)*(diadic(nvec_(1:2), tvec(1:2))) dtmat_(1:2, 3:4) = HH*ganma_hat/sjk*(1.0d0)*(diadic(nvec_(1:2), mvec(1:2))) dtmat_(1:2, 5:6) = HH*ganma_hat/sjk*(-1.0d0)*(diadic(nvec_(1:2), mvec(1:2) - tvec(1:2)))!!+- dtmat_(1:2, 7:8) = 0.0d0 dtmat_(1:2, 1:2) = dtmat_(1:2, 1:2) + 0.0d0 dtmat_(1:2, 3:4) = dtmat_(1:2, 3:4) + 1.0d0/sel*(-1.0d0)*alpha*diadic(nvec_(1:2), nvec_(1:2)) dtmat_(1:2, 5:6) = dtmat_(1:2, 5:6) + 1.0d0/sel*(1.0d0)*diadic(nvec_(1:2), nvec_(1:2)) dtmat_(1:2, 7:8) = dtmat_(1:2, 7:8) + 1.0d0/sel*(-1.0d0 + alpha)*diadic(nvec_(1:2), nvec_(1:2)) dmmat_(1:2, 1:8) = diadic(tvec_(1:2), dgzivec_(1:8)) dmmat_(1:2, 1:8) = dmmat_(1:2, 1:8) + gzi_*dtmat_(1:2, 1:8) dmmat_(1:2, 1:8) = dmmat_(1:2, 1:8) + diadic(nvec_(1:2), dganmavec_(1:8)) dmmat_(1:2, 1:8) = dmmat_(1:2, 1:8) + ganma_*dnmat_(1:2, 1:8) dselvec(1:2) = sel*HH*gzi_hat/sjk*(-1.0d0)*tvec(1:2) dselvec(3:4) = sel*HH*gzi_hat/sjk*(-1.0d0)*(mvec(1:2) - tvec(1:2)) dselvec(5:6) = sel*HH*gzi_hat/sjk*mvec(1:2) dselvec(7:8) = 0.0d0 dselvec(1:2) = dselvec(1:2) + 0.0d0 dselvec(3:4) = dselvec(3:4) + tvec_(1:2) dselvec(5:6) = dselvec(5:6) + (-alpha)*tvec_(1:2) !!+- dselvec(7:8) = dselvec(7:8) - (1.0d0 - alpha)*tvec_(1:2) dlamdavec_(1:8) = gzi_*dgzi_hat_vec(1:8) + gzi_hat*dgzivec_(1:8) & - ganma_hat*dganmavec_(1:8) - ganma_*dganma_hat_vec(1:8) !original part dsjkvec(1:2) = dble(beta)*0.0d0 dsjkvec(3:4) = dble(beta)*(-1.0d0)*tvec(1:2) dsjkvec(5:6) = dble(beta)*tvec(1:2) dsjkvec(7:8) = dble(beta)*0.0d0 lamda_ = gzi_*gzi_hat - ganma_*ganma_hat T0 = 1.0d0/sjk*HH*lamda_ dT0vec(1:8) = -HH*lamda_/sjk/sjk*dsjkvec(1:8) + HH/sjk*dlamdavec_(1:8) + lamda_/sjk*dHvec(1:8) Svec(1:2) = -sel*HH*gzi_hat/sjk*tvec(1:2) Svec(3:4) = -sel*HH*gzi_hat/sjk*(-mvec(1:2)) Svec(5:6) = -sel*HH*gzi_hat/sjk*mvec(1:2) - tvec(1:2)!!+- Svec(7:8) = 0.0d0 Svec(1:2) = Svec(1:2) + 0.0d0 Svec(3:4) = Svec(3:4) + (-alpha)*tvec_(1:2) Svec(5:6) = Svec(5:6) + tvec_(1:2) Svec(7:8) = Svec(7:8) - (1.0d0 - alpha)*tvec_(1:2) nt(1:2) = T0*tvec(1:2) nt(3:4) = T0*(-mvec(1:2)) nt(5:6) = T0*(mvec(1:2) - tvec(1:2))!!+- nt(7:8) = 0.0d0 nt(1:2) = nt(1:2) + 1.0d0/sel*tvec_(1:2) nt(3:4) = nt(3:4) + 1.0d0/sel*(alpha*mvec_(1:2) - tvec_(1:2)) nt(5:6) = nt(5:6) + 1.0d0/sel*(-mvec_(1:2)) nt(7:8) = nt(7:8) + 1.0d0/sel*(1.0d0 - alpha)*mvec_(1:2) Dnt(1:2, 1:8) = diadic(tvec(1:2), dT0vec(1:8)) + T0*dtmat(1:2, 1:8) Dnt(3:4, 1:8) = -diadic(mvec(1:2), dT0vec(1:8)) - T0*dmmat(1:2, 1:8) Dnt(5:6, 1:8) = diadic(mvec(1:2) - tvec(1:2), dT0vec(1:8)) + T0*(dmmat(1:2, 1:8) - dtmat(1:2, 1:8))!!+- Dnt(7:8, 1:8) = 0.0d0 Dnt(1:2, 1:8) = Dnt(1:2, 1:8) - 1.0d0/sel/sel*diadic(tvec_(1:2), dselvec(1:8)) Dnt(3:4, 1:8) = Dnt(3:4, 1:8) - 1.0d0/sel/sel*diadic(alpha*mvec_(1:2) - tvec_(1:2), dselvec(1:8)) !inverse original Dnt(5:6, 1:8) = Dnt(5:6, 1:8) - 1.0d0/sel/sel*diadic(-mvec_(1:2), dselvec(1:8)) Dnt(7:8, 1:8) = Dnt(7:8, 1:8) - 1.0d0/sel/sel*diadic((1.0d0 - alpha)*mvec_(1:2), dselvec(1:8)) Dnt(1:2, 1:8) = Dnt(1:2, 1:8) + 1.0d0/sel*dtmat_(1:2, 1:8) Dnt(3:4, 1:8) = Dnt(3:4, 1:8) + 1.0d0/sel*(diadic(mvec_(1:2), dalpha(1:8)) + alpha*dmmat_(1:2, 1:8) - dtmat_(1:2, 1:8))!inverse original Dnt(5:6, 1:8) = Dnt(5:6, 1:8) + 1.0d0/sel*(-dmmat_(1:2, 1:8)) Dnt(7:8, 1:8) = Dnt(7:8, 1:8) + 1.0d0/sel*(-diadic(mvec_(1:2), dalpha(1:8)) + (1.0d0 - alpha)*dmmat_(1:2, 1:8)) if (stick_slip(active_nts(j)) == 0) then Ft(1:8) = dble(beta)*ct*sel*nt(1:8) elseif (stick_slip(active_nts(j)) == 1) then Ft(1:8) = en*tan(phy)*ns(1:8) else stop "invalid stick_slip on contact.f95" end if fvec_e(1:8) = fvec_e(1:8) + dble(beta)*tts*sel*nt(1:8) K_st(1:8,1:8)=K_st(1:8,1:8)+dble(beta)*transpose( sel*diadic(Ft(1:8),nt(1:8))+tts*diadic(Svec(1:8),nt(1:8))+tts*sel*Dnt(1:8,1:8)) fvec_e(:) = fvec_e(:)*l !integration K_st(:, :) = K_st(:, :)*l !integration do i = 1, 4 do ii = 1, 4 if (i == 3) then i_1 = 4 elseif (i == 4) then i_1 = 3 else i_1 = i end if if (ii == 3) then ii_1 = 4 elseif (ii == 4) then ii_1 = 3 else ii_1 = ii end if k_contact(2*nts_elem_nod(active_nts(j), i_1) - 1, 2*nts_elem_nod(active_nts(j), ii_1) - 1) & = k_contact(2*nts_elem_nod(active_nts(j), i_1) - 1, 2*nts_elem_nod(active_nts(j), ii_1) - 1) & + k_st(2*i_1 - 1, 2*ii_1 - 1) k_contact(2*nts_elem_nod(active_nts(j), i_1) - 1, 2*nts_elem_nod(active_nts(j), ii_1)) & = k_contact(2*nts_elem_nod(active_nts(j), i_1) - 1, 2*nts_elem_nod(active_nts(j), ii_1)) & + k_st(2*i_1 - 1, 2*ii_1) k_contact(2*nts_elem_nod(active_nts(j), i_1), 2*nts_elem_nod(active_nts(j), ii_1) - 1) & = k_contact(2*nts_elem_nod(active_nts(j), i_1), 2*nts_elem_nod(active_nts(j), ii_1) - 1) & + k_st(2*i_1, 2*ii_1 - 1) k_contact(2*nts_elem_nod(active_nts(j), i_1), 2*nts_elem_nod(active_nts(j), ii_1)) & = k_contact(2*nts_elem_nod(active_nts(j), i_1), 2*nts_elem_nod(active_nts(j), ii_1)) & + k_st(2*i_1, 2*ii_1) end do end do do i = 1, 4 if (i == 3) then i_1 = 4 elseif (i == 4) then i_1 = 3 else i_1 = i end if fvec_contact(2*nts_elem_nod(active_nts(j), i_1) - 1) & = fvec_contact(2*nts_elem_nod(active_nts(j), i_1) - 1) + fvec_e(2*i_1 - 1) fvec_contact(2*nts_elem_nod(active_nts(j), i_1)) & = fvec_contact(2*nts_elem_nod(active_nts(j), i_1)) + fvec_e(2*i_1) end do else stop "error :: invalid beta" end if !諸量の更新 !nts_amo(active_nts(j),1) =gz !trial gzi0 on current timestep !nts_amo(active_nts(j),10) =gz !converged gzi at last timestep !nts_amo(active_nts(j),11) =pn !inactive end subroutine update_res_grad_c !============================================================== ! 変位を与えた節点でRvec=0.0d0とする !----------------------------------- subroutine disp_rvec(u_nod_x, u_nod_y, rvec) integer, intent(in) :: u_nod_x(:), u_nod_y(:) real(real64), intent(inout) :: rvec(:) integer i !x方向変位を設定した残差ベクトル成分を0.0d0 do i = 1, size(u_nod_x, 1) rvec(2*u_nod_x(i) - 1) = 0.0d0 end do !y方向変位を設定した残差ベクトル成分を0.0d0 do i = 1, size(u_nod_y, 1) rvec(2*u_nod_y(i)) = 0.0d0 end do end subroutine disp_rvec !=============================================================== subroutine get_beta_st_nts(nts_ID, nts_elem_nod, nod_coord, beta) integer, intent(in)::nts_ID, nts_elem_nod(:, :) integer, intent(out)::beta integer i, j, n real(real64), intent(in)::nod_coord(:, :) real(real64), allocatable::tvec_0(:), x1(:), x2(:), x3(:), a(:) real(real64) direction n = size(nod_coord, 2) allocate (tvec_0(n), x1(n), x2(n), x3(n), a(n)) x1(:) = nod_coord(nts_elem_nod(nts_ID, 2), :) x2(:) = nod_coord(nts_elem_nod(nts_ID, 3), :) x3(:) = nod_coord(nts_elem_nod(nts_ID, 4), :) a(:) = nod_coord(nts_elem_nod(nts_ID, 1), :) - x1(:) tvec_0(:) = x2(:) - x3(:) tvec_0(:) = tvec_0(:)/dsqrt(dot_product(tvec_0, tvec_0)) direction = dot_product(a, tvec_0) if (direction <= 0.0d0) then beta = -1 elseif (direction > 0.0d0) then beta = 1 else !print *, dsqrt(dot_product(tvec_0,tvec_0)),a(1:2),size(a) stop "ERROR on get_beta_st_nts, contact.mod" end if end subroutine get_beta_st_nts !=============================================================== subroutine ls_nts_generateCM(obj) ! 配列の宣言 class(ContactMechanics_), intent(inout) :: obj integer, allocatable:: mast_slav(:, :), mast_slav_es(:, :), & nts_elem_nod_es(:, :), master_nod(:), master_nod_es(:), slave_nod(:), & slave_nod_es(:) real(real64), allocatable ::con_d_coord(:, :), grobal_grid(:, :), grobal_grid_es(:, :), nod_coord(:, :), zerovec(:), uvec(:) integer grobal_grid_max, m, s, m_nod, s_nod, con_max, step, & sla_nod_max, i, j, k, l, o, p, q, nei_nod, nei_nod_1, nei_nod_2, & nn, nts_elem_max, x2, x11, x12, surn1, surn2 real(real64) gn, gn_tr, tol, tol_rm, ll, lx, ly, x, y, z, norm_rvec, norm_uvec, start, fin_time, nts_time, gzi ! only for 2D, 2domains if (.not. allocated(obj%sur_nod_inf)) then allocate (obj%sur_nod_inf(2, 2)) call obj%femdomain1%mesh%getSurface() call obj%femdomain2%mesh%getSurface() surn1 = size(obj%femdomain1%mesh%SurfaceLine2D) surn2 = size(obj%femdomain2%mesh%SurfaceLine2D) obj%sur_nod_inf(1, 1) = 1 obj%sur_nod_inf(1, 2) = surn1 obj%sur_nod_inf(2, 1) = surn1 + 1 obj%sur_nod_inf(2, 2) = surn1 + surn2 if (.not. allocated(obj%surface_nod)) then allocate (obj%surface_nod(surn1 + surn2)) obj%surface_nod(1:surn1) = obj%femdomain1%mesh%SurfaceLine2D(:) obj%surface_nod(1 + surn1:surn2) = obj%femdomain2%mesh%SurfaceLine2D(:) & + size(obj%femdomain1%mesh%nodcoord, 1) end if end if con_max = 2 step = obj%step uvec = obj%uvec p = size(obj%femdomain1%mesh%nodcoord, 1) + size(obj%femdomain2%mesh%nodcoord, 1) q = size(obj%femdomain1%mesh%nodcoord, 2) if (.not. allocated(obj%nod_coord)) allocate (obj%nod_coord(p, q)) obj%nod_coord(1:size(obj%femdomain1%mesh%nodcoord, 1), :) = obj%femdomain1%mesh%nodcoord(:, :) obj%nod_coord(size(obj%femdomain1%mesh%nodcoord, 1) + 1: & size(obj%femdomain2%mesh%nodcoord, 1), :) = obj%femdomain2%mesh%nodcoord(:, :) if (.not. allocated(obj%elem_nod)) allocate (obj%elem_nod(p, q)) obj%elem_nod(1:size(obj%femdomain1%mesh%elemnod, 1), :) = obj%femdomain1%mesh%elemnod(:, :) obj%elem_nod(size(obj%femdomain1%mesh%elemnod, 1) + 1: & size(obj%femdomain2%mesh%elemnod, 1), :) = obj%femdomain2%mesh%elemnod(:, :) & + size(obj%femdomain1%mesh%nodcoord, 1) allocate (nod_coord(size(obj%nod_coord, 1), size(obj%nod_coord, 2)), & zerovec(size(uvec))) do i = 1, size(nod_coord, 1) nod_coord(i, 1) = obj%nod_coord(i, 1) + obj%uvec(2*i - 1) nod_coord(i, 2) = obj%nod_coord(i, 2) + obj%uvec(2*i) end do zerovec(:) = 0.0d0 !=============================== !contact search !========================================================================================= !Grobal search !---------------- allocate (con_d_coord(con_max, 4)) ! 連続体ごと外接する長方形のx-min,x-max,y-min,y-maxの座標 con_d_coord(1:con_max, 1:4) = 0 do i = 1, con_max ! 連続体ループ do j = obj%sur_nod_inf(i, 1), obj%sur_nod_inf(i, 2) !該当連続体の開始節点～最終節点 !各連続体ごとに、最初の節点の値を初期のx-min,x-max,y-min,y-maxの座標とする。 if (j == obj%sur_nod_inf(i, 1)) then con_d_coord(i, 1) = nod_coord(obj%surface_nod(j), 1) con_d_coord(i, 2) = nod_coord(obj%surface_nod(j), 1) con_d_coord(i, 3) = nod_coord(obj%surface_nod(j), 2) con_d_coord(i, 4) = nod_coord(obj%surface_nod(j), 2) end if !連続体ごとに、接点の読み込み、最小/最大の更新 if (con_d_coord(i, 1) > nod_coord(obj%surface_nod(j), 1)) then con_d_coord(i, 1) = nod_coord(obj%surface_nod(j), 1) end if if (con_d_coord(i, 2) < nod_coord(obj%surface_nod(j), 1)) then con_d_coord(i, 2) = nod_coord(obj%surface_nod(j), 1) end if if (con_d_coord(i, 3) > nod_coord(obj%surface_nod(j), 2)) then con_d_coord(i, 3) = nod_coord(obj%surface_nod(j), 2) end if if (con_d_coord(i, 4) < nod_coord(obj%surface_nod(j), 2)) then con_d_coord(i, 4) = nod_coord(obj%surface_nod(j), 2) end if end do end do ! この時点で、連続体ごとに外接長方形の領域が確定 !check grobal_grid_max = 0 allocate (mast_slav(1, 2)) ! grobal search のループ do i = 1, con_max do j = 1, con_max if (i >= j) then cycle end if ! 矩形接触判定 if (con_d_coord(i, 2) < con_d_coord(j, 1)) then cycle elseif (con_d_coord(j, 2) < con_d_coord(i, 1)) then cycle elseif (con_d_coord(i, 4) < con_d_coord(j, 3)) then cycle elseif (con_d_coord(j, 4) < con_d_coord(i, 3)) then cycle else !接触あり !退避用mast_slav_esの作成 if (grobal_grid_max == 0) then mast_slav(1, 1) = i mast_slav(1, 2) = j grobal_grid_max = grobal_grid_max + 1 else allocate (mast_slav_es((size(mast_slav, 1)), 2)) do k = 1, grobal_grid_max do l = 1, 2 mast_slav_es(k, l) = mast_slav(k, l) end do end do deallocate (mast_slav) allocate (mast_slav(grobal_grid_max + 1, 2)) !データの再格納 do k = 1, grobal_grid_max do l = 1, 2 mast_slav(k, l) = mast_slav_es(k, l) end do end do mast_slav(grobal_grid_max + 1, 1) = i mast_slav(grobal_grid_max + 1, 2) = j grobal_grid_max = grobal_grid_max + 1 deallocate (mast_slav_es) end if end if end do end do if (grobal_grid_max /= 0) then !grobal_grid_maxのリセット grobal_grid_max = size(mast_slav, 1) !接触ありのmaster-slaveに対して、接触領域の確定・保存 allocate (grobal_grid(size(mast_slav, 1), 4)) do i = 1, grobal_grid_max do j = 1, 4 grobal_grid(i, j) = 0.0d0 end do end do !以下、xに関して確定・保存 do k = 1, grobal_grid_max i = mast_slav(k, 1) j = mast_slav(k, 2) if (con_d_coord(i, 1) + con_d_coord(i, 2) <= & con_d_coord(j, 1) + con_d_coord(j, 2)) then ! iのx方向辺の中心<=jのx方向辺の中心 if (con_d_coord(i, 2) >= con_d_coord(j, 2)) then !(3)に決定 grobal_grid(k, 1) = con_d_coord(j, 1) ! x-min grobal_grid(k, 2) = con_d_coord(j, 2) ! x-max else if (con_d_coord(i, 1) >= con_d_coord(j, 1)) then !(2)に決定 grobal_grid(k, 1) = con_d_coord(i, 1) ! x-min grobal_grid(k, 2) = con_d_coord(i, 2) ! x-max else !(1)に決定 grobal_grid(k, 1) = con_d_coord(j, 1) ! x-min grobal_grid(k, 2) = con_d_coord(i, 2) ! x-max end if end if else ! iのx方向辺の中心>jのx方向辺の中心 if (con_d_coord(j, 2) >= con_d_coord(i, 2)) then !(3)に決定 grobal_grid(k, 1) = con_d_coord(i, 1) ! x-min grobal_grid(k, 2) = con_d_coord(i, 2) ! x-max else if (con_d_coord(j, 1) >= con_d_coord(i, 1)) then !(2)に決定 grobal_grid(k, 1) = con_d_coord(j, 1) ! x-min grobal_grid(k, 2) = con_d_coord(j, 2) ! x-max else !(1)に決定 grobal_grid(k, 1) = con_d_coord(i, 1) ! x-min grobal_grid(k, 2) = con_d_coord(j, 2) ! x-max end if end if end if end do !以下、yに関して確定・保存 do k = 1, grobal_grid_max ! 接触組み合わせごとにループ i = mast_slav(k, 1) j = mast_slav(k, 2) if ((con_d_coord(i, 3) + con_d_coord(i, 4))/2 <= & (con_d_coord(j, 3) + con_d_coord(j, 4))/2) then ! iのx方向辺の中心<=jのx方向辺の中心 if (con_d_coord(i, 4) >= con_d_coord(j, 4)) then !(3)に決定 grobal_grid(k, 3) = con_d_coord(j, 3) ! y-min grobal_grid(k, 4) = con_d_coord(j, 4) ! y-max else if (con_d_coord(i, 3) >= con_d_coord(j, 3)) then !(2)に決定 grobal_grid(k, 3) = con_d_coord(i, 3) ! y-min grobal_grid(k, 4) = con_d_coord(i, 4) ! y-max else !(1)に決定 grobal_grid(k, 3) = con_d_coord(j, 3) ! y-min grobal_grid(k, 4) = con_d_coord(i, 4) ! y-max end if end if else ! iのx方向辺の中心>jのx方向辺の中心 if (con_d_coord(j, 4) >= con_d_coord(i, 4)) then !(3)に決定 grobal_grid(k, 3) = con_d_coord(i, 3) ! y-min grobal_grid(k, 4) = con_d_coord(i, 4) ! y-max else if (con_d_coord(j, 3) >= con_d_coord(i, 3)) then !(2)に決定 grobal_grid(k, 3) = con_d_coord(j, 3) ! y-min grobal_grid(k, 4) = con_d_coord(j, 4) ! y-max else !(1)に決定 grobal_grid(k, 3) = con_d_coord(i, 3) ! x-min grobal_grid(k, 4) = con_d_coord(j, 4) ! x-max end if end if end if end do ! この時点で、連続体組み合わせごとの重複領域（grobal search grid）が確定 write (*, *) "Grobal search was succeed!" write (20, *) 'grobal grid, xmin xmax ymin ymax' do k = 1, size(grobal_grid, 1) write (20, *) grobal_grid(k, 1), & grobal_grid(k, 2), & grobal_grid(k, 3), & grobal_grid(k, 4) end do !==================================================================================== ! Local search !---------------------- do i = 1, grobal_grid_max !重複矩形ごとループ m = 0 !master,slave各nodの数を記録する変数のリセット s = 0 allocate (master_nod(1)) !master-slaveごとに接点番号記録用配列の用意 allocate (slave_nod(1)) master_nod(:) = 0 slave_nod(:) = 0 do k = 1, 2 !master矩形,slave矩形 write (20, *) 'master,slave', k do j = obj%sur_nod_inf(mast_slav(i, k), 1), obj%sur_nod_inf & (mast_slav(i, k), 2) !m,sごとに、表面節点を1つずつ、重複矩形に入っているか吟味 jは吟味中の表面接点用No. if (grobal_grid(i, 1) <= nod_coord(obj%surface_nod(j), 1) .and. & nod_coord(obj%surface_nod(j), 1) <= grobal_grid(i, 2)) then if (grobal_grid(i, 3) <= nod_coord(obj%surface_nod(j), 2) & .and. nod_coord(obj%surface_nod(j), 2) <= grobal_grid(i, 4)) then if (k == 1) then m = m + 1 !master,slaveごとに接点数記録 !接点数の記録 if (m == 1) then master_nod(m) = obj%surface_nod(j) elseif (m >= 2) then !m>=2である。 !master_nod配列の拡張 allocate (master_nod_es(m - 1)) do l = 1, size(master_nod) !_esへの接点番号の避難 master_nod_es(l) = master_nod(l) end do deallocate (master_nod) allocate (master_nod(m)) !_esから接点番号の再格納 do l = 1, size(master_nod_es) master_nod(l) = master_nod_es(l) end do master_nod(m) = obj%surface_nod(j) deallocate (master_nod_es) !避難用配列の解体 else stop "ERROR Local Search m<1" end if elseif (k == 2) then s = s + 1 !master,slaveごとに接点数記録 !接点数の記録 if (s == 1) then slave_nod(s) = obj%surface_nod(j) write (20, *) obj%surface_nod(j) elseif (s >= 2) then !s>=2である。 !slave_nod配列の拡張 allocate (slave_nod_es(s - 1)) do l = 1, size(slave_nod) !_esへの接点番号の避難 slave_nod_es(l) = slave_nod(l) end do deallocate (slave_nod) allocate (slave_nod(s)) !_esから接点番号の再格納 do l = 1, size(slave_nod_es) slave_nod(l) = slave_nod_es(l) end do slave_nod(s) = obj%surface_nod(j) deallocate (slave_nod_es) !避難用配列の解体 else stop "ERROR Local Search m<2" end if else stop 'L388 masterでもslaveでもないk/=1,2' end if else cycle !次節点へ end if else cycle ! 次節点へ end if end do end do !-------重複矩形の表面節点の出力 write (20, *) 'grobal_grid No.=', i write (20, *) 'master_nod' do l = 1, size(master_nod) write (20, *) master_nod(l) end do write (20, *) 'slave_nod', size(slave_nod) do l = 1, size(slave_nod) write (20, *) slave_nod(l) end do !---------------------- !重複矩形内接点数を計上終了 if (slave_nod(size(slave_nod, 1)) == 0 .or. master_nod(size(master_nod, 1)) == 0) then !重複矩形内に接点なし if (grobal_grid_max == i) then print *, "No contact !" allocate (obj%nts_elem_nod(1, 3)) !no contact >> nts_elem_nod==0 obj%nts_elem_nod(:, :) = 0 exit else cycle !次重複矩形へ end if end if !================================================================ ! 以下、NTS-elementの生成 !------------------------------------ ! (1) nts_element節点番号記憶配列の確保 if (i >= 2) then !NTSへの書き込みが2回目以上で、NTS節点番号記憶用配列の拡張を要する場合 allocate (nts_elem_nod_es(size(obj%nts_elem_nod, 1), 3)) nts_elem_nod_es(:, :) = 0 nts_elem_max = size(obj%nts_elem_nod, 1) do l = 1, size(obj%nts_elem_nod, 1) do k = 1, 3 nts_elem_nod_es(l, k) = obj%nts_elem_nod(l, k) end do end do deallocate (obj%nts_elem_nod) allocate (obj%nts_elem_nod(size(nts_elem_nod_es, 1) + size(slave_nod, 1), 3)) obj%nts_elem_nod(:, :) = 0 ! size=これまでに記録されたntsの数+今回のslave_nodの数 do l = 1, size(nts_elem_nod_es, 1) do k = 1, 3 obj%nts_elem_nod(l, k) = nts_elem_nod_es(l, k) end do end do deallocate (nts_elem_nod_es) elseif (i == 1) then nts_elem_max = 0 allocate (obj%nts_elem_nod(size(slave_nod), 3)) obj%nts_elem_nod(:, :) = 0 else stop "wrong i on module ntselem" end if !nts_elem_nodを拡張済み !------------------------------------------------------------------------------------------- !initial value nei_nod = 0 nei_nod_1 = 0 do l = 1, size(slave_nod) !slave nod ごとにNTS作成 !do k = 1,size(master_nod)!重複矩形を構成するmaster_nodを1つずつ検証 do k = obj%sur_nod_inf(mast_slav(i, 1), 1), obj%sur_nod_inf(mast_slav(i, 1), 2) !表面節点用No. !現在のslave_nodとの距離を計算 lx = (nod_coord(slave_nod(l), 1) - nod_coord(obj%surface_nod(k), 1))**2 ly = (nod_coord(slave_nod(l), 2) - nod_coord(obj%surface_nod(k), 2))**2 gn_tr = (lx + ly)**(1.0d0/2.0d0) if (k == 1) then !初期値 gn = gn_tr end if !汝は最近傍なりや? If (gn_tr <= gn) then gn = gn_tr nei_nod = obj%surface_nod(k) !近傍節点番号の更新X1@表面節点用No. elseif (gn_tr > gn) then cycle else stop 'something is wrong at detecting x_11' end if end do !最近傍節点=nei_nod--------------------- obj%nts_elem_nod(nts_elem_max + l, 1) = slave_nod(l) obj%nts_elem_nod(nts_elem_max + l, 2) = nei_nod end do !次重複矩形へ、パラメータクリア m = 0 s = 0 deallocate (master_nod) deallocate (slave_nod) end do elseif (grobal_grid_max == 0) then print *, "No contact !" allocate (obj%nts_elem_nod(1, 3)) !no contact >> nts_elem_nod==0 obj%nts_elem_nod(:, :) = 0 else stop "Wrong value in grobal_grid" end if deallocate (nod_coord, zerovec) end subroutine !===================================================================== subroutine ls_nts_materialCM(obj) class(ContactMechanics_), intent(inout) :: obj integer i, j, s, m, ss, mm, n, step step = obj%step n = size(obj%nts_elem_nod, 1) if (allocated(obj%nts_mat)) then deallocate (obj%nts_mat) end if allocate (obj%nts_mat(n)) do i = 1, n !nts要素ごとに繰り返し if (obj%nts_elem_nod(1, 1) + obj%nts_elem_nod(1, 2) + obj%nts_elem_nod(1, 3) == 0) then obj%nts_mat(:) = 0 !0を入れておく exit end if ! if(step==136) stop "2" !表面節点No.を検索し、slave=s,master=mへ格納 do j = 1, size(obj%surface_nod, 1) if (obj%surface_nod(j) == obj%nts_elem_nod(i, 1)) then s = j elseif (obj%surface_nod(j) == obj%nts_elem_nod(i, 2)) then m = j else cycle end if end do !master nodの周面材料No.を検索 do j = 1, size(obj%sur_inf_mat, 1) if (obj%sur_inf_mat(j, 1) <= m .and. obj%sur_inf_mat(j, 2) >= m) then mm = obj%sur_inf_mat(j, 3) exit else cycle end if end do !slave nodの周面材料No.を検索 do j = 1, size(obj%sur_inf_mat, 1) if (obj%sur_inf_mat(j, 1) <= s .and. obj%sur_inf_mat(j, 2) >= s) then ss = obj%sur_inf_mat(j, 3) exit else cycle end if end do obj%nts_mat(i) = obj%contact_mat(ss, mm) end do end subroutine !===================================================================== subroutine save_nts_element(nts_elem_nod, nts_amo, old_nts_elem_nod, old_nts_amo, surface_nod, sur_nod_inf, & stick_slip, old_stick_slip) real(real64), intent(in)::nts_amo(:, :) real(real64), allocatable, intent(inout)::old_nts_amo(:, :) real(real64) gzin integer, intent(in)::nts_elem_nod(:, :), surface_nod(:), sur_nod_inf(:, :), stick_slip(:) integer, allocatable, intent(inout)::old_nts_elem_nod(:, :), old_stick_slip(:) integer i, j, n, m1, m2, m3, shift, slave_node, old_master, master1, master2 n = size(nts_elem_nod, 1) m1 = size(nts_elem_nod, 2) m2 = size(nts_amo, 2) if (allocated(old_nts_amo)) deallocate (old_nts_amo) if (allocated(old_nts_elem_nod)) deallocate (old_nts_elem_nod) if (allocated(old_stick_slip)) deallocate (old_stick_slip) allocate (old_nts_elem_nod(n, m1), old_nts_amo(n, m2), old_stick_slip(n)) old_nts_elem_nod(:, :) = nts_elem_nod(:, :) old_nts_amo(:, :) = nts_amo(:, :) old_stick_slip(:) = stick_slip(:) do i = 1, n gzin = nts_amo(i, 10) !converged gzi if (gzin > 1.0d0) then shift = 1 slave_node = nts_elem_nod(i, 1) old_master = nts_elem_nod(i, 2) old_master = nts_elem_nod(i, 3) call get_next_segment(surface_nod, sur_nod_inf, shift, old_master, master1, master2) old_nts_elem_nod(i, 2) = master1 old_nts_elem_nod(i, 3) = master2 gzin = 0.0d0 elseif (gzin < 0.0d0) then shift = -1 slave_node = nts_elem_nod(i, 1) old_master = nts_elem_nod(i, 2) old_master = nts_elem_nod(i, 3) call get_next_segment(surface_nod, sur_nod_inf, shift, old_master, master1, master2) old_nts_elem_nod(i, 2) = master1 old_nts_elem_nod(i, 3) = master2 gzin = 1.0d0 else cycle end if old_nts_amo(i, :) = 0.0d0 old_nts_amo(i, 1) = gzin old_nts_amo(i, 12) = nts_amo(i, 12) end do end subroutine save_nts_element !===================================================================== subroutine get_next_segment(surface_nod, sur_nod_inf, shift, old_master, master1, master2) integer, intent(in)::surface_nod(:), sur_nod_inf(:, :), shift, old_master integer, intent(out)::master1, master2 integer i, surface_nod_ID, domain_number, first_ID, last_ID if (shift == 1) then !case of old_master2 surface_nod_ID = 0 do i = 1, size(surface_nod) if (surface_nod(i) == old_master) then surface_nod_ID = i exit else cycle end if end do domain_number = 0 do i = 1, size(sur_nod_inf) first_ID = sur_nod_inf(i, 1) last_ID = sur_nod_inf(i, 2) if (first_ID <= surface_nod_ID .and. surface_nod_ID <= last_ID) then domain_number = i exit else cycle end if end do if (domain_number == 0 .or. surface_nod_ID == 0) then stop "invalid slave node ID: sub. get_next_segment" end if first_ID = sur_nod_inf(domain_number, 1) last_ID = sur_nod_inf(domain_number, 2) if (surface_nod_ID == last_ID) then master1 = surface_nod(last_ID) master2 = surface_nod(first_ID) else master1 = surface_nod(surface_nod_ID) master2 = surface_nod(surface_nod_ID + 1) end if elseif (shift == -1) then surface_nod_ID = 0 do i = 1, size(surface_nod) if (surface_nod(i) == old_master) then surface_nod_ID = i exit else cycle end if end do domain_number = 0 do i = 1, size(sur_nod_inf) first_ID = sur_nod_inf(i, 1) last_ID = sur_nod_inf(i, 2) if (first_ID <= surface_nod_ID .and. surface_nod_ID <= last_ID) then domain_number = i exit else cycle end if end do if (domain_number == 0 .or. surface_nod_ID == 0) then stop "invalid slave node ID: sub. get_next_segment" end if first_ID = sur_nod_inf(domain_number, 1) last_ID = sur_nod_inf(domain_number, 2) if (surface_nod_ID == first_ID) then master1 = surface_nod(last_ID) master2 = surface_nod(first_ID) else master1 = surface_nod(surface_nod_ID - 1) master2 = surface_nod(surface_nod_ID) end if else stop "invalid shifting parameter : sub.get_next_segment" end if end subroutine get_next_segment !===================================================================== subroutine load_nts_element(nts_elem_nod, nts_amo, old_nts_elem_nod, old_nts_amo, stick_slip, old_stick_slip) real(real64), intent(inout)::nts_amo(:, :) real(real64), intent(in)::old_nts_amo(:, :) integer, intent(inout)::nts_elem_nod(:, :), stick_slip(:) integer, intent(in)::old_nts_elem_nod(:, :), old_stick_slip(:) integer i, j, n do i = 1, size(nts_elem_nod, 1) n = 0 do j = 1, size(old_nts_elem_nod, 1) if (old_nts_elem_nod(j, 1) == nts_elem_nod(i, 1)) then n = j exit else cycle end if end do if (n == 0) then cycle else !nts_elem_nod(i,2)=old_nts_elem_nod(n,2) !nts_elem_nod(i,3)=old_nts_elem_nod(n,3) nts_amo(i, :) = old_nts_amo(i, :) !stick_slip(i)=old_stick_slip(n) end if end do end subroutine load_nts_element !===================================================================== subroutine ls_get_stabilized_ntsCM(obj) class(ContactMechanics_), intent(inout) :: obj integer, allocatable::nts_elem_nod_new(:, :) integer i, j, k, n, node_num, old_master, master1, master2, shift, cs, cm if (obj%nts_elem_nod(1, 1) + obj%nts_elem_nod(1, 2) + obj%nts_elem_nod(1, 3) == 0) then return end if !expand nts_lem_nod from 3 to 6 n = size(obj%nts_elem_nod, 1) allocate (nts_elem_nod_new(n, 6)) !input node#1 and node #2 do i = 1, n nts_elem_nod_new(i, 1:2) = obj%nts_elem_nod(i, 1:2) !get node#3 old_master = nts_elem_nod_new(i, 2) shift = 1 call get_next_segment(obj%surface_nod, obj%sur_nod_inf, shift, old_master, master1, master2) nts_elem_nod_new(i, 3) = master2 !get node#4 old_master = nts_elem_nod_new(i, 2) shift = -1 call get_next_segment(obj%surface_nod, obj%sur_nod_inf, shift, old_master, master1, master2) nts_elem_nod_new(i, 4) = master1 !get node#5 old_master = nts_elem_nod_new(i, 3) shift = 1 call get_next_segment(obj%surface_nod, obj%sur_nod_inf, shift, old_master, master1, master2) nts_elem_nod_new(i, 5) = master2 !get node#6 old_master = nts_elem_nod_new(i, 4) shift = -1 call get_next_segment(obj%surface_nod, obj%sur_nod_inf, shift, old_master, master1, master2) nts_elem_nod_new(i, 6) = master1 end do deallocate (obj%nts_elem_nod) allocate (obj%nts_elem_nod(n, 6)) do i = 1, n obj%nts_elem_nod(i, 1:6) = nts_elem_nod_new(i, 1:6) end do end subroutine !===================================================================== ! ######################################### subroutine setPenaltyParaCM(obj, para) class(ContactMechanics_), intent(inout)::obj real(real64), intent(in) :: para obj%PenaltyPara = para end subroutine ! ######################################### ! ######################################### subroutine updateContactStressCM(obj) class(ContactMechanics_), intent(inout)::obj !type(MPI_)::mpidata if (.not. allocated(obj%FEMIface%NTS_ElemNod)) then call obj%FEMIface%GetFEMIface() end if ! check NTS !call showArray(obj%FEMIface%Mesh1%NodCoord,IndexArray=obj%FEMIface%NTS_ElemNod(:,1:1)& ! ,Name="checkNTSmesh1.txt" ) !call showArray(obj%FEMIface%Mesh2%NodCoord,IndexArray=obj%FEMIface%NTS_ElemNod(:,2: )& ! ,Name="checkNTSmesh2.txt" ) !call showArray(obj%FEMIface%FEMDomains(1)%FEMDomainp%Mesh%NodCoord,& ! IndexArray=obj%FEMIface%NTS_ElemNod(:,1:1),Name="checkNTSdomain2.txt" ) !call showArray(obj%FEMIface%FEMDomains(2)%FEMDomainp%Mesh%NodCoord,& ! IndexArray=obj%FEMIface%NTS_ElemNod(:,2: ),Name="checkNTSdomain2.txt" ) !call showArray(obj%FEMIface%Mesh1%NodCoord, Name="checkNTSmesh1.txt" ) !call showArray(obj%FEMIface%Mesh2%NodCoord, Name="checkNTSmesh2.txt" ) !call showArray(obj%FEMIface%Mesh2%NodCoord, Name="checkNTSmesh2.txt" ) !call showArray(obj%FEMIface%Mesh1%ElemNod,Name="checkNTSmesh1.txt" ) !call showArray(obj%FEMIface%Mesh2%ElemNod,Name="checkNTSmesh2.txt" ) !call showArray(obj%FEMIface%NTS_ElemNod,Name="checkNTSmesh3.txt" ) !wrong pointer !call showArray(obj%FEMIface%NTS_ElemNod,Name="checkNTSmesh4.txt" ) !wrong pointer call obj%getGap() call obj%getForce() call obj%exportForceAsTraction() end subroutine ! ######################################### ! ######################################### subroutine getGapCM(obj) class(ContactMechanics_), intent(inout)::obj real(real64), allocatable :: gap(:), avec(:), avec1(:), avec2(:), nvec(:), evec(:), xs1(:), xm1(:), xm2(:), xm3(:), xm4(:) real(real64), allocatable :: xm5(:), xm6(:), xm7(:), xm8(:), mid(:) real(real64) :: val integer :: i, j, k, n, NumOfNTSelem, dim_num !type(MPI_)::mpidata if (.not. allocated(obj%FEMIface%NTS_ElemNod)) then print *, "Error :: ContactMechanics_ >> updateContactStressCM >> not (.not. allocated(obj%NTS_ElemNod) )" return end if NumOfNTSelem = size(obj%FEMIface%NTS_ElemNod, 1) dim_num = size(obj%FEMIface%FEMDomains(1)%FEMDomainp%Mesh%NodCoord, 2) allocate (gap(dim_num)) allocate (avec(3)) allocate (avec1(3)) allocate (avec2(3)) allocate (nvec(3)) allocate (evec(3)) allocate (xs1(3)) allocate (xm1(3)) allocate (xm2(3)) allocate (xm3(3)) allocate (xm4(3)) allocate (xm5(3)) allocate (xm6(3)) allocate (xm7(3)) allocate (xm8(3)) allocate (mid(3)) ! initial :: inactive gap = 0.0d0 avec(:) = 0.0d0 avec1(:) = 0.0d0 avec2(:) = 0.0d0 nvec(:) = 0.0d0 evec(:) = 0.0d0 evec(3) = 1.0d0 xs1(:) = 0.0d0 xm1(:) = 0.0d0 xm2(:) = 0.0d0 xm3(:) = 0.0d0 xm4(:) = 0.0d0 xm5(:) = 0.0d0 xm6(:) = 0.0d0 xm7(:) = 0.0d0 xm8(:) = 0.0d0 mid(:) = 0.0d0 if (.not. allocated(obj%NTSGap)) then allocate (obj%NTSGap(NumOfNTSElem, dim_num)) obj%NTSGap(:, :) = 0.0d0 elseif (size(obj%NTSGap, 1) /= NumOfNTSElem) then deallocate (obj%NTSGap) allocate (obj%NTSGap(NumOfNTSElem, dim_num)) obj%NTSGap(:, :) = 0.0d0 else obj%NTSGap(:, :) = 0.0d0 end if if (.not. allocated(obj%NTSGzi)) then allocate (obj%NTSGzi(NumOfNTSElem, dim_num)) obj%NTSGzi(:, :) = 0.0d0 elseif (size(obj%NTSGzi, 1) /= NumOfNTSElem) then deallocate (obj%NTSGzi) allocate (obj%NTSGzi(NumOfNTSElem, dim_num)) obj%NTSGzi(:, :) = 0.0d0 else obj%NTSGzi(:, :) = 0.0d0 end if if (dim_num == 2) then ! 2-D NTS do i = 1, NumOfNTSElem print *, "CmClass getGap not validated" xs1(1:2) = obj%FEMIface%NTS_NodCoord(i, 1:2) xm1(1:2) = obj%FEMIface%NTS_NodCoord(i, 3:4) xm2(1:2) = obj%FEMIface%NTS_NodCoord(i, 5:6) avec(1:2) = xm2(1:2) - xm1(1:2) nvec(1:3) = cross_product(evec, avec) val = norm(nvec) if (val == 0.0d0) then print *, "norm = ", val stop "ERROR CMClass >> getGap" end if nvec(:) = 1.0d0/val*nvec(:) obj%NTSGap(i, 1:2) = dot_product(xs1(1:2) - xm1(1:2), nvec(1:2)) print *, "gap=", dot_product(obj%NTSGap(i, 1:2), nvec(1:2)) end do elseif (dim_num == 3) then ! 3-D NTS do i = 1, NumOfNTSElem xs1(1:3) = obj%FEMIface%NTS_NodCoord(i, 1:3) xm1(1:3) = obj%FEMIface%NTS_NodCoord(i, 4:6) xm2(1:3) = obj%FEMIface%NTS_NodCoord(i, 7:9) xm3(1:3) = obj%FEMIface%NTS_NodCoord(i, 10:12) xm4(1:3) = obj%FEMIface%NTS_NodCoord(i, 13:15) mid(:) = 0.250d0*xm1(:) + 0.250d0*xm2(:) + 0.250d0*xm3(:) + 0.250d0*xm4(:) avec1(1:3) = xm1(1:3) - mid(1:3) avec2(1:3) = xm2(1:3) - mid(1:3) nvec(1:3) = cross_product(avec1, avec2) val = norm(nvec) if (val == 0.0d0) then print *, "norm = ", val stop "ERROR CMClass >> getGap" end if nvec(:) = 1.0d0/val*nvec(:) obj%NTSGap(i, 1:3) = dot_product(xs1(1:3) - mid(1:3), nvec(1:3)) !print *, dot_product(obj%NTSGap(i,1:3),nvec) !write(1010,*) " " !write(1010,*) xs1(1:3) !write(1010,*) mid(1:3) !write(1010,*) " " !write(1010,*) xm1(1:3) !write(1010,*) xm2(1:3) !write(1010,*) xm3(1:3) !write(1010,*) xm4(1:3) !write(1010,*) xm1(1:3) !write(1020,*) mid(1:3),xs1(1:3)-mid(1:3) !write(1030,*) mid(1:3),obj%NTSGap(i,1:3) !print *, "gap=",dot_product(obj%NTSGap(i,1:3),nvec(1:3) ) end do else print *, "Dimension of coord = ", dim_num stop "getGapCM >> invalid dimension" end if end subroutine ! ######################################### ! ######################################### subroutine getForceCM(obj) class(ContactMechanics_), intent(inout)::obj real(real64), allocatable :: gap(:), avec(:), avec1(:), avec2(:), nvec(:), evec(:), xs1(:), xm1(:), xm2(:), xm3(:), xm4(:) real(real64), allocatable :: xm5(:), xm6(:), xm7(:), xm8(:), mid(:) real(real64) :: val, area integer :: i, j, k, n, m, NumOfNTSelem, dim_num real(real64) :: gzi, gzi1, gzi2 if (.not. allocated(obj%FEMIface%NTS_ElemNod)) then print *, "Error :: ContactMechanics_ >> updateContactStressCM >> not (.not. allocated(obj%NTS_ElemNod) )" return end if NumOfNTSelem = size(obj%FEMIface%NTS_ElemNod, 1) dim_num = size(obj%FEMIface%FEMDomains(1)%FEMDomainp%Mesh%NodCoord, 2) allocate (gap(dim_num)) allocate (avec(3)) allocate (avec1(3)) allocate (avec2(3)) allocate (nvec(3)) allocate (evec(3)) allocate (xs1(3)) allocate (xm1(3)) allocate (xm2(3)) allocate (xm3(3)) allocate (xm4(3)) allocate (xm5(3)) allocate (xm6(3)) allocate (xm7(3)) allocate (xm8(3)) allocate (mid(3)) ! initial :: inactive gap = 0.0d0 avec(:) = 0.0d0 avec1(:) = 0.0d0 avec2(:) = 0.0d0 nvec(:) = 0.0d0 evec(:) = 0.0d0 evec(3) = 1.0d0 xs1(:) = 0.0d0 xm1(:) = 0.0d0 xm2(:) = 0.0d0 xm3(:) = 0.0d0 xm4(:) = 0.0d0 xm5(:) = 0.0d0 xm6(:) = 0.0d0 xm7(:) = 0.0d0 xm8(:) = 0.0d0 mid(:) = 0.0d0 n = size(obj%FEMDomain1%Mesh%NodCoord, 1) m = size(obj%FEMDomain2%Mesh%NodCoord, 1) dim_num = size(obj%FEMDomain2%Mesh%NodCoord, 2) if (.not. allocated(obj%Domain1Force)) then allocate (obj%Domain1Force(n, dim_num)) obj%Domain1Force(:, :) = 0.0d0 end if if (.not. allocated(obj%Domain2Force)) then allocate (obj%Domain2Force(m, dim_num)) obj%Domain2Force(:, :) = 0.0d0 end if gzi = 0.0d0 gzi1 = 0.0d0 gzi2 = 0.0d0 if (dim_num == 2) then ! import gzi at here ! 2-D NTS do i = 1, NumOfNTSElem print *, "CmClass getGap not validated" xs1(1:2) = obj%FEMIface%NTS_NodCoord(i, 1:2) xm1(1:2) = obj%FEMIface%NTS_NodCoord(i, 3:4) xm2(1:2) = obj%FEMIface%NTS_NodCoord(i, 5:6) avec(1:2) = xm2(1:2) - xm1(1:2) nvec(1:3) = cross_product(evec, avec) val = norm(nvec) if (val == 0.0d0) then print *, "norm = ", val stop "ERROR CMClass >> getGap" end if nvec(:) = 1.0d0/val*nvec(:) end do elseif (dim_num == 3) then ! import gzi at here do i = 1, NumOfNTSElem xs1(1:3) = obj%FEMIface%NTS_NodCoord(i, 1:3) xm1(1:3) = obj%FEMIface%NTS_NodCoord(i, 4:6) xm2(1:3) = obj%FEMIface%NTS_NodCoord(i, 7:9) xm3(1:3) = obj%FEMIface%NTS_NodCoord(i, 10:12) xm4(1:3) = obj%FEMIface%NTS_NodCoord(i, 13:15) mid(:) = 0.250d0*xm1(:) + 0.250d0*xm2(:) + 0.250d0*xm3(:) + 0.250d0*xm4(:) avec1(1:3) = xm1(1:3) - mid(1:3) avec2(1:3) = xm2(1:3) - mid(1:3) nvec(1:3) = cross_product(avec1, avec2) val = norm(nvec) if (val == 0.0d0) then print *, "norm = ", val stop "ERROR CMClass >> getGap" end if nvec(:) = 1.0d0/val*nvec(:) obj%NTSGap(i, 1:3) = dot_product(xs1(1:3) - mid(1:3), nvec(1:3)) ! Area area = 1.0d0 ! compute ShapeFunc(:) ! get contact force from penaltypara*gap*ShapeFunc(:) do j = 1, size(obj%FEMIface%NTS_ElemNod, 1) obj%Domain1Force(obj%FEMIface%NTS_ElemNod(j, 1), 1:3) = & obj%Domain1Force(obj%FEMIface%NTS_ElemNod(j, 1), 1:3) + & obj%penaltypara*obj%NTSGap(i, 1:3)*area obj%Domain2Force(obj%FEMIface%NTS_ElemNod(j, 2), 1:3) = & obj%Domain2Force(obj%FEMIface%NTS_ElemNod(j, 2), 1:3) + & obj%penaltypara*obj%NTSGap(i, 1:3)*area/4.0d0*(-1.0d0) obj%Domain2Force(obj%FEMIface%NTS_ElemNod(j, 3), 1:3) = & obj%Domain2Force(obj%FEMIface%NTS_ElemNod(j, 3), 1:3) + & obj%penaltypara*obj%NTSGap(i, 1:3)*area/4.0d0*(-1.0d0) obj%Domain2Force(obj%FEMIface%NTS_ElemNod(j, 4), 1:3) = & obj%Domain2Force(obj%FEMIface%NTS_ElemNod(j, 4), 1:3) + & obj%penaltypara*obj%NTSGap(i, 1:3)*area/4.0d0*(-1.0d0) obj%Domain2Force(obj%FEMIface%NTS_ElemNod(j, 5), 1:3) = & obj%Domain2Force(obj%FEMIface%NTS_ElemNod(j, 5), 1:3) + & obj%penaltypara*obj%NTSGap(i, 1:3)*area/4.0d0*(-1.0d0) end do end do else print *, "Dimension of coord = ", dim_num stop "getForceCM >> invalid dimension" end if end subroutine ! ######################################### ! ######################################### subroutine exportForceAsTractionCM(obj) class(ContactMechanics_), intent(inout)::obj !type(mpi_)::mpidata integer :: nodeid, i, j, k real(real64) :: bcval do i = 1, size(obj%FEMIface%NTS_ElemNod, 1) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Really?? print *, "slave node id : ", obj%FEMIface%NTS_ElemNod(i, 1), "master node id : ", obj%FEMIface%NTS_ElemNod(i, 2:) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! do j = 1, size(obj%FEMIface%NTS_ElemNod, 2) do k = 1, size(obj%Domain1Force, 2) if (j == 1) then !!!!!!!! debug !!!!!!!!!!!!!!! ! which is the correct node_id? nodeid = obj%FEMIface%Mesh1%GlobalNodID(obj%FEMIface%NTS_ElemNod(i, j)) !nodeid=obj%FEMIface%GloNodPoint1(obj%FEMIface%NTS_ElemNod(i,j)) ! obj%FEMIface%NTS_ElemNod is node pointer to local nodes, obj%FEMIface%Mesh%NodCoord !nodeid=obj%FEMIface%NTS_ElemNod(i,j) bcval = obj%Domain1Force(obj%FEMIface%NTS_ElemNod(i, j), k) !bcval = 0.0d0 !bcval=zeroif(obj%NTSGap(i,k),positive=.true.)/10000.0d0 if (k /= 1) then bcval = 0.0d0 end if call obj%FEMDomain1%AddNBC(NodID=nodeid, DimID=k, Val=bcval, FastMode=.false.) else !!!!!!!! debug !!!!!!!!!!!!!!! nodeid = obj%FEMIface%Mesh2%GlobalNodID(obj%FEMIface%NTS_ElemNod(i, j)) !nodeid=obj%FEMIface%GloNodPoint2(obj%FEMIface%NTS_ElemNod(i,j)) !nodeid=obj%FEMIface%NTS_ElemNod(i,j) bcval = obj%Domain2Force(obj%FEMIface%NTS_ElemNod(i, j), k) !bcval = 0.0d0 !bcval=zeroif(obj%NTSGap(i,k),positive=.true.)/10000.0d0 if (k /= 1) then bcval = 0.0d0 end if call obj%FEMDomain2%AddNBC(NodID=nodeid, DimID=k, Val=bcval, FastMode=.false.) end if end do end do end do !call showArray(obj%FEMDomain1%Mesh%NodCoord,IndexArray=obj%FEMIface%GloNodPoint1,Name="obj%GloNodPoint1.txt" ) !call showArray(obj%FEMDomain2%Mesh%NodCoord,IndexArray=obj%FEMIface%GloNodPoint2,Name="obj%GloNodPoint2.txt" ) call obj%FEMIface%GmshPlotMesh(Name="debugNTS", withNeumannBC=.true., withDirichletBC=.true.) !!call mpidata%end() !stop "debug" end subroutine ! ######################################### ! ######################################################### subroutine updateTimestepContact(obj, timestep) class(ContactMechanics_), intent(inout)::obj integer, optional, intent(in)::timestep call obj%FEMIFace%updateTimeStep(timestep=timestep) end subroutine ! ######################################################### ! ######################################################### subroutine getDispBoundCM(obj) class(ContactMechanics_), intent(inout) :: obj integer(int32) :: num_of_u_nod_x = 0 integer(int32) :: num_of_u_nod_y = 0 integer(int32) :: num_of_u_nod_z = 0 integer(int32) :: i, n, domain1_node_num ! for x do i = 1, size(obj%femdomain1%boundary%DBoundNodID, 1) if (obj%femdomain1%boundary%DBoundNodID(i, 1) >= 1) then num_of_u_nod_x = num_of_u_nod_x + 1 end if end do do i = 1, size(obj%femdomain2%boundary%DBoundNodID, 1) if (obj%femdomain2%boundary%DBoundNodID(i, 1) >= 1) then num_of_u_nod_x = num_of_u_nod_x + 1 end if end do if (allocated(obj%u_nod_x)) deallocate (obj%u_nod_x) if (allocated(obj%u_nod_dis_x)) deallocate (obj%u_nod_dis_x) allocate (obj%u_nod_x(num_of_u_nod_x)) allocate (obj%u_nod_dis_x(num_of_u_nod_x)) num_of_u_nod_x = 0 do i = 1, size(obj%femdomain1%boundary%DBoundNodID, 1) if (obj%femdomain1%boundary%DBoundNodID(i, 1) >= 1) then num_of_u_nod_x = num_of_u_nod_x + 1 obj%u_nod_x(num_of_u_nod_x) = obj%femdomain1%boundary%DBoundNodID(i, 1) obj%u_nod_dis_x(num_of_u_nod_x) = obj%femdomain1%boundary%DBoundVal(i, 1) end if end do do i = 1, size(obj%femdomain2%boundary%DBoundNodID, 1) if (obj%femdomain2%boundary%DBoundNodID(i, 1) >= 1) then num_of_u_nod_x = num_of_u_nod_x + 1 obj%u_nod_x(num_of_u_nod_x) = obj%femdomain2%boundary%DBoundNodID(i, 1) obj%u_nod_dis_x(num_of_u_nod_x) = obj%femdomain2%boundary%DBoundVal(i, 1) end if end do if (size(obj%femdomain2%boundary%DBoundNodID, 2) == 1) then return end if ! for y do i = 1, size(obj%femdomain1%boundary%DBoundNodID, 1) if (obj%femdomain1%boundary%DBoundNodID(i, 2) >= 1) then num_of_u_nod_y = num_of_u_nod_y + 1 end if end do do i = 1, size(obj%femdomain2%boundary%DBoundNodID, 1) if (obj%femdomain2%boundary%DBoundNodID(i, 2) >= 1) then num_of_u_nod_y = num_of_u_nod_y + 1 end if end do if (allocated(obj%u_nod_y)) deallocate (obj%u_nod_y) if (allocated(obj%u_nod_dis_y)) deallocate (obj%u_nod_dis_y) allocate (obj%u_nod_y(num_of_u_nod_y)) allocate (obj%u_nod_dis_y(num_of_u_nod_y)) num_of_u_nod_y = 0 do i = 1, size(obj%femdomain1%boundary%DBoundNodID, 1) if (obj%femdomain1%boundary%DBoundNodID(i, 2) >= 1) then num_of_u_nod_y = num_of_u_nod_y + 1 obj%u_nod_y(num_of_u_nod_y) = obj%femdomain1%boundary%DBoundNodID(i, 2) obj%u_nod_dis_y(num_of_u_nod_y) = obj%femdomain1%boundary%DBoundVal(i, 2) end if end do do i = 1, size(obj%femdomain2%boundary%DBoundNodID, 1) if (obj%femdomain2%boundary%DBoundNodID(i, 2) >= 1) then num_of_u_nod_y = num_of_u_nod_y + 1 obj%u_nod_y(num_of_u_nod_y) = obj%femdomain2%boundary%DBoundNodID(i, 2) obj%u_nod_dis_y(num_of_u_nod_y) = obj%femdomain2%boundary%DBoundVal(i, 2) end if end do if (size(obj%femdomain2%boundary%DBoundNodID, 2) == 2) then return end if ! for z do i = 1, size(obj%femdomain1%boundary%DBoundNodID, 1) if (obj%femdomain1%boundary%DBoundNodID(i, 3) >= 1) then num_of_u_nod_z = num_of_u_nod_z + 1 end if end do do i = 1, size(obj%femdomain2%boundary%DBoundNodID, 1) if (obj%femdomain2%boundary%DBoundNodID(i, 3) >= 1) then num_of_u_nod_z = num_of_u_nod_z + 1 end if end do if (allocated(obj%u_nod_z)) deallocate (obj%u_nod_z) if (allocated(obj%u_nod_dis_z)) deallocate (obj%u_nod_dis_z) allocate (obj%u_nod_z(num_of_u_nod_z)) allocate (obj%u_nod_dis_z(num_of_u_nod_z)) num_of_u_nod_z = 0 do i = 1, size(obj%femdomain1%boundary%DBoundNodID, 1) if (obj%femdomain1%boundary%DBoundNodID(i, 3) >= 1) then num_of_u_nod_z = num_of_u_nod_z + 1 obj%u_nod_z(num_of_u_nod_z) = obj%femdomain1%boundary%DBoundNodID(i, 3) obj%u_nod_dis_z(num_of_u_nod_z) = obj%femdomain1%boundary%DBoundVal(i, 3) end if end do do i = 1, size(obj%femdomain2%boundary%DBoundNodID, 1) if (obj%femdomain2%boundary%DBoundNodID(i, 3) >= 1) then num_of_u_nod_z = num_of_u_nod_z + 1 obj%u_nod_z(num_of_u_nod_z) = obj%femdomain2%boundary%DBoundNodID(i, 3) obj%u_nod_dis_z(num_of_u_nod_z) = obj%femdomain2%boundary%DBoundVal(i, 3) end if end do end subroutine ! ######################################################### ! ######################################################### subroutine ls_add_duCM(obj) class(ContactMechanics_), intent(inout) :: obj integer(int32) :: i if (.not. allocated(obj%du_nod_dis_x)) then obj%du_nod_dis_x = obj%u_nod_dis_x end if if (.not. allocated(obj%du_nod_dis_y)) then obj%du_nod_dis_y = obj%u_nod_dis_y end if ! regacy subroutine for lodging simulator 2.5 ! this will be revised. do i = 1, size(obj%u_nod_x, 1) obj%u_nod_dis_x(i) = obj%du_nod_dis_x(i) end do do i = 1, size(obj%u_nod_y, 1) obj%u_nod_dis_y(i) = obj%du_nod_dis_y(i) end do if (allocated(obj%u_nod_z)) then do i = 1, size(obj%u_nod_z, 1) obj%u_nod_dis_z(i) = obj%du_nod_dis_z(i) end do end if end subroutine ! ######################################################### ! ######################################################### subroutine getTracBoundCM(obj, dim_num) class(ContactMechanics_), intent(inout) :: obj integer(int32), optional, intent(in) :: dim_num integer(int32) :: i, n, domain1_node_num, node_id, dimnum dimnum = input(default=size(obj%femdomain1%mesh%nodcoord, 2), option=dim_num) ! for x do i = 1, size(obj%femdomain1%boundary%NBoundNodID, 1) if (obj%femdomain1%boundary%NBoundNodID(i, 1) >= 1) then node_id = obj%femdomain1%boundary%NBoundNodID(i, 1) obj%fvec((node_id - 1)*dimnum + 1) = obj%femdomain1%boundary%NBoundVal(i, 1) end if end do domain1_node_num = size(obj%femdomain1%boundary%NBoundNodID, 1) do i = 1, size(obj%femdomain2%boundary%NBoundNodID, 1) if (obj%femdomain2%boundary%NBoundNodID(i, 1) >= 1) then node_id = obj%femdomain2%boundary%NBoundNodID(i, 1) obj%fvec((node_id - 1)*dimnum + 1 + domain1_node_num) & = obj%femdomain2%boundary%NBoundVal(i, 1) end if end do ! for y do i = 1, size(obj%femdomain1%boundary%NBoundNodID, 1) if (obj%femdomain1%boundary%NBoundNodID(i, 2) >= 1) then node_id = obj%femdomain1%boundary%NBoundNodID(i, 2) obj%fvec((node_id - 1)*dimnum + 2) = obj%femdomain1%boundary%NBoundVal(i, 2) end if end do domain1_node_num = size(obj%femdomain1%boundary%NBoundNodID, 1) do i = 1, size(obj%femdomain2%boundary%NBoundNodID, 1) if (obj%femdomain2%boundary%NBoundNodID(i, 2) >= 1) then node_id = obj%femdomain2%boundary%NBoundNodID(i, 2) obj%fvec((node_id - 1)*dimnum + 2 + domain1_node_num) & = obj%femdomain2%boundary%NBoundVal(i, 2) end if end do if (size(obj%femdomain1%mesh%nodcoord, 2) <= 2) then return end if ! for z do i = 1, size(obj%femdomain1%boundary%NBoundNodID, 1) if (obj%femdomain1%boundary%NBoundNodID(i, 3) >= 1) then node_id = obj%femdomain1%boundary%NBoundNodID(i, 3) obj%fvec((node_id - 1)*dimnum + 2) = obj%femdomain1%boundary%NBoundVal(i, 3) end if end do domain1_node_num = size(obj%femdomain1%boundary%NBoundNodID, 1) do i = 1, size(obj%femdomain2%boundary%NBoundNodID, 1) if (obj%femdomain2%boundary%NBoundNodID(i, 3) >= 1) then node_id = obj%femdomain2%boundary%NBoundNodID(i, 3) obj%fvec((node_id - 1)*dimnum + 2 + domain1_node_num) & = obj%femdomain2%boundary%NBoundVal(i, 3) end if end do end subroutine ! ######################################################### ! regacy !------------------------------- subroutine displace_nr(Kmat, rvec, u_nod_x, u_nod_dis_x, u_nod_y, u_nod_dis_y) integer, intent(in) :: u_nod_x(:), u_nod_y(:) real(8), intent(inout) :: Kmat(:, :), rvec(:) real(8), intent(in) :: u_nod_dis_x(:), u_nod_dis_y(:) integer i, k !Kmat�̕ do i = 1, size(u_nod_x) do k = 1, size(kmat, 1) kmat(k, 2*u_nod_x(i) - 1) = 0.0d0 kmat(2*u_nod_x(i) - 1, k) = 0.0d0 end do end do do i = 1, size(u_nod_y) do k = 1, size(kmat, 1) kmat(k, 2*u_nod_y(i)) = 0.0d0 kmat(2*u_nod_y(i), k) = 0.0d0 end do end do !�ψʋ��E��̓��� do i = 1, size(u_nod_x) kmat(2*u_nod_x(i) - 1, 2*u_nod_x(i) - 1) = 1.0d0 rvec(2*u_nod_x(i) - 1) = 0.0d0 end do do i = 1, size(u_nod_y) kmat(2*u_nod_y(i), 2*u_nod_y(i)) = 1.0d0 rvec(2*u_nod_y(i)) = 0.0d0 end do end subroutine displace_nr !================================================================================= subroutine displace(Kmat, Bvec, u_nod_x, u_nod_dis_x, u_nod_y, u_nod_dis_y) integer, intent(in) :: u_nod_x(:), u_nod_y(:) real(8), intent(inout) :: Kmat(:, :), Bvec(:) real(8), intent(in) :: u_nod_dis_x(:), u_nod_dis_y(:) integer i, k !�O�̓x�N�g���̕ do i = 1, size(u_nod_x, 1) do k = 1, size(kmat, 1) Bvec(k) = Bvec(k) - kmat(k, 2*u_nod_x(i) - 1)/kmat(2*u_nod_x(i) - 1, 2*u_nod_x(i) - 1)* & u_nod_dis_x(i) end do end do do i = 1, size(u_nod_y, 1) do k = 1, size(kmat, 1) Bvec(k) = Bvec(k) - kmat(k, 2*u_nod_y(i))/kmat(2*u_nod_y(i), 2*u_nod_y(i))* & u_nod_dis_y(i) end do end do !Kmat�̕ do i = 1, size(u_nod_x) do k = 1, size(kmat, 1) kmat(k, 2*u_nod_x(i) - 1) = 0.0d0 kmat(2*u_nod_x(i) - 1, k) = 0.0d0 end do end do do i = 1, size(u_nod_y) do k = 1, size(kmat, 1) kmat(k, 2*u_nod_y(i)) = 0.0d0 kmat(2*u_nod_y(i), k) = 0.0d0 end do end do !�ψʋ��E��̓��� do i = 1, size(u_nod_x) kmat(2*u_nod_x(i) - 1, 2*u_nod_x(i) - 1) = 1.0d0 bvec(2*u_nod_x(i) - 1) = u_nod_dis_x(i) end do do i = 1, size(u_nod_y) kmat(2*u_nod_y(i), 2*u_nod_y(i)) = 1.0d0 bvec(2*u_nod_y(i)) = u_nod_dis_y(i) end do end subroutine displace subroutine showPropertyCM(obj) class(ContactMechanics_), intent(in) :: Obj integer(int32) :: i if (allocated(obj%YoungModulus)) then do i = 1, size(obj%femdomains) print *, "Domain-ID ::", i, "YoungModulus ::", obj%YoungModulus(i), "PoissonRatio", obj%PoissonRatio(i), "Density", obj%Density(i) end do end if end subroutine subroutine setYoungModulus(obj, YoungModulus, DomainID) class(ContactMechanics_), intent(inout) :: Obj real(real64), intent(in) :: YoungModulus integer(int32), optional, intent(in) :: DomainID if (present(DomainID)) then obj%YoungModulus(DomainID) = YoungModulus else obj%YoungModulus(:) = YoungModulus end if end subroutine subroutine setPoissonRatio(obj, PoissonRatio, DomainID) class(ContactMechanics_), intent(inout) :: Obj real(real64), intent(in) :: PoissonRatio integer(int32), optional, intent(in) :: DomainID if (present(DomainID)) then obj%PoissonRatio(DomainID) = PoissonRatio else obj%PoissonRatio(:) = PoissonRatio end if end subroutine subroutine setDensity(obj, density, DomainID) class(ContactMechanics_), intent(inout) :: Obj real(real64), intent(in) :: density integer(int32), optional, intent(in) :: DomainID if (present(DomainID)) then obj%density(DomainID) = density else obj%density(:) = density end if end subroutine subroutine removeContactMechanics(obj) class(ContactMechanics_), intent(inout) :: obj ! Modern if (allocated(obj%FEMDomains)) deallocate (obj%FEMDomains) call obj%solver%init() if (allocated(obj%contactlist)) deallocate (obj%contactlist) if (allocated(obj%YoungModulus)) deallocate (obj%YoungModulus) if (allocated(obj%PoissonRatio)) deallocate (obj%PoissonRatio) if (allocated(obj%Density)) deallocate (obj%Density) call obj%YoungModulusList%destroy() call obj%PoissonRatioList%destroy() call obj%DensityList%destroy() obj%initialized = .false. obj%gravity(1:3) = [0.0d0, 0.0d0, -9.810d0] obj%penalty = 100000.0d0 ! >>>>>>>>>>>> Regacy >>>>>>>>>>>>>>>>> ! >>>>>>>>>>>> Regacy >>>>>>>>>>>>>>>>> ! >>>>>>>>>>>> Regacy >>>>>>>>>>>>>>>>> ! >>>>>>>>>>>> Regacy >>>>>>>>>>>>>>>>> ! if (associated(obj%FEMDomain1)) nullify (obj%FEMDomain1) if (associated(obj%FEMDomain2)) nullify (obj%FEMDomain2) if (associated(obj%FEMIface)) nullify (obj%FEMIface) ! common fields if (allocated(obj%NTSGap)) deallocate (obj%NTSGap) if (allocated(obj%NTSGzi)) deallocate (obj%NTSGzi) obj%penaltypara = dble(1.0e+5) obj%FrictionalCoefficient = 0.30d0 obj%Cohesion = 0.0d0 obj%Tolerance = dble(1.0e-10) ! for weak coupling contact analysis if (allocated(obj%Domain1Force)) deallocate (obj%Domain1Force) if (allocated(obj%Domain2Force)) deallocate (obj%Domain2Force) ! for strong coupling contact analysys if (allocated(obj%KcontactEBE)) deallocate (obj%KcontactEBE) if (allocated(obj%KcontactGlo)) deallocate (obj%KcontactGlo) if (allocated(obj%FcontactEBE)) deallocate (obj%FcontactEBE) if (allocated(obj%FcontactGlo)) deallocate (obj%FcontactGlo) if (allocated(obj%DispVecEBE)) deallocate (obj%DispVecEBE) if (allocated(obj%DispVecGlo)) deallocate (obj%DispVecGlo) if (allocated(obj%NTSvariables)) deallocate (obj%NTSvariables) if (allocated(obj%ContactMatPara)) deallocate (obj%ContactMatPara) if (allocated(obj%GloNodCoord)) deallocate (obj%GloNodCoord) ! boundary conditions for lodging simulator 2.5 if (allocated(obj%u_nod_x)) deallocate (obj%u_nod_x) if (allocated(obj%u_nod_y)) deallocate (obj%u_nod_y) if (allocated(obj%u_nod_z)) deallocate (obj%u_nod_z) if (allocated(obj%du_nod_dis_x)) deallocate (obj%du_nod_dis_x) if (allocated(obj%du_nod_dis_y)) deallocate (obj%du_nod_dis_y) if (allocated(obj%du_nod_dis_z)) deallocate (obj%du_nod_dis_z) if (allocated(obj%u_nod_dis_x)) deallocate (obj%u_nod_dis_x) if (allocated(obj%u_nod_dis_y)) deallocate (obj%u_nod_dis_y) if (allocated(obj%u_nod_dis_z)) deallocate (obj%u_nod_dis_z) if (allocated(obj%duvec)) deallocate (obj%duvec) if (allocated(obj%uvec)) deallocate (obj%uvec) if (allocated(obj%dfvec)) deallocate (obj%dfvec) if (allocated(obj%fvec)) deallocate (obj%fvec) if (allocated(obj%NTSMaterial)) deallocate (obj%NTSMaterial) if (allocated(obj%StickOrSlip)) deallocate (obj%StickOrSlip) obj%step = 0 obj%itr_contact = 0 obj%itr = 0 obj%BiCG_ItrMax = 10000 obj%NR_ItrMax = 100 obj%control = 1 ! 1:displacement-control, 2: traction-control obj%TimeStep = 100 ! from lodging-simulatiro 2.5 if (allocated(obj%nts_elem_nod)) deallocate (obj%nts_elem_nod) if (allocated(obj%old_nts_elem_nod)) deallocate (obj%old_nts_elem_nod) if (allocated(obj%surface_nod)) deallocate (obj%surface_nod) if (allocated(obj%sur_nod_inf)) deallocate (obj%sur_nod_inf) if (allocated(obj%nod_coord)) deallocate (obj%nod_coord) if (allocated(obj%old_nod_coord)) deallocate (obj%old_nod_coord) if (allocated(obj%elem_nod)) deallocate (obj%elem_nod) if (allocated(obj%nts_mat)) deallocate (obj%nts_mat) if (allocated(obj%sur_inf_mat)) deallocate (obj%sur_inf_mat) if (allocated(obj%contact_mat)) deallocate (obj%contact_mat) if (allocated(obj%contact_mat_para)) deallocate (obj%contact_mat_para) if (allocated(obj%active_nts)) deallocate (obj%active_nts) if (allocated(obj%k_contact)) deallocate (obj%k_contact) if (allocated(obj%fvec_contact)) deallocate (obj%fvec_contact) if (allocated(obj%nts_amo)) deallocate (obj%nts_amo) if (allocated(obj%stick_slip)) deallocate (obj%stick_slip) if (allocated(obj%old_stick_slip)) deallocate (obj%old_stick_slip) if (allocated(obj%old_nts_amo)) deallocate (obj%old_nts_amo) if (allocated(obj%kmat)) deallocate (obj%kmat) if (allocated(obj%gvec)) deallocate (obj%gvec) if (allocated(obj%rvec)) deallocate (obj%rvec) if (allocated(obj%K_total)) deallocate (obj%K_total) if (allocated(obj%initial_duvec)) deallocate (obj%initial_duvec) if (allocated(obj%dduvec)) deallocate (obj%dduvec) if (allocated(obj%dduvec_nr)) deallocate (obj%dduvec_nr) end subroutine subroutine solveCM(obj, Algorithm) class(ContactMechanics_), target, intent(inout) :: obj character(*), intent(in) :: Algorithm !integer(int32),intent(in) :: domainID !type(FEMDomain_),pointer :: a_domain call obj%solver%solve(Algorithm) !a_domain => obj%femdomains(domainID)%femdomainp !! update displacement obj%displacement = obj%solver%x ! !! udate traction force !obj%TractionForce = reshape(a_domain%TractionVector(& ! displacement=obj%displacement,& ! YoungModulus=obj%YoungModulus,& ! PoissonRatio=obj%PoissonRatio) ,a_domain%nn(),a_domain%nd() ) end subroutine ! ########################################################################### ! ########################################################################### function getDisplacementContactMechanics(obj, DomainID) result(displacement) class(ContactMechanics_), target, intent(in) :: obj integer(int32), optional, intent(in) :: DomainID integer(int32) :: i, DOF, From, To, total_nn real(real64), allocatable :: displacement(:, :) if (obj%initialized) then if (present(DomainID)) then DOF = obj%femdomains(1)%femdomainp%nd() i = DomainID if (i == 1) then From = 1 To = obj%solver%NumberOfNode(i)*DOF else From = obj%solver%NumberOfNode(i - 1)*DOF + 1 To = obj%solver%NumberOfNode(i)*DOF end if displacement = reshape(obj%solver%x(From:To), obj%femdomains(i)%femdomainp%nn(), DOF) else DOF = obj%femdomains(1)%femdomainp%nd() total_nn = 0 do i = 1, size(obj%femdomains) total_nn = total_nn + obj%femdomains(i)%femdomainp%nn() end do displacement = reshape(obj%solver%x, total_nn, DOF) end if else print *, "[ERROR] getDisplacementContactMechanics >> .not. obj%initialized" end if end function ! ########################################################################### ! ########################################################################### function getAllCoordinateContactMechanics(obj, DomainID) result(Coordinate) class(ContactMechanics_), target, intent(in) :: obj integer(int32), optional, intent(in) :: DomainID ! if present, return coordinates only for the domain integer(int32) :: i, DOF, From, To, total_nn, j real(real64), allocatable :: Coordinate(:, :) integer(int32), allocatable :: number_of_node(:) if (.not. allocated(obj%femdomains)) then print *, "ERROR >> getAllCoordinateContactMechanics .not. allocated(obj%femdomains)" stop end if if (present(DomainID)) then DOF = obj%femdomains(1)%femdomainp%nd() i = DomainID Coordinate = obj%femdomains(i)%femdomainp%mesh%nodcoord else DOF = obj%femdomains(1)%femdomainp%nd() number_of_node = zeros(size(obj%femdomains)) do i = 1, size(obj%femdomains) number_of_node(i) = obj%femdomains(i)%femdomainp%nn() end do total_nn = sum(number_of_node) allocate (Coordinate(total_nn, DOF)) !$OMP parallel do private(i) do j = 1, size(obj%femdomains) if (i == 1) then From = 1 To = number_of_node(i) else From = sum(number_of_node(1:i - 1)) + 1 To = sum(number_of_node(1:i)) end if Coordinate(From:To, 1:DOF) = obj%femdomains(i)%femdomainp%mesh%nodcoord(:, :) end do !$OMP end parallel do end if end function ! ########################################################################### ! ########################################################################### function getStressContactMechanics(obj, DomainID) result(Stress) class(ContactMechanics_), target, intent(in) :: obj integer(int32), intent(in) :: DomainID integer(int32) :: i, DOF, From, To, n, ngp, j real(real64), allocatable :: Stress(:, :, :, :), displacement(:, :) real(real64), allocatable :: YoungModulus(:), PoissonRatio(:) if (obj%initialized) then DOF = obj%solver%DOF n = obj%femdomains(DomainID)%femdomainp%ne() ngp = obj%femdomains(DomainID)%femdomainp%ngp() allocate (Stress(n, ngp, DOF, DOF)) displacement = obj%getDisplacement(DomainID) YoungModulus = obj%YoungModulusList%pages(DomainID)%realist PoissonRatio = obj%YoungModulusList%pages(DomainID)%realist !$OMP parallel do private(i,j) do i = 1, n do j = 1, ngp Stress(i, j, :, :) = obj%femdomains(DomainID)%femdomainp%StressMatrix( & ElementID=i & , GaussPoint=j & , disp=displacement & , E=YoungModulus(i) & , v=YoungModulus(i)) end do end do !$OMP end parallel do else print *, "[ERROR] getDisplacementContactMechanics >> .not. obj%initialized" end if end function ! ########################################################################### end module