psmile_locations_dealloc.F90

Go to the documentation of this file.

!-----------------------------------------------------------------------
! Copyright 2006-2010, NEC Europe Ltd., London, UK.
! All rights reserved. Use is subject to OASIS4 license terms.
!-----------------------------------------------------------------------
!BOP
!
! !ROUTINE: PSMILe_Locations_dealloc
!
! !INTERFACE:

      subroutine psmile_locations_dealloc (send_info, ierror)
!
! !USES:
!
      use PRISM_constants
!
      use PSMILe, dummy_interface => PSMILe_Locations_dealloc

      implicit none
!
! !INPUT PARAMETERS:
 
      Type(Send_information), Intent(Inout) :: send_info

!     Send information

! !OUTPUT PARAMETERS:
!
      Integer, Intent (Out)           :: ierror

!     Returns the error code of PSMILe_Locations_dealloc;
!             ierror = 0 : No error
!             ierror > 0 : Severe error
!
! !LOCAL VARIABLES
!
!     ... for simplicity
!
      Integer                         :: nvec, nparts
!
!     ... loop indices
!
      Integer                         :: i, j
!
!     ... for error handling
!
!     Integer, parameter              :: nerrp = 2
!     Integer                         :: ierrp (nerrp)
!
! !DESCRIPTION:
!
! Subroutine "PSMILe_Locations_dealloc" frees the vectors for the send
! information for the coupler which were used to generate the lists for
! the transformer.
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 03.07.21    H. Ritzdorf  created
!
!EOP
!----------------------------------------------------------------------
!
!  $Id: psmile_locations_dealloc.F90 2938 2011-02-03 10:23:22Z hanke $
!  $Author: hanke $
!
   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_locations_dealloc.F90 2938 2011-02-03 10:23:22Z hanke $'
!
!----------------------------------------------------------------------
!
!  Initialization
!
#ifdef VERBOSE
      print 9990, trim(ch_id)

      call psmile_flushstd
#endif /* VERBOSE */
!
      ierror = 0
!
      nvec   = send_info%nvec
      nparts = send_info%nparts
!
#ifdef PRISM_ASSERTION
      if ( min (nvec, nparts) <= 0 ) then
         print *, trim(ch_id), ', nvec, nparts', nvec, nparts
         call psmile_assert (__FILE__, __LINE__, "nvec or nparts <= 0")
      endif
!
      if ( .not. Associated (send_info%srclocs) ) then
         call psmile_assert (__FILE__, __LINE__, &
                             "send_info%srclocs is not allocated")
        
      endif
!
      if ( .not. Associated (send_info%msklocs) ) then
         call psmile_assert (__FILE__, __LINE__, &
                             "send_info%msklocs is not allocated")
        
      endif
!
!rr      if ( .not. Associated (send_info%virtual) ) then
!rr         call PSMILe_Assert (__FILE__, __LINE__, &
!rr                             "send_info%virtual is not allocated")
!rr        
!rr      endif
!
      if ( .not. Associated (send_info%srcars) ) then
         call psmile_assert (__FILE__, __LINE__, &
                             "send_info%srcars is not allocated")
        
      endif
!
      if ( .not. Associated (send_info%nars) ) then
         call psmile_assert (__FILE__, __LINE__, &
                             "send_info%nars is not allocated")
        
      endif
!
      if ( .not. Associated (send_info%npoints) ) then
         call psmile_assert (__FILE__, __LINE__, &
                             "send_info%npoints is not allocated")
        
      endif
#endif
!
!----------------------------------------------------------------------------
!    Free
!----------------------------------------------------------------------------
!
      do j = 1, nparts

         if (Associated(send_info%virtual)) then
            if (Associated(send_info%virtual(1, j)%vector) ) &
               Deallocate (send_info%virtual(1, j)%vector)
         endif

         do i = 1, nvec

            if (Associated(send_info%msklocs(i, j)%vector) ) &
               Deallocate (send_info%msklocs(i, j)%vector)

            if (Associated(send_info%srclocs(i, j)%vector) ) &
               Deallocate (send_info%srclocs(i, j)%vector)
!
            if (Associated(send_info%srcars(i, j)%vector) ) &
               Deallocate (send_info%srcars(i, j)%vector)
         end do
      end do
!
      Deallocate (send_info%virtual, STAT = ierror)

      Deallocate (send_info%msklocs, STAT = ierror)
!
      Deallocate (send_info%srclocs, STAT = ierror)
!
      Deallocate (send_info%srcars, STAT = ierror)
!
      Deallocate (send_info%nars, STAT = ierror)
!
      Deallocate (send_info%npoints, STAT = ierror)
!
!===> Set count numbers to 0
!
      send_info%nvec   = 0
      send_info%nparts = 0
!
!===> All done
!
#ifdef VERBOSE
      print 9980, trim(ch_id), ierror

      call psmile_flushstd
#endif /* VERBOSE */
!
!  Formats:
!

#ifdef VERBOSE

9990 format (1x, a, ': psmile_locations_dealloc:')
9980 format (1x, a, ': psmile_locations_dealloc: eof ierror =', i3)

#endif /* VERBOSE */

      end subroutine PSMILe_Locations_dealloc