psmile_neigh_extra_search_clean.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_Neigh_extra_search_clean
!
! !INTERFACE:

      subroutine psmile_neigh_extra_search_clean (search, extra_search, ierror)
!
! !USES:
!
      use PRISM_constants
!
      use PSMILe, dummy_interface => PSMILe_Neigh_extra_search_clean

      Implicit none
!
! !INPUT PARAMETERS:
!
      Type (Enddef_search),     Intent (In)    :: search

!     Info's on coordinates to be searched
!
! !INPUT/OUTPUT PARAMETERS:
!
      Type (Extra_search_info), Intent (InOut) :: extra_search
!
!     Structure containing the data for
!     (*) global search and
!     (*) extra search of location
!         (for example: where required mask values were not "true")
!
! !OUTPUT PARAMETERS:

      Integer,                  Intent (Out)   :: ierror

!     Returns the error code of PSMILE_Neigh_extra_search_clean;
!             ierror = 0 : No error
!             ierror > 0 : Severe error
!
! !LOCAL VARIABLES
!
      Integer                         :: ipart
!
!     ... for error handling
!
!     Integer, Parameter              :: nerrp = 2
!     Integer                         :: ierrp (nerrp)
!
!
! !DESCRIPTION:
!
! Subroutine "PSMILe_Neigh_extra_search_clean" clean the vectors
! and variables use for the extra search; i.e for
!
!   (*) global search or
!   (*) extra search (nearest neighbour search).
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 15.03.06    H. Ritzdorf  created
!
!EOP
!----------------------------------------------------------------------
!
!  $Id: psmile_neigh_extra_search_clean.F90 2082 2009-10-21 13:31:19Z hanke $
!  $Author: hanke $
!
   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_neigh_extra_search_clean.F90 2082 2009-10-21 13:31:19Z hanke $'
!
!----------------------------------------------------------------------
!
!  Initialization
!
#ifdef VERBOSE
      print 9990, trim(ch_id)

      call psmile_flushstd
#endif /* VERBOSE */
!
!===> Initialization
!
      ierror  = 0
!
         do ipart = 1, search%npart
         if (extra_search%len_req(ipart) > 0) then
            Deallocate (extra_search%indices_req (ipart)%vector)
            Deallocate (extra_search%required    (ipart)%vector)
         endif
         end do
!
      if ( Associated (extra_search%indices) ) then
           Deallocate (extra_search%indices)
      endif
!
!===> Remove distance arrays for global nearest neighbour search
!
      if ( Associated (extra_search%dist_dble) ) then
           Deallocate (extra_search%dist_dble)
      endif
!
      if ( Associated (extra_search%cos_search_dble) ) then
           Deallocate (extra_search%cos_search_dble)
      endif
!
      if ( Associated (extra_search%sin_search_dble) ) then
           Deallocate (extra_search%sin_search_dble)
      endif
!
      if ( Associated (extra_search%z_search_dble) ) then
           Deallocate (extra_search%z_search_dble)
      endif
!
!===> ... real arrays
!
      if ( Associated (extra_search%dist_real) ) then
           Deallocate (extra_search%dist_real)
      endif
!
      if ( Associated (extra_search%cos_search_real) ) then
           Deallocate (extra_search%cos_search_real)
      endif
!
      if ( Associated (extra_search%sin_search_real) ) then
           Deallocate (extra_search%sin_search_real)
      endif
!
      if ( Associated (extra_search%z_search_real) ) then
           Deallocate (extra_search%z_search_real)
      endif
!
!===> 
!
      Deallocate (extra_search%len_extra,   &
                  extra_search%len_req,     &
                  extra_search%indices_req, &
                  extra_search%required)
!
!===> Reset number of extra points and
!           number of points which require global search

!
      extra_search%n_extra = 0
      extra_search%n_req = 0
!
!===> All done
!
#ifdef VERBOSE
      print 9980, trim(ch_id)

      call psmile_flushstd
#endif /* VERBOSE */
!
!  Formats:
!
9990 format (1x, a, ': psmile_neigh_extra_search_clean: ')
9980 format (1x, a, ': psmile_neigh_extra_search_clean: eof')

      end subroutine psmile_neigh_extra_search_clean