program TestMono
! File: http://ftp.cac.psu.edu/pub/ger/fortran/hdk/CheckMono.f90
!
! by Mike Metcalf as posted at comp.lang.fortran on 11 December 2006.
! Checks monotonicity of real array values.
! More programs by Mike Metcalf::
!       ftp://stratus.ssec.wisc.edu/pub/fluxnet/fnetall.zip

implicit none
real :: a(3)
integer :: k

print *, " "
print *, "Monotonicity Checks:"
print *, " "

a=(/3.,2., 1./)
k=CheckValueOrder(a,3,3)
print *, "Array=",a," Monotonic=",k

a=(/3.,1., 2./)
k=CheckValueOrder(a,3,3)
print *, "Array=",a," Monotonic=",k

a=(/1.,2., 3./)
k=CheckValueOrder(a,3,3)
print *, "Array=",a," Monotonic=",k

contains

   integer function CheckValueOrder(array,ndata,n)
! Check if the first n elements of array are monotonic
! ndata is the dimension of array.
! CheckValueOrder =0 implies not monotonic.
!                =-1 implies monotonic decreasing.
!                =+1 implies monotonic increasing.

      integer  i, result
      integer, intent(in) ::  n, ndata
      real ::   array(ndata), firstdiff, diff

      i = 2
      result = 1
      do while ((i .le. n) .and. (result .ne. 0))
        if (i .eq. 2) then
          firstdiff = array(2)-array(1)
          if (firstdiff .lt. 0) then  ! e.g., 3.,2.,1.
            result = -1
          else if (firstdiff .gt. 0) then
            result = 1
          else
            result = 0
          end if
        else
          diff = array(i) - array(i-1)
          if ((firstdiff .lt. 0 .and. diff .ge. 0) .or. &
             (firstdiff .gt. 0 .and. diff .le. 0)) result = 0
        end if
        i = i + 1
      end do

      CheckValueOrder = result
   end function CheckValueOrder

end program TestMono