CESM_Driver: shr_vmath_mod.F90 Source File

00001 !===============================================================================
00002 ! SVN $Id: shr_vmath_mod.F90 6752 2007-10-04 21:02:15Z jwolfe $
00003 ! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/branch_tags/cesm1_0_rel_tags/cesm1_0_rel01_share3_100616/shr/shr_vmath_mod.F90 $
00004 !===============================================================================
00005 ! PURPOSE: 
00006 !   provides a uniform, platform-independent API for vector math functions
00007 !===============================================================================
00008 
00009 module shr_vmath_mod
00010 
00011    !----------------------------------------------------------------------------
00012    ! routines that evaluate various math functions for vector arguments
00013    ! intended to provide platform independent access to vendor optimized code
00014    !----------------------------------------------------------------------------
00015 
00016    use shr_kind_mod
00017    use shr_log_mod, only: s_loglev  => shr_log_Level
00018    use shr_log_mod, only: s_logunit => shr_log_Unit
00019 
00020    implicit none
00021 
00022    private
00023    public :: shr_vmath_sqrt, &
00024       shr_vmath_exp, shr_vmath_log, &
00025       shr_vmath_sin, shr_vmath_cos, &
00026       shr_vmath_rsqrt, shr_vmath_div
00027 
00028    contains
00029 
00030 !===============================================================================
00031 
00032 subroutine shr_vmath_sqrt(X, Y, n)
00033 
00034    !----- arguments ---
00035    integer(SHR_KIND_IN),intent(in)  ::   n  ! vector length
00036    real   (SHR_KIND_R8),intent(in)  :: X(n) ! input vector argument
00037    real   (SHR_KIND_R8),intent(out) :: Y(n) ! output vector argument
00038 
00039 !-------------------------------------------------------------------------------
00040 ! PURPOSE: sqrt for vector arguments, optimized on different platforms
00041 !-------------------------------------------------------------------------------
00042 
00043 #if (defined NO_SHR_VMATH)
00044    Y = sqrt(X)
00045 #else
00046 
00047 #if (defined AIX)
00048    call vsqrt(Y, X, n)
00049 #endif
00050 
00051 #if (defined IRIX64)
00052    call shr_vmath_fwrap_vsqrt(X, Y, n)
00053 #endif
00054 
00055 #if (defined OSF1)
00056    call vsqrt(X, 1, Y, 1, n)
00057 #endif
00058 
00059 #if (!defined AIX && !defined IRIX64 && !defined OSF1)
00060    Y = sqrt(X)
00061 #endif
00062 #endif
00063 
00064 end subroutine shr_vmath_sqrt
00065 
00066 !===============================================================================
00067 
00068 subroutine shr_vmath_rsqrt(X, Y, n)
00069 
00070    !----- arguments ---
00071    integer(SHR_KIND_IN),intent(in)  ::   n  ! vector length
00072    real   (SHR_KIND_R8),intent(in)  :: X(n) ! input vector argument
00073    real   (SHR_KIND_R8),intent(out) :: Y(n) ! output vector argument
00074 
00075 !-------------------------------------------------------------------------------
00076 ! PURPOSE: sqrt for vector arguments, optimized on different platforms
00077 !-------------------------------------------------------------------------------
00078 
00079 #if (defined NO_SHR_VMATH)
00080    Y = 1.0_SHR_KIND_R8/sqrt(X)
00081 #else
00082 
00083 #if (defined AIX)
00084    call vrsqrt(Y, X, n)
00085 #endif
00086 
00087 #if (!defined AIX)
00088    Y = 1.0_SHR_KIND_R8/sqrt(X)
00089 #endif
00090 #endif
00091 
00092 end subroutine shr_vmath_rsqrt
00093 
00094 !===============================================================================
00095 
00096 subroutine shr_vmath_exp(X, Y, n)
00097 
00098    !----- arguments ---
00099    integer(SHR_KIND_IN),intent(in)  ::   n  ! vector length
00100    real   (SHR_KIND_R8),intent(in)  :: X(n) ! input vector argument
00101    real   (SHR_KIND_R8),intent(out) :: Y(n) ! output vector argument
00102 
00103 !-------------------------------------------------------------------------------
00104 ! PURPOSE: exp for vector arguments, optimized on different platforms
00105 !-------------------------------------------------------------------------------
00106 
00107 #if (defined NO_SHR_VMATH)
00108    Y = exp(X)
00109 #else
00110 
00111 #if (defined AIX)
00112    call vexp(Y, X, n)
00113 #endif
00114 
00115 #if (defined IRIX64)
00116    call shr_vmath_fwrap_vexp(X, Y, n)
00117 #endif
00118 
00119 #if (defined OSF1)
00120    call vexp(X, 1, Y, 1, n)
00121 #endif
00122 
00123 #if (!defined AIX && !defined IRIX64 && !defined OSF1)
00124    Y = exp(X)
00125 #endif
00126 #endif
00127 
00128 end subroutine shr_vmath_exp
00129 
00130 !===============================================================================
00131 
00132 subroutine shr_vmath_div(X, Y, Z, n)
00133    !----- arguments ---
00134    integer(SHR_KIND_IN),intent(in)  ::   n  ! vector length
00135    real   (SHR_KIND_R8),intent(in)  :: X(n) ! input vector argument
00136    real   (SHR_KIND_R8),intent(in)  :: Y(n) ! input vector argument
00137    real   (SHR_KIND_R8),intent(out) :: Z(n) ! output vector argument
00138 
00139 #if (defined NO_SHR_VMATH)
00140    integer :: i
00141    do i=1,n
00142       Z(i) = X(i)/Y(i)
00143    enddo
00144 #else
00145 #if (defined AIX)
00146    call vdiv(Z,X,Y,n)
00147 #else
00148    integer :: i
00149    do i=1,n
00150       Z(i) = X(i)/Y(i)
00151    enddo
00152 #endif
00153 #endif
00154    return
00155  end subroutine shr_vmath_div
00156 
00157 !===============================================================================
00158 
00159 subroutine shr_vmath_log(X, Y, n)
00160 
00161    !----- arguments ---
00162    integer(SHR_KIND_IN),intent(in)  ::   n  ! vector length
00163    real   (SHR_KIND_R8),intent(in)  :: X(n) ! input vector argument
00164    real   (SHR_KIND_R8),intent(out) :: Y(n) ! output vector argument
00165 
00166 !-------------------------------------------------------------------------------
00167 ! PURPOSE: log for vector arguments, optimized on different platforms
00168 !-------------------------------------------------------------------------------
00169 
00170 #if (defined NO_SHR_VMATH)
00171    Y = log(X)
00172 #else
00173 
00174 #if (defined AIX)
00175    call vlog(Y, X, n)
00176 #endif
00177 
00178 #if (defined IRIX64)
00179    call shr_vmath_fwrap_vlog(X, Y, n)
00180 #endif
00181 
00182 #if (defined OSF1)
00183    call vlog(X, 1, Y, 1, n)
00184 #endif
00185 
00186 #if (!defined AIX && !defined IRIX64 && !defined OSF1)
00187    Y = log(X)
00188 #endif
00189 #endif
00190 
00191 end subroutine shr_vmath_log
00192 
00193 !===============================================================================
00194 
00195 subroutine shr_vmath_sin(X, Y, n)
00196 
00197    !----- arguments ---
00198    integer(SHR_KIND_IN),intent(in)  ::   n  ! vector length
00199    real   (SHR_KIND_R8),intent(in)  :: X(n) ! input vector argument
00200    real   (SHR_KIND_R8),intent(out) :: Y(n) ! output vector argument
00201 
00202 !-------------------------------------------------------------------------------
00203 ! PURPOSE: sin for vector arguments, optimized on different platforms
00204 !-------------------------------------------------------------------------------
00205 
00206 #if (defined NO_SHR_VMATH)
00207    Y = sin(X)
00208 #else
00209 
00210 #if (defined AIX)
00211    call vsin(Y, X, n)
00212 #endif
00213 
00214 #if (defined IRIX64)
00215    call shr_vmath_fwrap_vsin(X, Y, n)
00216 #endif
00217 
00218 #if (defined OSF1)
00219    call vsin(X, 1, Y, 1, n)
00220 #endif
00221 
00222 #if (!defined AIX && !defined IRIX64 && !defined OSF1)
00223    Y = sin(X)
00224 #endif
00225 #endif
00226 
00227 end subroutine shr_vmath_sin
00228 
00229 !===============================================================================
00230 
00231 subroutine shr_vmath_cos(X, Y, n)
00232 
00233    !----- arguments ---
00234    integer(SHR_KIND_IN),intent(in)  ::   n  ! vector length
00235    real   (SHR_KIND_R8),intent(in)  :: X(n) ! input vector argument
00236    real   (SHR_KIND_R8),intent(out) :: Y(n) ! output vector argument
00237 
00238 !-------------------------------------------------------------------------------
00239 ! PURPOSE: cos for vector arguments, optimized on different platforms
00240 !-------------------------------------------------------------------------------
00241 
00242 #if (defined NO_SHR_VMATH)
00243    Y = cos(X)
00244 #else
00245 
00246 #if (defined AIX)
00247    call vcos(Y, X, n)
00248 #endif
00249 
00250 #if (defined IRIX64)
00251    call shr_vmath_fwrap_vcos(X, Y, n)
00252 #endif
00253 
00254 #if (defined OSF1)
00255    call vcos(X, 1, Y, 1, n)
00256 #endif
00257 
00258 #if (!defined AIX && !defined IRIX64 && !defined OSF1)
00259    Y = cos(X)
00260 #endif
00261 #endif
00262 
00263 end subroutine shr_vmath_cos
00264 
00265 !===============================================================================
00266 
00267 end module shr_vmath_mod