!===============================================================================
! CVS: $Id: shr_vmath_mod.F90,v 1.2.4.1 2004/01/02 18:50:56 mvr Exp $
! CVS: $Source: /fs/cgd/csm/models/CVS.REPOS/shared/csm_share/shr/shr_vmath_mod.F90,v $
! CVS: $Name: cam3_0_brnchT_release01 $
!===============================================================================
! PURPOSE: 
!   provides a uniform, platform-independent API for vector math functions
!===============================================================================


module shr_vmath_mod,1

   !----------------------------------------------------------------------------
   ! routines that evaluate various math functions for vector arguments
   ! intended to provide platform independent access to vendor optimized code
   !----------------------------------------------------------------------------

   use shr_kind_mod

   implicit none

   private
   public :: shr_vmath_sqrt, &
      shr_vmath_exp, shr_vmath_log, &
      shr_vmath_sin, shr_vmath_cos, &
      shr_vmath_rsqrt, shr_vmath_div

   contains

!===============================================================================


subroutine shr_vmath_sqrt(X, Y, n)

   !----- arguments ---
   integer(SHR_KIND_IN),intent(in)  ::   n  ! vector length
   real   (SHR_KIND_R8),intent(in)  :: X(n) ! input vector argument
   real   (SHR_KIND_R8),intent(out) :: Y(n) ! output vector argument

!-------------------------------------------------------------------------------
! PURPOSE: sqrt for vector arguments, optimized on different platforms
!-------------------------------------------------------------------------------

#if (defined NO_SHR_VMATH)
   Y = sqrt(X)
#else

#if (defined AIX)
   call vsqrt(Y, X, n)
#endif

#if (defined IRIX64)
   call shr_vmath_fwrap_vsqrt(X, Y, n)
#endif

#if (defined OSF1)
   call vsqrt(X, 1, Y, 1, n)
#endif

#if (!defined AIX && !defined IRIX64 && !defined OSF1)
   Y = sqrt(X)
#endif
#endif

end subroutine shr_vmath_sqrt

!===============================================================================


subroutine shr_vmath_rsqrt(X, Y, n)

   !----- arguments ---
   integer(SHR_KIND_IN),intent(in)  ::   n  ! vector length
   real   (SHR_KIND_R8),intent(in)  :: X(n) ! input vector argument
   real   (SHR_KIND_R8),intent(out) :: Y(n) ! output vector argument

!-------------------------------------------------------------------------------
! PURPOSE: sqrt for vector arguments, optimized on different platforms
!-------------------------------------------------------------------------------

#if (defined NO_SHR_VMATH)
   Y = 1.0/sqrt(X)
#else

#if (defined AIX)
   call vrsqrt(Y, X, n)
#endif

#if (!defined AIX)
   Y = 1.0/sqrt(X)
#endif
#endif

end subroutine shr_vmath_rsqrt

!===============================================================================


subroutine shr_vmath_exp(X, Y, n)

   !----- arguments ---
   integer(SHR_KIND_IN),intent(in)  ::   n  ! vector length
   real   (SHR_KIND_R8),intent(in)  :: X(n) ! input vector argument
   real   (SHR_KIND_R8),intent(out) :: Y(n) ! output vector argument

!-------------------------------------------------------------------------------
! PURPOSE: exp for vector arguments, optimized on different platforms
!-------------------------------------------------------------------------------

#if (defined NO_SHR_VMATH)
   Y = exp(X)
#else

#if (defined AIX)
   call vexp(Y, X, n)
#endif

#if (defined IRIX64)
   call shr_vmath_fwrap_vexp(X, Y, n)
#endif

#if (defined OSF1)
   call vexp(X, 1, Y, 1, n)
#endif

#if (!defined AIX && !defined IRIX64 && !defined OSF1)
   Y = exp(X)
#endif
#endif

end subroutine shr_vmath_exp

!===============================================================================


subroutine shr_vmath_div(X, Y, Z, n)
   !----- arguments ---
   integer(SHR_KIND_IN),intent(in)  ::   n  ! vector length
   real   (SHR_KIND_R8),intent(in)  :: X(n) ! input vector argument
   real   (SHR_KIND_R8),intent(in)  :: Y(n) ! input vector argument
   real   (SHR_KIND_R8),intent(out) :: Z(n) ! output vector argument

#if (defined NO_SHR_VMATH)
   integer :: i
   do i=1,n
      Z(i) = X(i)/Y(i)
   enddo
#else
#if (defined AIX)
   call vdiv(Z,X,Y,n)
#else
   integer :: i
   do i=1,n
      Z(i) = X(i)/Y(i)
   enddo
#endif
#endif
   return
 end subroutine shr_vmath_div

!===============================================================================


subroutine shr_vmath_log(X, Y, n)

   !----- arguments ---
   integer(SHR_KIND_IN),intent(in)  ::   n  ! vector length
   real   (SHR_KIND_R8),intent(in)  :: X(n) ! input vector argument
   real   (SHR_KIND_R8),intent(out) :: Y(n) ! output vector argument

!-------------------------------------------------------------------------------
! PURPOSE: log for vector arguments, optimized on different platforms
!-------------------------------------------------------------------------------

#if (defined NO_SHR_VMATH)
   Y = log(X)
#else

#if (defined AIX)
   call vlog(Y, X, n)
#endif

#if (defined IRIX64)
   call shr_vmath_fwrap_vlog(X, Y, n)
#endif

#if (defined OSF1)
   call vlog(X, 1, Y, 1, n)
#endif

#if (!defined AIX && !defined IRIX64 && !defined OSF1)
   Y = log(X)
#endif
#endif

end subroutine shr_vmath_log

!===============================================================================


subroutine shr_vmath_sin(X, Y, n)

   !----- arguments ---
   integer(SHR_KIND_IN),intent(in)  ::   n  ! vector length
   real   (SHR_KIND_R8),intent(in)  :: X(n) ! input vector argument
   real   (SHR_KIND_R8),intent(out) :: Y(n) ! output vector argument

!-------------------------------------------------------------------------------
! PURPOSE: sin for vector arguments, optimized on different platforms
!-------------------------------------------------------------------------------

#if (defined NO_SHR_VMATH)
   Y = sin(X)
#else

#if (defined AIX)
   call vsin(Y, X, n)
#endif

#if (defined IRIX64)
   call shr_vmath_fwrap_vsin(X, Y, n)
#endif

#if (defined OSF1)
   call vsin(X, 1, Y, 1, n)
#endif

#if (!defined AIX && !defined IRIX64 && !defined OSF1)
   Y = sin(X)
#endif
#endif

end subroutine shr_vmath_sin

!===============================================================================


subroutine shr_vmath_cos(X, Y, n)

   !----- arguments ---
   integer(SHR_KIND_IN),intent(in)  ::   n  ! vector length
   real   (SHR_KIND_R8),intent(in)  :: X(n) ! input vector argument
   real   (SHR_KIND_R8),intent(out) :: Y(n) ! output vector argument

!-------------------------------------------------------------------------------
! PURPOSE: cos for vector arguments, optimized on different platforms
!-------------------------------------------------------------------------------

#if (defined NO_SHR_VMATH)
   Y = cos(X)
#else

#if (defined AIX)
   call vcos(Y, X, n)
#endif

#if (defined IRIX64)
   call shr_vmath_fwrap_vcos(X, Y, n)
#endif

#if (defined OSF1)
   call vcos(X, 1, Y, 1, n)
#endif

#if (!defined AIX && !defined IRIX64 && !defined OSF1)
   Y = cos(X)
#endif
#endif

end subroutine shr_vmath_cos

!===============================================================================

end module shr_vmath_mod