psmile_extent_subgrid_2d_real.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_Extent_Subgrid_2d_real
!
! !INTERFACE:

      subroutine psmile_extent_subgrid_2d_real (         &
                    array, idlow, idhigh, jdlow, jdhigh, &
                           nbr_corners,                  &
                           ibeg, iend, jbeg, jend,       &
                    extent, ierror)
!
! !USES:
!
      use PRISM_constants
!
      use PSMILe, dummy_interface => PSMILe_Extent_Subgrid_2d_real

      implicit none
!
! !INPUT PARAMETERS:
!
      Integer, Intent (In)             :: idlow, idhigh
      Integer, Intent (In)             :: jdlow, jdhigh
      Integer, Intent (In)             :: nbr_corners

!     Dimensions of "array"

      Real, Intent (In)                :: array (idlow:idhigh, 
                                                 jdlow:jdhigh, 
                                                 nbr_corners)

!     Fully dimensioned Array for which the extent of the subarray
!     should be computed.

      Integer, Intent (In)             :: ibeg, iend, jbeg, jend

!     Definintion of the subgrid
!
!
! !OUTPUT PARAMETERS:
!
      Real, Intent (Out)               :: extent (2)

!     Returns the extent of subarray "array (ibeg:iend, jbeg:jend,
!                                            1:nbr_corners)"

      Integer, Intent (Out)            :: ierror

!     Returns the error code of PSMILe_Extent_Subgrid_2d_real;
!             ierror = 0 : No error
!             ierror > 0 : Severe error
!
! !DESCRIPTION:
!
! Subroutine "PSMILe_Extent_Subgrid_2d_real" computes the extent
! of the subgrid contained in array~(ibeg:iend,~jbeg:jend,~nbr_corners).
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 01.12.03    H. Ritzdorf  created
!
!EOP
!----------------------------------------------------------------------
!
! $Id: psmile_extent_subgrid_2d_real.F90 2325 2010-04-21 15:00:07Z valcke $
! $Author: valcke $
!
   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_extent_subgrid_2d_real.F90 2325 2010-04-21 15:00:07Z valcke $'
!
!----------------------------------------------------------------------

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

      call psmile_flushstd
#endif /* VERBOSE */
!
!  Initialization
!
      ierror = 0
!
!===> Evaluation of face points only is not correct
!     HR: A checkboard access would help to decrease the number of
!         acesses. However, this would imply, that the corner volumes
!         would always fit.
!
!     Try, to help the compiler; is this necessary ?
!
      if (ibeg == idlow .and. iend == idhigh) then
         if (jbeg == jdlow .and. jend == jdhigh) then
            extent (1) = MINVAL (array)
            extent (2) = MAXVAL (array)
         else 
            extent (1) = MINVAL (array (:, jbeg:jend, 1:nbr_corners))
            extent (2) = MAXVAL (array (:, jbeg:jend, 1:nbr_corners))
         endif
      else
         extent (1) = MINVAL (array (ibeg:iend, jbeg:jend, 1:nbr_corners))
         extent (2) = MAXVAL (array (ibeg:iend, jbeg:jend, 1:nbr_corners))
      endif
!
!===> All done
!
#ifdef VERBOSE
      print *, trim(ch_id), ': PSMILe_Extent_Subgrid_2d_real eof', &
                            ': ierror =', ierror
!                         , '; extent =', extent

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