srchutil.f90

CCSM Research Tools: Community Atmosphere Model (CAM)

#include <misc.h>
#include <params.h>

module srchutil

!----------------------------------------------------------------------- 
! 
! Purpose: Module containing Fortran equivalents to Cray library functions
!          NOTE: some aspects of this code may not meet the CCM coding standard
! 
! Author: Lifted from Cray manuals
! 
!-----------------------------------------------------------------------
#if (! defined CRAY )

CONTAINS

   integer function ismax (n, sx, incx)
!----------------------------------------------------------------------- 
! 
! Purpose: determine index of array maximum
! 
!-----------------------------------------------------------------------

   use precision

   implicit none
!
! Arguments
!   
   real(r8), intent(in) :: sx(*)        ! array to be searched

   integer, intent(in) :: n             ! number of values to be searched
   integer, intent(in) :: incx          ! increment through array        
!
! Local workspace
!
   integer imax          ! tmp index of max value
   integer i             ! loop index

   real(r8) max          ! maximum value

   max = sx(1)
   imax = 1
   do 100 i=1+incx,n,incx
      if (max .lt. sx(i)) then
         max = sx(i)
         imax = i
      endif
100   continue
      ismax = imax
      return
   end function ismax
 
!===============================================================================

   integer function ismin(n,sx,incx)

   use precision
   
   implicit none
!
! Arguments
!   
   real(r8), intent(in) :: sx(*)  ! array to be searched           

   integer n                      ! number of values to be searched
   integer incx                   ! increment through array        
!
! Local workspace
!
   integer imin                   ! tmp index of min value         
   integer i                      ! loop index                     

   real(r8) min                   ! minimum value                  
   
   min = sx(1)
   imin = 1
   do 100 i=1+incx,n,incx
      if (min .gt. sx(i)) then
         min = sx(i)
         imin = i
      endif
100   continue
      ismin = imin
      return
   end function ismin
 
!===============================================================================

   real*8 function second ()
!----------------------------------------------------------------------- 
! 
! Purpose: placeholder routine for Cray second()
! 
!-----------------------------------------------------------------------

      implicit none

      second = 0.
      return
   end function second
 
!===============================================================================

   subroutine wheneq (n, array, inc, target, index, nval)
!----------------------------------------------------------------------- 
! 
! Purpose: Determine indices of "array" which equal "target"
! 
!-----------------------------------------------------------------------

      implicit none
!
! Arguments
!
      integer, intent(in) :: array(*)    ! array to be searched
      integer, intent(in) :: target      ! value to compare against
      integer, intent(in) :: inc         ! increment to move through array

      integer, intent(out) :: nval       ! number of values meeting criteria
      integer, intent(out) :: index(*)   ! output array of indices
!
! Local workspace
!
      integer :: i
      integer :: n
      integer :: ina

      ina=1
      nval=0
      if (inc .lt. 0) ina=(-inc)*(n-1)+1
      do i=1,n
         if(array(ina) .eq. target) then
           nval=nval+1
           index(nval)=i
         end if
         ina=ina+inc
      enddo
      return
   end subroutine wheneq

#endif

end module srchutil