hecmw_mat_id.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_mat_id
  use hecmw_util
 
  private
 
  public:: hecmw_mat_id_set
  public:: hecmw_mat_id_get
  public:: hecmw_mat_id_clear
 
  type mat_mesh
    logical :: used = .false.
    type(hecmwST_matrix), pointer :: mat
    type(hecmwST_local_mesh), pointer :: mesh
  end type mat_mesh
 
  integer(kind=kint), parameter :: MAX_MM = 8
 
  type(mat_mesh), save :: mm(MAX_MM)
 
contains
 
  subroutine hecmw_mat_id_set(hecMAT, hecMESH, id)
    implicit none
    type(hecmwst_matrix), intent(in), target :: hecmat
    type(hecmwst_local_mesh), intent(in), target :: hecmesh
    integer(kind=kint), intent(out) :: id
    integer(kind=kint) :: i
    id = 0
    do i = 1, max_mm
      if (.not. mm(i)%used) then
        id = i
        exit
      endif
    end do
    if (id == 0) then
      stop 'ERROR: hecmw_mat_id_set: too many matrices set'
    endif
    mm(id)%mat => hecmat
    mm(id)%mesh => hecmesh
    mm(id)%used = .true.
  end subroutine hecmw_mat_id_set
 
  subroutine hecmw_mat_id_get(id, hecMAT, hecMESH)
    implicit none
    integer(kind=kint), intent(in) :: id
    type(hecmwst_matrix), pointer :: hecmat
    type(hecmwst_local_mesh), pointer :: hecmesh
    if (id <= 0 .or. max_mm < id) then
      stop 'ERROR: hecmw_mat_id_get: id out of range'
    endif
    if (.not. mm(id)%used) then
      stop 'ERROR: hecmw_mat_id_get: invalid id'
    endif
    hecmat => mm(id)%mat
    hecmesh => mm(id)%mesh
  end subroutine hecmw_mat_id_get
 
  subroutine hecmw_mat_id_clear(id)
    implicit none
    integer(kind=kint), intent(in) :: id
    if (.not. mm(id)%used) then
      stop 'ERROR: hecmw_mat_id_clear: invalid id'
    endif
    mm(id)%mat => null()
    mm(id)%mesh => null()
    mm(id)%used = .false.
  end subroutine hecmw_mat_id_clear
 
end module hecmw_mat_id