psmile_get_grid_extent.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_Get_Grid_Extent
!
! !INTERFACE:

      subroutine psmile_get_grid_extent (grid_id, extent, ierror)

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

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

!     Specifies the handle to the grid information.
!
! !OUTPUT PARAMETERS:
!
      Real (PSMILe_float_kind), Intent (Out) :: extent (2, ndim_3d)

!     Returns the extent of grid "grid_id"

      Integer,                  Intent (Out) :: ierror

!     Returns the error code of PSMILe_Get_Grid_Extent;
!             ierror = 0 : No error
!             ierror > 0 : Severe error
!
!
! !LOCAL VARIABLES
!
      Type (Corner_Block), Pointer :: corner_pointer

      Integer, parameter           :: nerrp = 1
      Integer                      :: ierrp (nerrp)
      Integer                      :: i, index
!
! !DESCRIPTION:
!
! Subroutine "PSMILe_Get_Grid_Extent" computes the extent of the grid
! "grid_id".
!
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 01.12.03    H. Ritzdorf  created
!
!EOP
!----------------------------------------------------------------------
!
! $Id: psmile_get_grid_extent.F90 2325 2010-04-21 15:00:07Z valcke $
! $Author: valcke $
!
   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_get_grid_extent.F90 2325 2010-04-21 15:00:07Z valcke $'
!
!----------------------------------------------------------------------

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

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

      if (Grids(grid_id)%grid_type == PRISM_Gridless) then
!
!  No grid
!
         extent (1:2, 1:ndim_3d) = Grids(grid_id)%grid_shape (1:2, 1:ndim_3d)
         
         if (Associated (Grids(grid_id)%partition)) then

               do i = 1, ndim_3d

               extent (1,i) = Grids(grid_id)%partition  (1,i) + 1
               extent (2,i) = Grids(grid_id)%partition  (1,i) + &
                              Grids(grid_id)%grid_shape (2,i) - &
                              Grids(grid_id)%grid_shape (1,i) + 1

               end do

         else

               extent (1:2, 1:ndim_3d) = Grids(grid_id)%grid_shape (1:2, 1:ndim_3d)

         endif
!
      else

          corner_pointer => Grids(grid_id)%corner_pointer
!
          if (corner_pointer%corner_datatype == MPI_REAL) then

!            ... Real datatype

             call psmile_get_grid_extent_real (grid_id, extent, ierror)

!            ... expand the extend to the pole when the pole is included in the grid.
             if ( associated ( corner_pointer%pole_array ) ) then
                do i = 1, size(corner_pointer%pole_array)
                   index = corner_pointer%pole_array(i)
                   if (index /= PRISM_UNDEFINED) then
                   if      ( corner_pointer%corners_real(1)%vector(index) > 0.0 ) then
                      extent(2,2) =  90.0
                   else if ( corner_pointer%corners_real(1)%vector(index) < 0.0 ) then
                      extent(1,2) = -90.0
                   endif
                   endif
                enddo
             endif

          else if (corner_pointer%corner_datatype == MPI_DOUBLE_PRECISION) then

!            ... Double precision datatype

             call psmile_get_grid_extent_dble (grid_id, extent, ierror)

!            ... expand the extend to the pole when the pole is included in the grid.
             if ( associated ( corner_pointer%pole_array ) ) then
                do i = 1, size(corner_pointer%pole_array)
                   index = corner_pointer%pole_array(i)
                   if (index /= PRISM_UNDEFINED) then
                   if      ( corner_pointer%corners_dble(2)%vector(index) > 0.0 ) then
                      extent(2,2) =  90.0
                   else if ( corner_pointer%corners_dble(2)%vector(index) < 0.0 ) then
                      extent(1,2) = -90.0
                   endif
                   endif
                enddo
             endif

#if defined ( PRISM_QUAD_TYPE )

          else if (corner_pointer%corner_datatype == MPI_REAL16) then

!            ... Quadruple precision datatype

             call psmile_get_grid_extent_quad (grid_id, extent, ierror)

!            ... expand the extend to the pole when the pole is included in the grid.
             if ( associated ( corner_pointer%pole_array ) ) then
                do i = 1, size(corner_pointer%pole_array)
                   index = corner_pointer%pole_array(i)
                   if (index /= PRISM_UNDEFINED) then
                   if      ( corner_pointer%corners_quad(1)%vector(index) > 0.0 ) then
                      extent(2,2) = 90.0
                   else if ( corner_pointer%corners_quad(1)%vector(index) < 0.0 ) then
                      extent(2,1) = -90.0
                   endif
                   endif
                enddo
             endif
#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

      endif
!
!===> All done
!
#ifdef VERBOSE
      print *, trim(ch_id), ': PSMILe_Get_Grid_Extent eof: grid_id',&
                             grid_id, ', ierror =', ierror

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