hecmw_solver_las.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 hecmw_solver_las
  use hecmw_util
  use hecmw_solver_las_11
  use hecmw_solver_las_22
  use hecmw_solver_las_33
  use hecmw_solver_las_44
  use hecmw_solver_las_66
  use hecmw_solver_las_nn
 
  implicit none
 
  private
 
  public :: hecmw_matvec
  public :: hecmw_matvec_set_async
  public :: hecmw_matvec_unset_async
  public :: hecmw_matresid
  public :: hecmw_rel_resid_l2
  public :: hecmw_tvec
  public :: hecmw_ttvec
  public :: hecmw_ttmattvec
  public :: hecmw_matvec_clear_timer
  public :: hecmw_matvec_get_timer
  public :: hecmw_mat_diag_sr
  public :: hecmw_mat_add
  public :: hecmw_mat_multiple
 
  real(kind=kreal), save :: time_ax = 0.d0
 
contains
 
  !C
  !C***
  !C*** hecmw_matvec
  !C***
  !C
  subroutine hecmw_matvec (hecMESH, hecMAT, X, Y, COMMtime)
    use hecmw_util
 
    implicit none
    type (hecmwst_local_mesh), intent(in) :: hecmesh
    type (hecmwst_matrix), intent(in), target :: hecmat
    real(kind=kreal), intent(in) :: x(:)
    real(kind=kreal), intent(out) :: y(:)
    real(kind=kreal), intent(inout), optional :: commtime
    select case(hecmat%NDOF)
      case (3)
        call hecmw_matvec_33(hecmesh, hecmat, x, y, time_ax, commtime)
      case (4)
        call hecmw_matvec_44(hecmesh, hecmat, x, y, time_ax,commtime)
      case (6)
        call hecmw_matvec_66(hecmesh, hecmat, x, y, time_ax,commtime)
      case (1)
        call hecmw_matvec_11(hecmesh, hecmat, x, y, time_ax, commtime)
      case (2)
        call hecmw_matvec_22(hecmesh, hecmat, x, y, time_ax, commtime)
      case default
        call hecmw_matvec_nn(hecmesh, hecmat, x, y, time_ax, commtime)
    end select
 
  end subroutine hecmw_matvec
 
  !C
  !C***
  !C*** hecmw_matvec_set_async
  !C***
  !C
  subroutine hecmw_matvec_set_async (hecMAT)
    use hecmw_util
    implicit none
    type (hecmwst_matrix), intent(in) :: hecmat
 
  end subroutine hecmw_matvec_set_async
 
  !C
  !C***
  !C*** hecmw_matvec_unset_async
  !C***
  !C
  subroutine hecmw_matvec_unset_async
    implicit none
  end subroutine hecmw_matvec_unset_async
 
  !C
  !C***
  !C*** hecmw_matresid
  !C***
  !C
  subroutine hecmw_matresid (hecMESH, hecMAT, X, B, R, COMMtime)
    use hecmw_util
    implicit none
    type (hecmwst_local_mesh), intent(in) :: hecmesh
    type (hecmwst_matrix), intent(in)     :: hecmat
    real(kind=kreal), intent(in) :: x(:), b(:)
    real(kind=kreal), intent(out) :: r(:)
    real(kind=kreal), intent(inout), optional :: commtime
 
    select case(hecmat%NDOF)
      case (3)
        call hecmw_matresid_33(hecmesh, hecmat, x, b, r, time_ax, commtime)
      case (4)
        call hecmw_matresid_44(hecmesh, hecmat, x, b, r, time_ax, commtime)
      case (6)
        call hecmw_matresid_66(hecmesh, hecmat, x, b, r, time_ax, commtime)
      case (1)
        call hecmw_matresid_11(hecmesh, hecmat, x, b, r, time_ax, commtime)
      case (2)
        call hecmw_matresid_22(hecmesh, hecmat, x, b, r, time_ax, commtime)
      case default
        call hecmw_matresid_nn(hecmesh, hecmat, x, b, r, time_ax, commtime)
    end select
  end subroutine hecmw_matresid
 
  !C
  !C***
  !C*** hecmw_rel_resid_L2
  !C***
  !C
  function hecmw_rel_resid_l2 (hecMESH, hecMAT, COMMtime)
    use hecmw_util
    implicit none
    real(kind=kreal) :: hecmw_rel_resid_l2
    type ( hecmwst_local_mesh ), intent(in) :: hecmesh
    type ( hecmwst_matrix     ), intent(in) :: hecmat
    real(kind=kreal), intent(inout), optional :: commtime
 
    select case(hecmat%NDOF)
      case (3)
        hecmw_rel_resid_l2 = hecmw_rel_resid_l2_33(hecmesh, hecmat, time_ax, commtime)
      case (4)
        hecmw_rel_resid_l2 = hecmw_rel_resid_l2_44(hecmesh, hecmat, time_ax, commtime)
      case (6)
        hecmw_rel_resid_l2 = hecmw_rel_resid_l2_66(hecmesh, hecmat, time_ax, commtime)
      case (1)
        hecmw_rel_resid_l2 = hecmw_rel_resid_l2_11(hecmesh, hecmat, time_ax, commtime)
      case (2)
        hecmw_rel_resid_l2 = hecmw_rel_resid_l2_22(hecmesh, hecmat, time_ax, commtime)
      case default
        hecmw_rel_resid_l2 = hecmw_rel_resid_l2_nn(hecmesh, hecmat, time_ax, commtime)
    end select
  end function hecmw_rel_resid_l2
 
  !C
  !C***
  !C*** hecmw_Tvec
  !C***
  !C
  subroutine hecmw_tvec (hecMESH, ndof, X, Y, COMMtime)
    use hecmw_util
    use hecmw_solver_las_33
    use hecmw_solver_las_nn
 
    implicit none
    type (hecmwst_local_mesh), intent(in) :: hecmesh
    integer(kind=kint), intent(in) :: ndof
    real(kind=kreal), intent(in) :: x(:)
    real(kind=kreal), intent(out) :: y(:)
    real(kind=kreal), intent(inout) :: commtime
 
    select case(ndof)
      case (3)
        call hecmw_tvec_33(hecmesh, x, y, commtime)
      case default
        call hecmw_tvec_nn(hecmesh, ndof, x, y, commtime)
    end select
 
  end subroutine hecmw_tvec
 
  !C
  !C***
  !C*** hecmw_Ttvec
  !C***
  !C
  subroutine hecmw_ttvec (hecMESH, ndof, X, Y, COMMtime)
    use hecmw_util
    use hecmw_solver_las_33
    use hecmw_solver_las_nn
    implicit none
    type (hecmwst_local_mesh), intent(in) :: hecmesh
    integer(kind=kint), intent(in) :: ndof
    real(kind=kreal), intent(in) :: x(:)
    real(kind=kreal), intent(out) :: y(:)
    real(kind=kreal), intent(inout) :: commtime
 
    select case(ndof)
      case (3)
        call hecmw_ttvec_33(hecmesh, x, y, commtime)
      case default
        call hecmw_ttvec_nn(hecmesh, ndof, x, y, commtime)
    end select
 
  end subroutine hecmw_ttvec
 
  !C
  !C***
  !C*** hecmw_TtmatTvec
  !C***
  !C
  subroutine hecmw_ttmattvec (hecMESH, hecMAT, X, Y, W, COMMtime)
    use hecmw_util
    implicit none
    type (hecmwst_local_mesh), intent(in) :: hecmesh
    type (hecmwst_matrix), intent(in)     :: hecmat
    real(kind=kreal), intent(in) :: x(:)
    real(kind=kreal), intent(out) :: y(:), w(:)
    real(kind=kreal), intent(inout) :: commtime
 
    !    call hecmw_Tvec(hecMESH, X, Y, COMMtime)
    !    call hecmw_matvec(hecMESH, hecMAT, Y, W, COMMtime)
    !    call hecmw_Ttvec(hecMESH, W, Y, COMMtime)
    select case(hecmesh%n_dof)
      case (3)
        call hecmw_ttmattvec_33 (hecmesh, hecmat, x, y, w, time_ax, commtime)
      case default
        call hecmw_ttmattvec_nn (hecmesh, hecmat, x, y, w, time_ax, commtime)
    end select
 
  end subroutine hecmw_ttmattvec
 
  !C
  !C***
  !C*** hecmw_matvec_clear_timer
  !C***
  !C
  subroutine hecmw_matvec_clear_timer
    implicit none
    time_ax = 0.d0
  end subroutine hecmw_matvec_clear_timer
 
  !C
  !C***
  !C*** hecmw_matvec_get_timer
  !C***
  !C
  function hecmw_matvec_get_timer()
    implicit none
    real(kind=kreal) :: hecmw_matvec_get_timer
    hecmw_matvec_get_timer = time_ax
  end function hecmw_matvec_get_timer
 
  !C
  !C***
  !C*** hecmw_mat_diag_sr
  !C***
  !C
  subroutine hecmw_mat_diag_sr(hecMESH, hecMAT, COMMtime)
    use hecmw_util
    use hecmw_solver_las_33
    use hecmw_solver_las_nn
    implicit none
    type (hecmwst_local_mesh), intent(in) :: hecmesh
    type (hecmwst_matrix), intent(inout), target :: hecmat
    real(kind=kreal), intent(inout), optional :: commtime
 
    select case(hecmesh%n_dof)
      case (3)
        call hecmw_mat_diag_sr_33(hecmesh, hecmat, commtime)
      case default
        call hecmw_mat_diag_sr_nn(hecmesh, hecmat, commtime)
    end select
 
  end subroutine hecmw_mat_diag_sr
 
  subroutine hecmw_mat_add(hecMAT1, hecMAT2, hecMAT3)
    use hecmw_util
    use hecmw_solver_las_33
    use hecmw_solver_las_nn
    implicit none
    type (hecmwst_matrix), intent(inout), target :: hecmat1, hecmat2, hecmat3
 
    call hecmw_mat_add_nn(hecmat1, hecmat2, hecmat3)
  end subroutine hecmw_mat_add
 
  subroutine hecmw_mat_multiple(hecMAT, alpha)
    use hecmw_util
    use hecmw_solver_las_33
    use hecmw_solver_las_nn
    implicit none
    type (hecmwst_matrix), intent(inout), target :: hecmat
    real(kind=kreal), intent(in) :: alpha
 
    call hecmw_mat_multiple_nn(hecmat, alpha)
  end subroutine hecmw_mat_multiple
end module hecmw_solver_las