destroy.F

Go to the documentation of this file.

#include "cppdefs.h"
      MODULE destroy_mod
!
!git $Id$
!================================================== Hernan G. Arango ===
!  Copyright (c) 2002-2025 The ROMS Group                              !
!    Licensed under a MIT/X style license                              !
!    See License_ROMS.md                                               !
!=======================================================================
!                                                                      !
!  It releases the space allocated for pointer variable in ROMS        !
!  kernel structures. After a variable has been deallocated, it        !
!  cannot be defined or referenced until it is allocated or            !
!  assigned again.                                                     !
!                                                                      !
!  On Input:                                                           !
!                                                                      !
!     ng         Nested grid number (integer)                          !
!     Varray     Pointer variable to deallocate (real)                 !
!     routine    Calling routine (string)                              !
!     line       Calling routine line (integer)                        !
!     Vstring    Variable name (string)                                !
!                                                                      !
!  On Output:                                                          !
!                                                                      !
!     Lsuccess   Deallocation error switch (logical)                   !
!                                                                      !
!=======================================================================
!
      USE mod_kinds
      USE mod_parallel, ONLY : master
      USE mod_iounits,  ONLY : stdout
!
      implicit none
!
      INTERFACE destroy
        MODULE PROCEDURE destroy_1d_i    ! 1D integer array
        MODULE PROCEDURE destroy_1d_l    ! 1D logical array
#ifdef SINGLE_PRECISION
        MODULE PROCEDURE destroy_1d_dp   ! 1D real(dp) array
        MODULE PROCEDURE destroy_2d_dp   ! 2D real(dp) array
        MODULE PROCEDURE destroy_3d_dp   ! 3D real(dp) array
        MODULE PROCEDURE destroy_4d_dp   ! 4D real(dp) array
        MODULE PROCEDURE destroy_5d_dp   ! 5D real(dp) array
#endif
        MODULE PROCEDURE destroy_1d_r8   ! 1D real(r8) array
        MODULE PROCEDURE destroy_2d_r8   ! 2D real(r8) array
        MODULE PROCEDURE destroy_3d_r8   ! 3D real(r8) array
        MODULE PROCEDURE destroy_4d_r8   ! 4D real(r8) array
        MODULE PROCEDURE destroy_5d_r8   ! 5D real(r8) array
      END INTERFACE destroy
!
      integer, parameter :: avar = 1
      integer, parameter :: pvar = 2
!
      CONTAINS
!
!***********************************************************************
      FUNCTION destroy_1d_i (ng, Varray, routine, line, Vstring)        &
     &               result(lsuccess)
!***********************************************************************
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, line
 
      integer, pointer, intent(inout) :: varray(:)
!
      character (len=*) :: vstring, routine
!
!  Local variable declarations.
!
      logical :: lsuccess
!
      integer :: derror
!
      character (len=:), allocatable :: dmsg
!
!-----------------------------------------------------------------------
!  Deallocate 1D integer array.
!-----------------------------------------------------------------------
!
      lsuccess=.true.
      derror=0
!
#ifdef DISTRIBUTE
      IF (associated(varray))                                           &
     &  deallocate ( varray, errmsg = dmsg, stat = derror )
#else
      IF (master) THEN
        IF (associated(varray))                                         &
     &    deallocate ( varray, errmsg = dmsg, stat = derror )
      END IF
#endif
!
!  Report if unsuccessful deallocation.
!
      IF (derror.ne.0) THEN
        IF (master) THEN
          WRITE (stdout,10) ng, vstring, routine, line, dmsg
        END IF
        lsuccess=.false.
      END IF
!
 10   FORMAT (/,' DESTROY_1D_I - Grid ',i2.2,                           &
     &        ', error while deallocating: ''',a,''' in routine ''',a,  &
     &        ''' at line = ',i0,/,16x,a)
!
      RETURN
      END FUNCTION destroy_1d_i
!
!***********************************************************************
      FUNCTION destroy_1d_l (ng, Varray, routine, line, Vstring)        &
     &               result(lsuccess)
!***********************************************************************
!
!  Imported variable declarations.
!
      logical, pointer, intent(inout) :: varray(:)
!
      integer, intent(in) :: ng, line
!
      character (len=*) :: vstring, routine
!
!  Local variable declarations.
!
      logical :: lsuccess
!
      integer :: derror
!
      character (len=:), allocatable :: dmsg
!
!-----------------------------------------------------------------------
!  Deallocate 1D logical array.
!-----------------------------------------------------------------------
!
      lsuccess=.true.
      derror=0
!
#ifdef DISTRIBUTE
      IF (associated(varray))                                           &
     &  deallocate ( varray, errmsg = dmsg, stat = derror )
#else
      IF (master) THEN
        IF (associated(varray))                                         &
     &    deallocate ( varray, errmsg = dmsg, stat = derror )
      END IF
#endif
!
!  Report if unsuccessful deallocation.
!
      IF (derror.ne.0) THEN
        IF (master) THEN
          WRITE (stdout,10) ng, vstring, routine, line, dmsg
        END IF
        lsuccess=.false.
      END IF
!
 10   FORMAT (/,' DESTROY_1D_L - Grid ',i2.2,                           &
     &        ', error while deallocating: ''',a,''' in routine ''',a,  &
     &        ''' at line = ',i0,/,16x,a)
!
      RETURN
      END FUNCTION destroy_1d_l
!
!***********************************************************************
      FUNCTION destroy_1d_r8 (ng, Varray, routine, line, Vstring)       &
     &                result(lsuccess)
!***********************************************************************
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, line
!
      real(r8), pointer, intent(inout) :: varray(:)
!
      character (len=*) :: vstring, routine
!
!  Local variable declarations.
!
      logical :: lsuccess
!
      integer :: derror
!
      character (len=:), allocatable :: dmsg
!
!-----------------------------------------------------------------------
!  Deallocate 1D floating-point array (KIND=r8).
!-----------------------------------------------------------------------
!
      lsuccess=.true.
      derror=0
!
#ifdef DISTRIBUTE
      IF (associated(varray))                                           &
     &  deallocate ( varray, errmsg = dmsg, stat = derror )
#else
      IF (master) THEN
        IF (associated(varray))                                         &
     &    deallocate ( varray, errmsg = dmsg, stat = derror )
      END IF
#endif
!
!  Report if unsuccessful deallocation.
!
      IF (derror.ne.0) THEN
        IF (master) THEN
          WRITE (stdout,10) ng, vstring, routine, line, dmsg
        END IF
        lsuccess=.false.
      END IF
!
 10   FORMAT (/,' DESTROY_1D_R8 - Grid ',i2.2,                          &
     &        ', error while deallocating: ''',a,''' in routine ''',a,  &
     &        ''' at line = ',i0,/,17x,a)
!
      RETURN
      END FUNCTION destroy_1d_r8
!
!***********************************************************************
      FUNCTION destroy_2d_r8 (ng, Varray, routine, line, Vstring)       &
     &                result(lsuccess)
!***********************************************************************
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, line
!
      real(r8), pointer, intent(inout) :: varray(:,:)
!
      character (len=*) :: vstring, routine
!
!  Local variable declarations.
!
      logical :: lsuccess
!
      integer :: derror
!
      character (len=:), allocatable :: dmsg
!
!-----------------------------------------------------------------------
!  Deallocate 2D floating-point array (KIND=r8).
!-----------------------------------------------------------------------
!
      lsuccess=.true.
      derror=0
!
#ifdef DISTRIBUTE
      IF (associated(varray))                                           &
     &  deallocate ( varray, errmsg = dmsg, stat = derror )
#else
      IF (master) THEN
        IF (associated(varray))                                         &
     &    deallocate ( varray, errmsg = dmsg, stat = derror )
      END IF
#endif
!
!  Report if unsuccessful deallocation.
!
      IF (derror.ne.0) THEN
        IF (master) THEN
          WRITE (stdout,10) ng, vstring, routine, line, dmsg
        END IF
        lsuccess=.false.
      END IF
!
 10   FORMAT (/,' DESTROY_2D_R8 - Grid ',i2.2,                          &
     &        ', error while deallocating: ''',a,''' in routine ''',a,  &
     &        ''' at line = ',i0,/,17x,a)
!
      RETURN
      END FUNCTION destroy_2d_r8
!
!***********************************************************************
      FUNCTION destroy_3d_r8 (ng, Varray, routine, line, Vstring)       &
     &                result(lsuccess)
!***********************************************************************
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, line
!
      real(r8), pointer, intent(inout) :: varray(:,:,:)
!
      character (len=*) :: vstring, routine
!
!  Local variable declarations.
!
      logical :: lsuccess
!
      integer :: derror
!
      character (len=:), allocatable :: dmsg
!
!-----------------------------------------------------------------------
!  Deallocate 3D floating-point array (KIND=r8).
!-----------------------------------------------------------------------
!
      lsuccess=.true.
      derror=0
!
#ifdef DISTRIBUTE
      IF (associated(varray))                                           &
     &  deallocate ( varray, errmsg = dmsg, stat = derror )
#else
      IF (master) THEN
        IF (associated(varray))                                         &
     &    deallocate ( varray, errmsg = dmsg, stat = derror )
      END IF
#endif
!
!  Report if unsuccessful deallocation.
!
      IF (derror.ne.0) THEN
        IF (master) THEN
          WRITE (stdout,10) ng, vstring, routine, line, dmsg
        END IF
        lsuccess=.false.
      END IF
!
 10   FORMAT (/,' DESTROY_3D_R8 - Grid ',i2.2,                          &
     &        ', error while deallocating: ''',a,''' in routine ''',a,  &
     &        ''' at line = ',i0,/,17x,a)
!
      RETURN
      END FUNCTION destroy_3d_r8
!
!***********************************************************************
      FUNCTION destroy_4d_r8 (ng, Varray, routine, line, Vstring)       &
     &                result(lsuccess)
!***********************************************************************
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, line
!
      real(r8), pointer, intent(inout) :: varray(:,:,:,:)
!
      character (len=*) :: vstring, routine
!
!  Local variable declarations.
!
      logical :: lsuccess
!
      integer :: derror
!
      character (len=:), allocatable :: dmsg
!
!-----------------------------------------------------------------------
!  Deallocate 4D floating-point array (KIND=r8).
!-----------------------------------------------------------------------
!
      lsuccess=.true.
      derror=0
!
#ifdef DISTRIBUTE
      IF (associated(varray))                                           &
     &  deallocate ( varray, errmsg = dmsg, stat = derror )
#else
      IF (master) THEN
        IF (associated(varray))                                         &
     &    deallocate ( varray, errmsg = dmsg, stat = derror )
      END IF
#endif
!
!  Report if unsuccessful deallocation.
!
      IF (derror.ne.0) THEN
        IF (master) THEN
          WRITE (stdout,10) ng, vstring, routine, line, dmsg
        END IF
        lsuccess=.false.
      END IF
!
 10   FORMAT (/,' DESTROY_4D_R8 - Grid ',i2.2,                          &
     &        ', error while deallocating: ''',a,''' in routine ''',a,  &
     &        ''' at line = ',i0,/,17x,a)
!
      RETURN
      END FUNCTION destroy_4d_r8
!
!***********************************************************************
      FUNCTION destroy_5d_r8 (ng, Varray, routine, line, Vstring)       &
     &                result(lsuccess)
!***********************************************************************
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, line
!
      real(r8), pointer, intent(inout) :: varray(:,:,:,:,:)
!
      character (len=*) :: vstring, routine
!
!  Local variable declarations.
!
      logical :: lsuccess
!
      integer :: derror
!
      character (len=:), allocatable :: dmsg
!
!-----------------------------------------------------------------------
!  Deallocate 5D floating-point array (KIND=r8).
!-----------------------------------------------------------------------
!
      lsuccess=.true.
      derror=0
!
#ifdef DISTRIBUTE
      IF (associated(varray))                                           &
     &  deallocate ( varray, errmsg = dmsg, stat = derror )
#else
      IF (master) THEN
        IF (associated(varray))                                         &
     &    deallocate ( varray, errmsg = dmsg, stat = derror )
      END IF
#endif
!
!  Report if unsuccessful deallocation.
!
      IF (derror.ne.0) THEN
        IF (master) THEN
          WRITE (stdout,10) ng, vstring, routine, line, dmsg
        END IF
        lsuccess=.false.
      END IF
!
 10   FORMAT (/,' DESTROY_5D_R8 - Grid ',i2.2,                          &
     &        ', error while deallocating: ''',a,''' in routine ''',a,  &
     &        ''' at line = ',i0,/,17x,a)
!
      RETURN
      END FUNCTION destroy_5d_r8
 
#ifdef SINGLE_PRECISION
!
!***********************************************************************
      FUNCTION destroy_1d_dp (ng, Varray, routine, line, Vstring)       &
     &                result(lsuccess)
!***********************************************************************
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, line
!
      real(dp), pointer, intent(inout) :: varray(:)
!
      character (len=*) :: vstring, routine
!
!  Local variable declarations.
!
      logical :: lsuccess
!
      integer :: derror
!
      character (len=:), allocatable :: dmsg
!
!-----------------------------------------------------------------------
!  Deallocate 1D double precision array (KIND=dp).
!-----------------------------------------------------------------------
!
      lsuccess=.true.
      derror=0
!
# ifdef DISTRIBUTE
      IF (associated(varray))                                           &
     &  deallocate ( varray, errmsg = dmsg, stat = derror )
# else
      IF (master) THEN
        IF (associated(varray))                                         &
     &    deallocate ( varray, errmsg = dmsg, stat = derror )
      END IF
# endif
!
!  Report if unsuccessful deallocation.
!
      IF (derror.ne.0) THEN
        IF (master) THEN
          WRITE (stdout,10) ng, vstring, routine, line, dmsg
        END IF
        lsuccess=.false.
      END IF
!
 10   FORMAT (/,' DESTROY_1D_DP - Grid ',i2.2,                          &
     &        ', error while deallocating: ''',a,''' in routine ''',a,  &
     &        ''' at line = ',i0,/,17x,a)
!
      RETURN
      END FUNCTION destroy_1d_dp
!
!***********************************************************************
      FUNCTION destroy_2d_dp (ng, Varray, routine, line, Vstring)       &
     &                result(lsuccess)
!***********************************************************************
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, line
!
      real(dp), pointer, intent(inout) :: varray(:,:)
!
      character (len=*) :: vstring, routine
!
!  Local variable declarations.
!
      logical :: lsuccess
!
      integer :: derror
!
      character (len=:), allocatable :: dmsg
!
!-----------------------------------------------------------------------
!  Deallocate 2D double precision array (KIND=dp).
!-----------------------------------------------------------------------
!
      lsuccess=.true.
      derror=0
!
# ifdef DISTRIBUTE
      IF (associated(varray))                                           &
     &  deallocate ( varray, errmsg = dmsg, stat = derror )
# else
      IF (master) THEN
        IF (associated(varray))                                         &
     &    deallocate ( varray, errmsg = dmsg, stat = derror )
      END IF
# endif
!
!  Report if unsuccessful deallocation.
!
      IF (derror.ne.0) THEN
        IF (master) THEN
          WRITE (stdout,10) ng, vstring, routine, line, dmsg
        END IF
        lsuccess=.false.
      END IF
!
 10   FORMAT (/,' DESTROY_2D_DP - Grid ',i2.2,                          &
     &        ', error while deallocating: ''',a,''' in routine ''',a,  &
     &        ''' at line = ',i0,/,17x,a)
!
      RETURN
      END FUNCTION destroy_2d_dp
!
!***********************************************************************
      FUNCTION destroy_3d_dp (ng, Varray, routine, line, Vstring)       &
     &                result(lsuccess)
!***********************************************************************
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, line
!
      real(dp), pointer, intent(inout) :: varray(:,:,:)
!
      character (len=*) :: vstring, routine
!
!  Local variable declarations.
!
      logical :: lsuccess
!
      integer :: derror
!
      character (len=:), allocatable :: dmsg
!
!-----------------------------------------------------------------------
!  Deallocate 3D double precision array (KIND=dp).
!-----------------------------------------------------------------------
!
      lsuccess=.true.
      derror=0
!
# ifdef DISTRIBUTE
      IF (associated(varray))                                           &
     &  deallocate ( varray, errmsg = dmsg, stat = derror )
# else
      IF (master) THEN
        IF (associated(varray))                                         &
     &    deallocate ( varray, errmsg = dmsg, stat = derror )
      END IF
# endif
!
!  Report if unsuccessful deallocation.
!
      IF (derror.ne.0) THEN
        IF (master) THEN
          WRITE (stdout,10) ng, vstring, routine, line, dmsg
        END IF
        lsuccess=.false.
      END IF
!
 10   FORMAT (/,' DESTROY_3D_DP - Grid ',i2.2,                          &
     &        ', error while deallocating: ''',a,''' in routine ''',a,  &
     &        ''' at line = ',i0,/,17x,a)
!
      RETURN
      END FUNCTION destroy_3d_dp
!
!***********************************************************************
      FUNCTION destroy_4d_dp (ng, Varray, routine, line, Vstring)       &
     &                result(lsuccess)
!***********************************************************************
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, line
!
      real(dp), pointer, intent(inout) :: varray(:,:,:,:)
!
      character (len=*) :: vstring, routine
!
!  Local variable declarations.
!
      logical :: lsuccess
!
      integer :: derror
!
      character (len=:), allocatable :: dmsg
!
!-----------------------------------------------------------------------
!  Deallocate 4D double precision array (KIND=dp).
!-----------------------------------------------------------------------
!
      lsuccess=.true.
      derror=0
!
# ifdef DISTRIBUTE
      IF (associated(varray))                                           &
     &  deallocate ( varray, errmsg = dmsg, stat = derror )
# else
      IF (master) THEN
        IF (associated(varray))                                         &
     &    deallocate ( varray, errmsg = dmsg, stat = derror )
      END IF
# endif
!
!  Report if unsuccessful deallocation.
!
      IF (derror.ne.0) THEN
        IF (master) THEN
          WRITE (stdout,10) ng, vstring, routine, line, dmsg
        END IF
        lsuccess=.false.
      END IF
!
 10   FORMAT (/,' DESTROY_4D_DP - Grid ',i2.2,                          &
     &        ', error while deallocating: ''',a,''' in routine ''',a,  &
     &        ''' at line = ',i0,/,17x,a)
!
      RETURN
      END FUNCTION destroy_4d_dp
!
!***********************************************************************
      FUNCTION destroy_5d_dp (ng, Varray, routine, line, Vstring)       &
     &                result(lsuccess)
!***********************************************************************
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, line
!
      real(dp), pointer, intent(inout) :: varray(:,:,:,:,:)
!
      character (len=*) :: vstring, routine
!
!  Local variable declarations.
!
      logical :: lsuccess
!
      integer :: derror
!
      character (len=:), allocatable :: dmsg
!
!-----------------------------------------------------------------------
!  Deallocate 5D double precision array (KIND=dp).
!-----------------------------------------------------------------------
!
      lsuccess=.true.
      derror=0
!
# ifdef DISTRIBUTE
      IF (associated(varray))                                           &
     &  deallocate ( varray, errmsg = dmsg, stat = derror )
# else
      IF (master) THEN
        IF (associated(varray))                                         &
     &    deallocate ( varray, errmsg = dmsg, stat = derror )
      END IF
# endif
!
!  Report if unsuccessful deallocation.
!
      IF (derror.ne.0) THEN
        IF (master) THEN
          WRITE (stdout,10) ng, vstring, routine, line, dmsg
        END IF
        lsuccess=.false.
      END IF
!
 10   FORMAT (/,' DESTROY_5D_DP - Grid ',i2.2,                          &
     &        ', error while deallocating: ''',a,''' in routine ''',a,  &
     &        ''' at line = ',i0,/,17x,a)
!
      RETURN
      END FUNCTION destroy_5d_dp
#endif
!
      END MODULE destroy_mod