Grzegorz Kowal
b60ebe52ae
We cannot resize the workspace with OpenMP. It should be allocated large enough from the beginning. If OpenMP is used, just notify about the workspace too small and return an error. Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
214 lines
6.0 KiB
Fortran
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) 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 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
|