psmile_sel_grid_range.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_Sel_grid_range
!
! !INTERFACE:

      subroutine psmile_sel_grid_range (grid_id, dinter, inter, ierror)

!
! !USES:
!
      use PRISM_constants
!
      use PSMILe, dummy_interface => PSMILe_Sel_grid_range

      implicit none
!
! !INPUT PARAMETERS:
!
      Integer,                  Intent (In)  :: grid_id

!     Specifies the handle to the grid information.

      Real (PSMILe_float_kind), Intent (In)  :: dinter (2, ndim_3d)

!     Specifies the intersection with grid "grid_id"
!
! !OUTPUT PARAMETERS:
!
      Integer,                  Intent (Out) :: inter (2, ndim_3d)

!     Returns the sub-array of grid "grid_id" which contains "dinter"

      Integer,                  Intent (Out) :: ierror

!     Returns the error code of PSMILe_Sel_grid_range;
!             ierror = 0 : No error
!             ierror > 0 : Severe error
!
! !DEFINED PARAMETERS:
!
     Integer, parameter            :: nc_reg = 2

!    Number of corners for regular directions
!
! !LOCAL VARIABLES
!
      Type (Corner_Block), Pointer :: corner_pointer
!
      integer, parameter           :: nerrp = 2
      integer                      :: ierrp (nerrp)
!!
! !DESCRIPTION:
!
! Subroutine "PSMILe_Sel_grid_range" computes the subarray of grid id
! "grid_id"  which contains the range "dinter".
!
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 03.06.03    H. Ritzdorf  created
!
!EOP
!----------------------------------------------------------------------
!
! $Id: psmile_sel_grid_range.F90 2325 2010-04-21 15:00:07Z valcke $
! $Author: valcke $
!
   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_sel_grid_range.F90 2325 2010-04-21 15:00:07Z valcke $'
!
!----------------------------------------------------------------------

#ifdef VERBOSE
      print *, trim(ch_id), ': PSMILe_Sel_grid_range: grid_id', grid_id

      call psmile_flushstd
#endif /* VERBOSE */
!
!  Initialization
!
      ierror = 0

      corner_pointer => Grids(grid_id)%corner_pointer
!

      if (corner_pointer%corner_datatype == MPI_REAL) then

!        ...  Real datatype

         call psmile_sel_grid_range_real (grid_id, dinter, inter, ierror)

      else if (corner_pointer%corner_datatype == MPI_DOUBLE_PRECISION) then

!        ...  Double precision datatype

         call psmile_sel_grid_range_dble (grid_id, dinter, inter, ierror)

#if defined ( PRISM_QUAD_TYPE )
      else if (corner_pointer%corner_datatype == MPI_REAL16) then

!        ...  Quadruple precision datatype

         call psmile_sel_grid_range_dble (grid_id, dinter, inter, ierror)

#endif

      else
!
!        Unknown data type
!
         ierrp (1) = corner_pointer%corner_datatype
         ierror = PRISM_Error_Internal
         call psmile_error ( ierror, 'unsupported data type', &
                             ierrp, 1, __FILE__, __LINE__ )
      endif
!
!===> All done
!
#ifdef VERBOSE
      print *, trim(ch_id), ': PSMILe_Sel_grid_range eof: grid_id',&
                             grid_id, ', ierror =', ierror, '; inter  =', inter

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