fms/include/fms.inc

   1 !***********************************************************************
   2 !*                   GNU Lesser General Public License
   3 !*
   4 !* This file is part of the GFDL Flexible Modeling System (FMS).
   5 !*
   6 !* FMS is free software: you can redistribute it and/or modify it under
   7 !* the terms of the GNU Lesser General Public License as published by
   8 !* the Free Software Foundation, either version 3 of the License, or (at
   9 !* your option) any later version.
  10 !*
  11 !* FMS is distributed in the hope that it will be useful, but WITHOUT
  12 !* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13 !* FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14 !* for more details.
  15 !*
  16 !* You should have received a copy of the GNU Lesser General Public
  17 !* License along with FMS.  If not, see <http://www.gnu.org/licenses/>.
  18 !***********************************************************************
  19
  20 !> @brief Determines if a real input array has values which increase or
  21 !!     decrease with strict monotonicity.
  22 !! @return If the input array of real values either increases or decreases in a strictly monotonic manner,
  23 !!     then true is returned. Otherwise, false is returned.
  24
  25 function MONOTONIC_ARRAY_(array, direction) result(ret)
  26 real(FMS_MOD_KIND_), intent(in) :: array(:) !< An array of real values. If size(array) < 2, this function
  27                                             !! assumes the array is not monotonic; no fatal error will occur
  28                                             !! in this case.
  29 integer, intent(out), optional :: direction !< If the input array is:
  30                                             !! >> strictly monotonic (small to large), then direction = +1.
  31                                             !! >> strictly monotonic (large to small), then direction = -1.
  32                                             !! >> not strictly monotonic, then direction = 0.
  33 logical :: ret                              !< If the input array of real values either increases or
  34                                             !! decreases with strict monotonicity, then TRUE is returned;
  35                                             !! otherwise, FALSE is returned.
  36 integer :: i
  37
  38 ! initialize
  39   ret = .false.
  40   if (present(direction)) direction = 0
  41
  42 ! array too short
  43   if ( size(array(:)) < 2 ) return
  44
  45 ! ascending
  46   if ( array(1) < array(size(array(:))) ) then
  47      do i = 2, size(array(:))
  48        if (array(i-1) < array(i)) cycle
  49        return
  50      enddo
  51      ret = .true.
  52      if (present(direction)) direction = +1
  53
  54 ! descending
  55   else
  56      do i = 2, size(array(:))
  57        if (array(i-1) > array(i)) cycle
  58        return
  59      enddo
  60      ret = .true.
  61      if (present(direction)) direction = -1
  62   endif
  63
  64 end function