amun-code/sources/workspace.F90
Grzegorz Kowal 9829505650 Update copyright year to 2022.
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
2022-02-02 09:51:41 -03:00

214 lines
6.0 KiB
Fortran

!!******************************************************************************
!!
!! 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) 2022 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 last thread number
!
integer, save :: nt = 0
! the flag indicating that the workspace is in use
!
logical, dimension(:), allocatable, save :: work_in_use
! 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;
! nthreads - the number of threads;
! status - the call status (0 for success, otherwise failure);
!
!===============================================================================
!
subroutine initialize_workspace(ninit, nthreads, status)
use helpers, only : print_message
implicit none
integer, intent(in) :: ninit, nthreads
integer, intent(out) :: status
character(len=*), parameter :: loc = 'WORKSPACE::initialize_workspace()'
!-------------------------------------------------------------------------------
!
status = 0
if (ninit <= 0) then
call print_message(loc, "The initial workspace size is wrong!")
status = 1
return
end if
nwork = ninit
nt = nthreads - 1
allocate(work_in_use(0:nt), work(nwork,0:nt), stat=status)
if (status /= 0) &
call print_message(loc, "Could not allocate the common workspace!")
work_in_use = .false.
!-------------------------------------------------------------------------------
!
end subroutine initialize_workspace
!
!===============================================================================
!
! subroutine FINALIZE_WORKSPACE:
! -----------------------------
!
! Arguments:
!
! status - the call status (0 for success, otherwise failure);
!
!===============================================================================
!
subroutine finalize_workspace(status)
use helpers, only : print_message
implicit none
integer, intent(out) :: status
character(len=*), parameter :: loc = 'WORKSPACE::finalize_workspace()'
!-------------------------------------------------------------------------------
!
status = 0
if (allocated(work)) then
deallocate(work_in_use, work, stat=status)
if (status /= 0) &
call print_message(loc, "Could not deallocate the common workspace!")
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 helpers, only : print_message
implicit none
integer, intent(in) :: nsize
integer, intent(out) :: status
character(len=*), parameter :: loc = 'WORKSPACE::resize_workspace()'
!-------------------------------------------------------------------------------
!
status = 0
#ifdef _OPENMP
if (nsize > nwork) then
call print_message(loc, "Workspace is too small!")
status = 1
end if
#else /* _OPENMP */
if (any(work_in_use)) then
call print_message(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,0:nt), stat=status)
if (status /= 0) then
call print_message(loc, "Could not allocate a new workspace!")
status = 1
else
nwork = nsize
end if
else
call print_message(loc, &
"Could not deallocate the previous workspace!")
nwork = 0
status = 1
end if
end if
end if
#endif /* _OPENMP */
!-------------------------------------------------------------------------------
!
end subroutine resize_workspace
!===============================================================================
!
end module