!!****************************************************************************** !! !! 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 !! !! 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 . !! !!****************************************************************************** !! !! module: WORKSPACE - handling the common workspace !! !!****************************************************************************** ! module workspace #ifdef PROFILE use timers, only : set_timer, start_timer, stop_timer #endif /* PROFILE */ implicit none #ifdef PROFILE integer, save :: imi, imf, imr #endif /* PROFILE */ ! 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: ! ! status - the call status (0 for success, otherwise failure); ! !=============================================================================== ! subroutine initialize_workspace(status) use coordinates , only : nn => bcells use equations , only : nf use iso_fortran_env, only : error_unit use parameters , only : get_parameter implicit none integer, intent(out) :: status character(len=*), parameter :: loc = 'WORKSPACE::initialize_workspace()' !------------------------------------------------------------------------------- ! #ifdef PROFILE call set_timer('workspace:: initialization', imi) call set_timer('workspace:: finalization' , imf) call set_timer('workspace:: resize' , imr) call start_timer(imi) #endif /* PROFILE */ status = 0 ! get the requested size of the workspace ! call get_parameter('workspace_size', nwork) nwork = max(nwork, 3 * NDIMS * nf * nn**NDIMS) ! allocate the workspace ! allocate(work(nwork), stat=status) if (status /= 0) then write(error_unit,"('[',a,']: ',a)") trim(loc), & "Could not allocate the common workspace!" end if #ifdef PROFILE call stop_timer(imi) #endif /* PROFILE */ !------------------------------------------------------------------------------- ! 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()' !------------------------------------------------------------------------------- ! #ifdef PROFILE call start_timer(imf) #endif /* PROFILE */ 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 #ifdef PROFILE call stop_timer(imf) #endif /* PROFILE */ !------------------------------------------------------------------------------- ! 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()' !------------------------------------------------------------------------------- ! #ifdef PROFILE call start_timer(imr) #endif /* PROFILE */ 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 #ifdef PROFILE call stop_timer(imr) #endif /* PROFILE */ !------------------------------------------------------------------------------- ! end subroutine resize_workspace !=============================================================================== ! end module