psmile_extent_subgrid_3d_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_3d_dble
!
! !INTERFACE:

      subroutine psmile_extent_subgrid_3d_dble (         &
                    array, idlow, idhigh, jdlow, jdhigh, &
                           kdlow, kdhigh, nbr_corners,   &
                           shape,                        &
                    extent, ierror)
!
! !USES:
!
      use PRISM_constants
!
      use PSMILe, dummy_interface => PSMILe_Extent_Subgrid_3d_dble

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

!     Dimensions of "array"

      Double Precision, Intent (In)    :: array (idlow:idhigh, jdlow:jdhigh, 
                                                 kdlow:kdhigh, nbr_corners)

!     Fully dimensioned Array for which the extent of the subarray
!     should be computed.
!
      Integer, Intent (In)             :: shape (2, ndim_3d)

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

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

      Integer, Intent (Out)            :: ierror

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

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

      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 (shape(1,1) == idlow .and. shape(2,1) == idhigh) then
         if (shape(1,2) == jdlow .and. shape(2,2) == jdhigh) then
            if (shape(1,3) == kdlow .and. shape(2,3) == kdhigh) then
               extent (1) = MINVAL (array)
               extent (2) = MAXVAL (array)
            else
               extent (1) = MINVAL (array (:, :,                  &
                                           shape(1,3):shape(1,3), &
                                           1:nbr_corners))
               extent (2) = MAXVAL (array (:, :,                  &
                                           shape(1,3):shape(1,3), &
                                           1:nbr_corners))
            endif
         else 
            extent (1) = MINVAL (array (:,                     &
                                        shape(1,2):shape(1,2), &
                                        shape(1,3):shape(1,3), &
                                        1:nbr_corners))
            extent (2) = MAXVAL (array (:,                     &
                                        shape(1,2):shape(1,2), &
                                        shape(1,3):shape(1,3), &
                                        1:nbr_corners))
         endif

      else

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

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