psmile_free_method_handle.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_Free_method_handle
!
! !INTERFACE:

      subroutine psmile_free_method_handle ( method_id, ierror)
!
! !USES:
!
      use PRISM_constants
!
      use PSMILe, dummy_interface => PSMILe_Free_method_handle

      implicit none
!
! !INPUT PARAMETERS:
!
      integer, Intent (In)  :: method_id

!     Handle to the grid point information to be released.
!
! !OUTPUT PARAMETERS:
!
      integer, Intent (Out)               :: ierror
!     Returns the error code of PRISM_Init;
!             ierror = 0 : No error
!             ierror > 0 : Severe error
!
! !LOCAL VARIABLES
!
      integer                             :: i
!
      integer, parameter                  :: nerrp = 2
      integer                             :: ierrp (nerrp)
!
! !DESCRIPTION:
!
! Subroutine "PSMILe_Free_method_handle" releases a handle to grid point information.
!
! !REVISION HISTORY:
!
!   Date      Programmer    Description
! ----------  -----------   -----------
! 01.12.03    H. Ritzdorf   created
!
!EOP
!----------------------------------------------------------------------
!
! $Id: psmile_free_method_handle.F90 2325 2010-04-21 15:00:07Z valcke $
! $Author: valcke $
!
   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_free_method_handle.F90 2325 2010-04-21 15:00:07Z valcke $'
!
!----------------------------------------------------------------------

#ifdef VERBOSE
      print *, trim(ch_id), ': PSMILe_Free_method_handle: start handle =', method_id

      call psmile_flushstd
#endif /* VERBOSE */

!
!   Initialization
!
      ierror = 0
!
      if (method_id > Number_of_Methods_allocated .or. &
          method_id < 1) then

         ierrp (1) = method_id
         ierrp (2) = Number_of_Methods_allocated

         ierror = PRISM_Error_Internal
         call psmile_error (ierror, "invalid method handle", &
                            ierrp, nerrp, __FILE__, __LINE__)
         return
      endif
!
!   Free Index
!
      Methods(method_id)%status = PSMILe_status_free
!
!   Update linked list
!
      if (Methods(method_id)%previous_method_in_grid /= PRISM_UNDEFINED) then
         i = Methods(method_id)%previous_method_in_grid
         Methods(i)%next_method_in_grid = Methods(method_id)%next_method_in_grid
      endif

      if (Methods(method_id)%next_method_in_grid /= PRISM_UNDEFINED) then
         i = Methods(method_id)%next_method_in_grid
         Methods(i)%previous_method_in_grid = &
             Methods(method_id)%previous_method_in_grid
      endif
!
!   De-allocate memory
!
      if (Associated (Methods(method_id)%send_infos_direct)) then
          Deallocate (Methods(method_id)%send_infos_direct)
      endif

      if (Associated (Methods(method_id)%send_infos_coupler)) then
          Deallocate (Methods(method_id)%send_infos_coupler)
      endif

      if (Associated (Methods(method_id)%recv_infos_direct)) then
          Deallocate (Methods(method_id)%recv_infos_direct)
      endif

      if (Associated (Methods(method_id)%recv_infos_coupler)) then
          Deallocate (Methods(method_id)%recv_infos_coupler)
      endif

#ifdef VERBOSE
      print *, trim(ch_id), ': PSMILe_Free_method_handle: eof ierror =', ierror

      call psmile_flushstd
#endif /* VERBOSE */
!
      end subroutine PSMILe_Free_method_handle