amun-code/sources/workspace.F90

!!******************************************************************************
!!
!!  This file is part of the AMUN source code, a program to perform
!!  Newtonian or relativistic magnetohydrodynamical simulations on uniform or
!!  adaptive mesh.
!!
!!  Copyright (C) 2021 Grzegorz Kowal <grzegorz@amuncode.org>
!!
!!  This program is free software: you can redistribute it and/or modify
!!  it under the terms of the GNU General Public License as published by
!!  the Free Software Foundation, either version 3 of the License, or
!!  (at your option) any later version.
!!
!!  This program is distributed in the hope that it will be useful,
!!  but WITHOUT ANY WARRANTY; without even the implied warranty of
!!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!!  GNU General Public License for more details.
!!
!!  You should have received a copy of the GNU General Public License
!!  along with this program.  If not, see <http://www.gnu.org/licenses/>.
!!
!!******************************************************************************
!!
!! module: WORKSPACE - handling the common workspace
!!
!!******************************************************************************
!
module workspace

  implicit none

! the size of the common workspace
!
  integer, save :: nwork = 0

! the flag indicating that the workspace is in use
!
  logical, save :: work_in_use = .false.

! the common workspace to use for local arrays
!
  real(kind=8), dimension(:), allocatable, target :: work

  private

  public :: initialize_workspace, finalize_workspace
  public :: resize_workspace
  public :: work, work_in_use

!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
  contains
!
!===============================================================================
!!
!!***  PUBLIC SUBROUTINES  *****************************************************
!!
!===============================================================================
!
!===============================================================================
!
! subroutine INITIALIZE_WORKSPACE:
! -------------------------------
!
!   Arguments:
!
!     ninit  - the initial workspace size;
!     status - the call status (0 for success, otherwise failure);
!
!===============================================================================
!
  subroutine initialize_workspace(ninit, status)

    use iso_fortran_env, only : error_unit

    implicit none

    integer, intent(in)  :: ninit
    integer, intent(out) :: status

    character(len=*), parameter :: loc = 'WORKSPACE::initialize_workspace()'

!-------------------------------------------------------------------------------
!
    status = 0

    if (ninit <= 0) then
      write(error_unit,"('[',a,']: ',a)") trim(loc),                           &
                       "The initial workspace size is wrong!"
      status = 1
      return
    end if

    nwork = ninit

    allocate(work(nwork), stat=status)

    if (status /= 0) then
      write(error_unit,"('[',a,']: ',a)") trim(loc),                           &
                       "Could not allocate the common workspace!"
    end if

!-------------------------------------------------------------------------------
!
  end subroutine initialize_workspace
!
!===============================================================================
!
! subroutine FINALIZE_WORKSPACE:
! -----------------------------
!
!   Arguments:
!
!     status - the call status (0 for success, otherwise failure);
!
!===============================================================================
!
  subroutine finalize_workspace(status)

    use iso_fortran_env, only : error_unit

    implicit none

    integer, intent(out) :: status

    character(len=*), parameter :: loc = 'WORKSPACE::finalize_workspace()'

!-------------------------------------------------------------------------------
!
    status = 0

    if (allocated(work)) then
      deallocate(work, stat=status)

      if (status /= 0) then
        write(error_unit,"('[',a,']: ',a)") trim(loc),                         &
                         "Could not deallocate the common workspace!"
      end if

    end if

!-------------------------------------------------------------------------------
!
  end subroutine finalize_workspace
!
!===============================================================================
!
! subroutine RESIZE_WORKSPACE:
! ---------------------------
!
!   Arguments:
!
!     status - the call status (0 for success, otherwise failure);
!
!===============================================================================
!
  subroutine resize_workspace(nsize, status)

    use iso_fortran_env, only : error_unit

    implicit none

    integer, intent(in)  :: nsize
    integer, intent(out) :: status

    character(len=*), parameter :: loc = 'WORKSPACE::resize_workspace()'

!-------------------------------------------------------------------------------
!
    status = 0

    if (work_in_use) then
      write(error_unit,"('[',a,']: ',a,3i4,a)") trim(loc),                     &
                       "Could not resize the workspace. " //                   &
                       "It is being used right now!"
      status = 1
    else
      if (nsize > nwork) then
        deallocate(work, stat=status)
        if (status == 0) then
          allocate(work(nsize), stat=status)
          if (status /= 0) then
            write(error_unit,"('[',a,']: ',a)") trim(loc),                     &
                             "Could not allocate a new workspace!"
            status = 1
          else
            nwork = nsize
          end if
        else
          write(error_unit,"('[',a,']: ',a)") trim(loc),                       &
                           "Could not deallocate the previous workspace!"
          nwork  = 0
          status = 1
        end if
      end if
    end if

!-------------------------------------------------------------------------------
!
  end subroutine resize_workspace

!===============================================================================
!
end module