PLAG_ModReallocateMemory.F90

Go to the documentation of this file.

! *********************************************************************
! * Rocstar Simulation Suite                                          *
! * Copyright@2015, Illinois Rocstar LLC. All rights reserved.        *
! *                                                                   *
! * Illinois Rocstar LLC                                              *
! * Champaign, IL                                                     *
! * www.illinoisrocstar.com                                           *
! * sales@illinoisrocstar.com                                         *
! *                                                                   *
! * License: See LICENSE file in top level of distribution package or *
! * http://opensource.org/licenses/NCSA                               *
! *********************************************************************
! *********************************************************************
! * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,   *
! * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES   *
! * OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND          *
! * NONINFRINGEMENT.  IN NO EVENT SHALL THE CONTRIBUTORS OR           *
! * COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER       *
! * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,   *
! * Arising FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE    *
! * USE OR OTHER DEALINGS WITH THE SOFTWARE.                          *
! *********************************************************************
!*******************************************************************************
!
! Purpose: Suite of routines to dynamically reallocate memory.
!
! Description: None.
!
! Notes: None.
!
!*******************************************************************************
!
! $Id: PLAG_ModReallocateMemory.F90,v 1.9 2008/12/06 08:44:34 mtcampbe Exp $
!
! Copyright: (c) 2004 by the University of Illinois
!
!*******************************************************************************

MODULE plag_modreallocatememory

  USE moddatatypes
  USE moderror
  USE modparameters
  USE modglobal,     ONLY: t_global
  USE moddatastruct, ONLY: t_region
  USE modpartlag,    ONLY: t_plag
  USE modmpi 
  USE plag_modparameters
  USE modinterfaceslagrangian, ONLY: plag_inrt_allocmemtstep,   &
                                     plag_inrt_deallocmemtstep, &  
                                     plag_rflu_allocmemsol,     &
                                     plag_rflu_allocmemtstep,   &                                    
                                     plag_rflu_deallocmemsol,   &
                                     plag_rflu_deallocmemtstep
 
  USE plag_moddimensions,      ONLY: plag_setmaxdimensions

  IMPLICIT NONE

  REAL(RFREAL), PARAMETER :: PLAG_EXPAND_RATIO =   0.90_RFREAL
  REAL(RFREAL), PARAMETER :: PLAG_SHRINK_RATIO =   0.25_RFREAL

  PRIVATE
  PUBLIC :: plag_reallocmemwrapper

! ******************************************************************************
! Declarations and definitions
! ******************************************************************************  
   
  CHARACTER(CHRLEN) :: RCSIdentString = & 
    '$RCSfile: PLAG_ModReallocateMemory.F90,v $ $Revision: 1.9 $'        
             
! ******************************************************************************
! Routines
! ******************************************************************************

  CONTAINS




! ******************************************************************************
!
! Purpose: Copy dimensions for Lagrangian particle solution.
!
! Description: None.
!
! Input:
!   global       Global pointer
!   pPlag        Plag pointer
!   pPlagCopy    Plag pointer to copy
!
! Output: None.
!
! Notes: Memory dimensions operation is performed at the last RK-stage following
!        particle relocation, communication and injection.
!
! ******************************************************************************

SUBROUTINE plag_copydimensions(global,pPlag,pPlagCopy)

  IMPLICIT NONE

! ******************************************************************************
! Definitions and declarations
! ******************************************************************************

! ==============================================================================
! Arguments
! ==============================================================================

  TYPE(t_global), POINTER :: global
  TYPE(t_plag),   POINTER :: pplag,pplagcopy

! ==============================================================================
! Locals
! ==============================================================================

  CHARACTER(CHRLEN) :: rcsidentstring

! ******************************************************************************
! Start
! ******************************************************************************

  rcsidentstring = '$RCSfile: PLAG_ModReallocateMemory.F90,v $ $Revision: 1.9 $'

  CALL registerfunction(global,'PLAG_CopyDimensions',&
  'PLAG_ModReallocateMemory.F90')

! *****************************************************************************
! Copy particle dimensions from original datastructure to temporary datastructure
! *****************************************************************************

  pplagcopy%nAiv = pplag%nAiv
  pplagcopy%nArv = pplag%nArv
  pplagcopy%nCv  = pplag%nCv
  pplagcopy%nDv  = pplag%nDv
  pplagcopy%nTv  = pplag%nTv
  pplagcopy%nPcls = pplag%nPcls

! ******************************************************************************
! End
! ******************************************************************************

  CALL deregisterfunction(global)

END SUBROUTINE plag_copydimensions



! ******************************************************************************
!
! Purpose: Copy memory for Lagrangian particle solution.
!
! Description: None.
!
! Input:
!   global       Global pointer
!   pPlag        Plag pointer
!   pPlagCopy    Plag pointer to copy
!
! Output: None.
!
! Notes: 
!   1.  Memory copy operation is performed at the last RK-stage following
!       particle relocation, communication and injection.
!   2.  Copying of dv and tv data is not required given the memory swap
!       occurs at the last RK stage; but it is kept for consistency.
!
! ******************************************************************************

SUBROUTINE plag_copymemory(global,pPlag,pPlagCopy)

  IMPLICIT NONE

! ******************************************************************************
! Definitions and declarations
! ******************************************************************************

! ==============================================================================
! Arguments
! ==============================================================================

  TYPE(t_global), POINTER :: global
  TYPE(t_plag),   POINTER :: pplag,pplagcopy

! ==============================================================================
! Locals
! ==============================================================================

  CHARACTER(CHRLEN) :: rcsidentstring
  INTEGER :: ipcl,ivar,naiv,narv,ncont,ncv,ndv,npcls,ntv

! ******************************************************************************
! Start
! ******************************************************************************

  rcsidentstring = '$RCSfile: PLAG_ModReallocateMemory.F90,v $ $Revision: 1.9 $'

  CALL registerfunction(global,'PLAG_CopyMemory',&
  'PLAG_ModReallocateMemory.F90')

! ******************************************************************************
! Set variables 
! ******************************************************************************

  npcls = pplag%nPcls

  naiv = pplag%nAiv
  narv = pplag%nArv

  ncv  = pplag%nCv
  ndv  = pplag%nDv
  ntv  = pplag%nTv 

! *****************************************************************************
! Copy particle data from original datastructure to temporary datastructure
! *****************************************************************************

  DO ipcl = 1,npcls
    DO ivar = 1,ncv
      pplagcopy%cv(ivar,ipcl)     = pplag%cv(ivar,ipcl)
      pplagcopy%cvOld(ivar,ipcl)  = pplag%cvOld(ivar,ipcl)
      pplagcopy%rhsSum(ivar,ipcl) = pplag%rhsSum(ivar,ipcl)
    END DO ! iVar
    
    DO ivar = 1,ndv
      pplagcopy%dv(ivar,ipcl) = pplag%dv(ivar,ipcl)
    END DO ! iVar
   
    DO ivar = 1,ntv
      pplagcopy%tv(ivar,ipcl) = pplag%tv(ivar,ipcl)
    END DO ! iVar
    
    DO ivar = 1,naiv
      pplagcopy%aiv(ivar,ipcl)    = pplag%aiv(ivar,ipcl)
      pplagcopy%aivOld(ivar,ipcl) = pplag%aivOld(ivar,ipcl)
    END DO ! iVar
    
    DO ivar = 1,narv   
      pplagcopy%arv(ivar,ipcl)    = pplag%arv(ivar,ipcl)
      pplagcopy%arvOld(ivar,ipcl) = pplag%arvOld(ivar,ipcl)
    END DO ! iVar
  END DO ! iPcl

! ******************************************************************************
! End
! ******************************************************************************

  CALL deregisterfunction(global)

END SUBROUTINE plag_copymemory








! ******************************************************************************
!
! Purpose: Decide to reallocate memory for particle datastructure.
!
! Description: None.
!
! Input:
!   pRegion        Region pointer
! 
! Output: 
!  pDecideReallocMem Logical flag for decision
!
! Notes: None.
!
! ******************************************************************************

SUBROUTINE plag_decidereallocmem(pRegion,pDecideReallocMem)

  IMPLICIT NONE

! ******************************************************************************
! Definitions and declarations
! ******************************************************************************

! ==============================================================================
! Arguments
! ==============================================================================

  TYPE(t_region), POINTER :: pregion
  LOGICAL, INTENT(INOUT)  :: pdecidereallocmem

! ==============================================================================
! Locals
! ==============================================================================

  CHARACTER(CHRLEN) :: rcsidentstring

  INTEGER :: errorflag,npcls,npclsmax
 
  REAL(RFREAL) :: pclratio

  TYPE(t_global), POINTER :: global 

! ******************************************************************************
! Start
! ******************************************************************************
 
  rcsidentstring = '$RCSfile: PLAG_ModReallocateMemory.F90,v $ $Revision: 1.9 $'

  global => pregion%global

  CALL registerfunction(global,'PLAG_DecideReallocMem',&
  'PLAG_ModReallocateMemory.F90')

! ******************************************************************************
! Set variables 
! ******************************************************************************

  npclsmax    = pregion%plag%nPclsMax
  npcls       = pregion%plag%nPcls

  pdecidereallocmem = .false.

! ******************************************************************************
! Set logical flag depending on ratio of nPcls to maximum size of datastructure
! ******************************************************************************

  pclratio = REAL(npcls,kind=rfreal)/REAL(npclsmax,kind=rfreal)

  IF ( pclratio >= plag_expand_ratio   .OR.  &
       ( pclratio <= plag_shrink_ratio .AND. & 
         npclsmax > npcls_tot_min )          ) pdecidereallocmem = .true.

! ******************************************************************************
! End
! ******************************************************************************

  CALL deregisterfunction(global)

END SUBROUTINE plag_decidereallocmem







! ******************************************************************************
!
! Purpose: Realllocate memory for Lagrangian particle datastructure.
!
! Description: None.
!
! Input:
!   pRegion        Region pointer
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************

SUBROUTINE plag_reallocmem(pRegion)

  IMPLICIT NONE

! ******************************************************************************
! Definitions and declarations
! ******************************************************************************

! ==============================================================================
! Arguments
! ==============================================================================

  TYPE(t_region), POINTER :: pregion

! ==============================================================================
! Locals
! ==============================================================================

  CHARACTER(CHRLEN) :: rcsidentstring

  INTEGER :: errorflag,npcls,nplagpclstot

  TYPE(t_global), POINTER :: global 
  TYPE(t_plag),   POINTER :: pplag,pplagtemp

! ******************************************************************************
! Start
! ******************************************************************************
 
  rcsidentstring = '$RCSfile: PLAG_ModReallocateMemory.F90,v $ $Revision: 1.9 $'

  global => pregion%global

  CALL registerfunction(global,'PLAG_ReallocMem',&
  'PLAG_ModReallocateMemory.F90')

! ******************************************************************************
! Set pointers and variables 
! ******************************************************************************

  pplag => pregion%plag
  pplagtemp => pregion%plagTemp

! ******************************************************************************
! Copy particle dimensions from original datastructure 
!   to temporary datastructure
! ******************************************************************************

  CALL plag_copydimensions( global,pplag,pplagtemp )

! ******************************************************************************
! Allocate memory for intermediate datastructure
! ******************************************************************************

  CALL plag_rflu_allocmemsol( pregion,pplagtemp )
  CALL plag_rflu_allocmemtstep( pregion,pplagtemp )

! *****************************************************************************
! Copy particle data from original datastructure to temporary datastructure
! *****************************************************************************

  CALL plag_copymemory( global,pplag,pplagtemp )

! ******************************************************************************
! Destroy memory of original datastructure
! ******************************************************************************

  CALL plag_rflu_deallocmemsol( pregion,pplag )
  CALL plag_rflu_deallocmemtstep( pregion,pplag )
  CALL plag_inrt_deallocmemtstep( pregion,pplag )

! ******************************************************************************
! Allocate memory for original datastructure with updated maximum value
! ******************************************************************************

  CALL plag_rflu_allocmemsol( pregion,pplag )
  CALL plag_rflu_allocmemtstep( pregion,pplag )
  CALL plag_inrt_allocmemtstep( pregion,pplag )

! *****************************************************************************
! Copy particle data from temporary datastructure to original datastructre
! *****************************************************************************

  CALL plag_copymemory( global,pplagtemp,pplag )

! ******************************************************************************
! Destroy memory of temporary datastructure
! ******************************************************************************

  CALL plag_rflu_deallocmemsol( pregion,pplagtemp )
  CALL plag_rflu_deallocmemtstep( pregion,pplagtemp )

! ******************************************************************************
! End
! ******************************************************************************

  CALL deregisterfunction(global)

END SUBROUTINE plag_reallocmem







! ******************************************************************************
!
! Purpose: Wrapper routine to realllocate memory for Lagrangian 
!particle datastructure.
!
! Description: None.
!
! Input:
!   pRegion        Region pointer
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************

SUBROUTINE plag_reallocmemwrapper(pRegion)

  IMPLICIT NONE

! ******************************************************************************
! Definitions and declarations
! ******************************************************************************

! ==============================================================================
! Arguments
! ==============================================================================

  TYPE(t_region), POINTER :: pregion

! ==============================================================================
! Locals
! ==============================================================================

  CHARACTER(CHRLEN) :: rcsidentstring

  LOGICAL :: pdecidereallocmem

  TYPE(t_global), POINTER :: global 
  TYPE(t_plag),   POINTER :: pplag

! ******************************************************************************
! Start
! ******************************************************************************
 
  rcsidentstring = '$RCSfile: PLAG_ModReallocateMemory.F90,v $ $Revision: 1.9 $'

  global => pregion%global

  CALL registerfunction(global,'PLAG_ReallocMem',&
  'PLAG_ModReallocateMemory.F90')

! ******************************************************************************
! Set pointers  
! ******************************************************************************

  pplag => pregion%plag

! ******************************************************************************
! Driver for memory reallocation
! ******************************************************************************

  CALL plag_decidereallocmem( pregion, pdecidereallocmem )

  IF ( pdecidereallocmem .EQV. .true. ) THEN
    CALL plag_setmaxdimensions( pregion )
    CALL plag_reallocmem( pregion )

! TEMPORARY
    WRITE(stdout,'(A,I2,2X,I10,2X,I10)') ' PLAG_ReallocMem-iReg: nPcls, nPclsMax = ',&
    pregion%iRegionGlobal,pregion%plag%nPcls,pregion%plag%nPclsMax
! END TEMPORARY

  END IF ! pDecideReallocMem

! ******************************************************************************
! End
! ******************************************************************************

  CALL deregisterfunction(global)

END SUBROUTINE plag_reallocmemwrapper







! ******************************************************************************
! End
! ******************************************************************************
  
END MODULE plag_modreallocatememory

!******************************************************************************
!
! RCS Revision history:
!
! $Log: PLAG_ModReallocateMemory.F90,v $
! Revision 1.9  2008/12/06 08:44:34  mtcampbe
! Updated license.
!
! Revision 1.8  2008/11/19 22:17:46  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.7  2007/03/20 17:37:25  fnajjar
! Moved USE call for PLAG_SetMaxDimensions to new module PLAG_ModDimensions
!
! Revision 1.6  2007/03/06 23:15:32  fnajjar
! Renamed nPclsTot to nPclsMax
!
! Revision 1.5  2006/05/02 17:47:19  fnajjar
! Increased integer size in format statement
!
! Revision 1.4  2005/12/13 23:09:09  fnajjar
! Added memory allocation, copying and deallocation of cvOld,rhsSum,aivOld and arvOld to fix bug for parallel PLAG w RFLU
!
! Revision 1.3  2004/07/29 20:03:56  fnajjar
! Bug fix in PLAG_DecideReallocMem
!
! Revision 1.2  2004/07/29 16:32:50  fnajjar
! Included temporary io statement for monitoring
!
! Revision 1.1  2004/07/28 18:59:50  fnajjar
! Initial import for dynamic memory reallocation
!
!******************************************************************************