solve_LINEQ_direct_serial_lag.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
! Copyright (c) 2019 FrontISTR Commons
! This software is released under the MIT License, see LICENSE.txt
!-------------------------------------------------------------------------------
module m_solve_lineq_direct_serial_lag
 
  use hecmw_util
  use m_set_arrays_directsolver_contact
  use hecmw_solver_direct_serial_lag
  use hecmw_matrix_dump
  use hecmw_matrix_ass
  use hecmw_matrix_misc
  use hecmw_ebc_defer
 
contains
 
  subroutine solve_lineq_serial_lag_hecmw_init(hecMAT,hecLagMAT,is_sym)
    implicit none
    type (hecmwST_matrix)                    :: hecMAT
    type (hecmwST_matrix_lagrange)           :: hecLagMAT
    logical                                  :: is_sym
 
    call set_pointersandindices_directsolver(hecmat,heclagmat,is_sym)
 
  end subroutine solve_lineq_serial_lag_hecmw_init
 
 
  subroutine solve_lineq_serial_lag_hecmw(hecMESH,hecMAT,hecLagMAT,hecEBC)
    implicit none
    type (hecmwST_local_mesh)                :: hecMESH
    type (hecmwST_matrix)                    :: hecMAT
    type (hecmwST_matrix_lagrange)           :: hecLagMAT
    type (hecmwST_ebc)                       :: hecEBC
    integer (kind=4)                         :: ntdf, ilag_sta
    integer (kind=4)                         :: numNon0
    integer (kind=4)                         :: ierr, nprocs, myrank
 
    real(kind=8), allocatable               :: b(:)           
    integer(kind=kint) :: mpc_method
 
    mpc_method = hecmw_mat_get_mpc_method(hecmat)
    if (mpc_method /= 1 .and. mpc_method /= 3) then
      mpc_method = 1
      call hecmw_mat_set_mpc_method(hecmat,mpc_method)
    endif
    if (mpc_method /= 1) then
      write(*,*) 'ERROR: MPCMETHOD other than penalty is not available for DIRECT solver', &
          ' in contact analysis without elimination'
      stop
    endif
    call hecmw_mat_ass_equation(hecmesh, hecmat)
    call hecmw_mat_ass_equation_rhs(hecmesh, hecmat)
    call hecmw_ebc_apply(hecmesh, hecmat, hecebc)
 
    call hecmw_mat_dump(hecmat, hecmesh)
 
    call set_values_directsolver(hecmat,heclagmat)
 
    ntdf = hecmat%NP*hecmat%NDOF + heclagmat%num_lagrange
    ilag_sta = hecmat%NP*hecmat%NDOF + 1
    numnon0 = hecmat%NPU*hecmat%NDOF**2+hecmat%NP*hecmat%NDOF*(ntdf+1)/2 &
      + (heclagmat%numU_lagrange)*hecmat%NDOF+heclagmat%num_lagrange
 
    allocate(b(size(hecmat%B)))
    b = hecmat%B
 
    call hecmw_solve_direct_serial_lag(ntdf, ilag_sta, numnon0, pointers, indices, values, b)
 
    hecmat%X = b
 
    deallocate(b)
 
    call hecmw_mat_dump_solution(hecmat)
 
  end subroutine solve_lineq_serial_lag_hecmw
 
 
end module m_solve_lineq_direct_serial_lag