psmile_bbcells_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_Bbcells_1d_dble
!
! !INTERFACE:

      subroutine psmile_bbcells_1d_dble (array, shape, range,         &
                           corners, corner_shape, nbr_corners,        &
                           chmin,        chmax,        levdim,        &
                           ierror)
!
! !USES:
!
      use PRISM_constants
!
      use PSMILe, dummy_interface => PSMILe_Bbcells_1d_dble

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

!     Dimension of (method/grid) coordinate "array"

      Double Precision, Intent (In)   :: array(shape(1):shape(2))

!     Coordinates of the method

      Integer, Intent (In)            :: range (2)

!     Definintion of the subgrid for which the (bounding) cells should
!     be computed.

      Integer, Intent (In)            :: corner_shape (2)

!     Dimension of the array "corners" containing the corner points
!     of the control volume.

      Integer,           Intent (In)  :: nbr_corners

!     Number of corners per control volume
!     Must be 2.

      Double Precision,  Intent (In)  :: corners (corner_shape(1): 
                                                  corner_shape(2), 
                                                  nbr_corners)

!     Coordinates of corner points of control volume

      Integer,           Intent (In)  :: levdim

!     Dimension of chmin and chmax (only for control)

! !OUTPUT PARAMETERS:
!
      Double Precision,  Intent (Out) :: chmin (range(1)-1:range(2))
!
!     Minimum value of bounding box of coordinate.
!
      Double Precision,  Intent (Out) :: chmax (range(1)-1:range(2))
!
!     Maximum value of bounding box of coordinate.
!
      Integer,           Intent (Out) :: ierror

!     Returns the error code of PSMILe_Bbcells_1d_dble
!             ierror = 0 : No error
!             ierror > 0 : Severe error
!
! !DEFINED PARAMETERS:
!
! r_nbr = 1 / Number of corners per grid cell.
!
      Double Precision, Parameter     :: epsp1 = 1.0d0 + 5d-6
!
! !LOCAL VARIABLES
!
      Integer                         :: i, ibeg, iend
!
      Double Precision                :: chmin_corner (2), 
                                         chmax_corner (2)
!
!
! !DESCRIPTION:
!
! Subroutine "PSMILe_Bbcells_1d_dble" computes the bounding box for each cell
! of the 1-dimensional coordinate defined by "array".
!
! chmin (i) returns the minimal value of bounding box of
!           method cell (i:i+1)
!
! The first box
! chmin (range(1)-1) returns the minimal value of the bounding box from
!                    the virtual cell (array(range(1)):bounding box of
!                                                      corner control volume)
! The last box
! chmin (range(2))   returns the minimal value of the bounding box from
!                    the virtual cell (array(range(2)):bounding box of
!                                                      corner control volume)
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 03.06.25    H. Ritzdorf  created
!
!EOP
!----------------------------------------------------------------------
!
!  $Id: psmile_bbcells_1d_dble.F90 2807 2010-12-08 09:56:19Z redler $
!  $Author: redler $
!
   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_bbcells_1d_dble.F90 2807 2010-12-08 09:56:19Z redler $'
!
!----------------------------------------------------------------------
!
#ifdef VERBOSE
      print 9990, trim(ch_id)

      call psmile_flushstd
#endif /* VERBOSE */
!
#ifdef PRISM_ASSERTION
      if (range(1) < corner_shape(1) .or. range(2) > corner_shape(2)) then
         print *, trim(ch_id), ": PSMILe_bbcells_1d_dble: range, corner", &
                  range, corner_shape
         call psmile_assert (__FILE__, __LINE__, &
              "levdim_corner must be >= range(2)-range(1)")
      endif
!
      if (levdim < range(2)-range(1)+2) then
         print *, trim(ch_id), ": PSMILe_bbcells_1d_dble: levdim, range", levdim
         call psmile_assert (__FILE__, __LINE__, &
              "levdim < range(2)-range(1)+2")
      endif
!
      if (nbr_corners /= 2) then
         print *, trim(ch_id), ": PSMILe_bbcells_1d_dble: nbr_corner", &
                  nbr_corners
         call psmile_assert (__FILE__, __LINE__, &
              "nbr_corners != 2")
      endif
#endif
!
!  Initialization
!
      ierror = 0
!
      ibeg = range (1)
      iend = range (2)
!
!  Get bounding box of the first and last corner cell
!
      chmin_corner (1) = min (corners(ibeg, 1), corners(ibeg, 2))
      chmax_corner (1) = max (corners(ibeg, 1), corners(ibeg, 2))
!
      chmin_corner (2) = min (corners(iend, 1), corners(iend, 2))
      chmax_corner (2) = max (corners(iend, 1), corners(iend, 2))
!
      if (ibeg == iend) then
!
#ifdef PRISM_ASSERTION
         if (chmin_corner (1) > array (ibeg) .or. &
             chmax_corner (1) < array (ibeg)) then
            print *, trim(ch_id), ": PSMILe_bbcells_1d_dble: corner", &
                     chmin_corner (1), chmax_corner (1), array (ibeg)
            call psmile_assert (__FILE__, __LINE__, &
                 "method point should be in corner control volume")
         endif
#endif
!
         chmin (ibeg-1) = chmin_corner (1)
         chmax (ibeg-1) = array (ibeg)

         chmin (iend) = array (iend)
         chmax (iend) = chmax_corner (1)
!
      else if ( ibeg < iend) then
!
!        Compute bounding box of method cells
!
!cdir vector
            do i = ibeg, iend-1
            chmin (i) = min (array(i), array (i+1))
            enddo
!
!cdir vector
            do i = ibeg, iend-1
            chmax (i) = max (array(i), array (i+1))
            enddo
!
!        Set box of the first and last (virtual) method cell
!        The first starts at begin of control volume and ends 
!        at the coordinate of first method point.
!        Corresponding for the last.
!
         if (array(ibeg) == chmin (ibeg)) then
            chmin (ibeg-1) = chmin_corner (1)
            chmax (ibeg-1) = array (ibeg)
         else
            chmin (ibeg-1) = array (ibeg)
            chmax (ibeg-1) = chmax_corner (1)
         endif
!
         if (array (iend) == chmax (iend-1) ) then
            chmin (iend) = array (iend)
            chmax (iend) = chmax_corner (2)
         else
            chmin (iend) = chmin_corner (2)
            chmax (iend) = array (iend)
         endif
!
      endif
!
!===> All done
!
#ifdef VERBOSE
      print 9980, trim(ch_id), ierror

      call psmile_flushstd
#endif /* VERBOSE */
!
!  Formats:
!
9990 format (1x, a, ': psmile_bbcells_1d_dble')
9980 format (1x, a, ': psmile_bbcells_1d_dble: eof ierror =', i3)
!
      end subroutine PSMILe_Bbcells_1d_dble