psmile_extent_subgrid_1d_dble.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_1d_dble
!
! !INTERFACE:

      subroutine psmile_extent_subgrid_1d_dble (         &
                    array, idlow, idhigh, nbr_corners,   &
                           ibeg,  iend,                  &
                    extent, ierror)
!
! !USES:
!
      use PRISM_constants
!
      use PSMILe, dummy_interface => PSMILe_Extent_Subgrid_1d_dble

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

!     Dimensions of "array"

      Double Precision, Intent (In)    :: array (idlow:idhigh, nbr_corners)

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

      Integer, Intent (In)             :: ibeg, iend

!     Definintion of the subgrid

!
! !OUTPUT PARAMETERS:
!
      Double Precision, Intent (Out)   :: extent (2)

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

      Integer, Intent (Out)            :: ierror

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

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

      call psmile_flushstd
#endif /* VERBOSE */
!
!  Initialization
!
      ierror = 0
!
!  Get extent of subgrid
!
      if (ibeg == idlow .and. iend == idhigh) then
         extent (1) = MINVAL (array)
         extent (2) = MAXVAL (array)

      else

         extent (1) = MINVAL (array (ibeg:iend, 1:nbr_corners))
         extent (2) = MAXVAL (array (ibeg:iend, 1:nbr_corners))
      endif
!
!===> All done
!
#ifdef VERBOSE
      print *, trim(ch_id), ': PSMILe_Extent_Subgrid_1d_dble eof', &
                            ': ierror =', ierror

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