Line data    Source code

       1             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       2             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       3             : !!!!                                                                                                                            !!!!
       4             : !!!!    ParaMonte: Parallel Monte Carlo and Machine Learning Library.                                                           !!!!
       5             : !!!!                                                                                                                            !!!!
       6             : !!!!    Copyright (C) 2012-present, The Computational Data Science Lab                                                          !!!!
       7             : !!!!                                                                                                                            !!!!
       8             : !!!!    This file is part of the ParaMonte library.                                                                             !!!!
       9             : !!!!                                                                                                                            !!!!
      10             : !!!!    LICENSE                                                                                                                 !!!!
      11             : !!!!                                                                                                                            !!!!
      12             : !!!!       https://github.com/cdslaborg/paramonte/blob/main/LICENSE.md                                                          !!!!
      13             : !!!!                                                                                                                            !!!!
      14             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      15             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      16             : 
      17             : !>  \brief
      18             : !>  This include file contains procedure implementation of [pm_mathExp](@ref pm_mathExp).
      19             : !>
      20             : !>  \finmain
      21             : !>
      22             : !>  \author
      23             : !>  \AmirShahmoradi, April 25, 2015, 2:21 PM, National Institute for Fusion Studies, The University of Texas at Austin
      24             : 
      25             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      26             : 
      27             :         !%%%%%%%%%%%%%%%
      28             : #if     isIntPow_ENABLED
      29             :         !%%%%%%%%%%%%%%%
      30             : 
      31         231 :         CHECK_ASSERTION(__LINE__, 0_IKC < absx, SK_"@getExpNext(): The condition `0 < absx` must hold. absx = "//getStr(absx))
      32             : #if     Def_ENABLED
      33         224 :         powisint = logical(popcnt(absx) == 1, LK)
      34             : #elif   Arb_ENABLED
      35           7 :         CHECK_ASSERTION(__LINE__, 1_IKC <= base, SK_"@getExpNext(): The condition `0 <= base` must hold. base = "//getStr(base))
      36             :         powisint = .false._LK
      37             :         block
      38             :             integer(IKC) :: quotient, dividend
      39           0 :             dividend = absx
      40           0 :             do
      41           9 :                 quotient = dividend / base
      42           9 :                 if (quotient * base /= dividend) return
      43           4 :                 if (quotient == 1_IKC) exit
      44           2 :                 dividend = quotient
      45             :             end do
      46             :             powisint = .true._LK
      47             :         end block
      48             : #else
      49             : #error  "Unrecognized interface."
      50             : #endif
      51             : 
      52             :         !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      53             : #elif   getExpNext_ENABLED || getExpPrev_ENABLED
      54             :         !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      55             : 
      56             :         ! Define the rounding mode.
      57             : #if     getExpNext_ENABLED
      58             : #define GET_ROUND(X) ceiling(X, kind = IKC)
      59             : #define EXPONENT expNext
      60             : #elif   getExpPrev_ENABLED
      61             : #define GET_ROUND(X) floor(X, kind = IKC)
      62             : #define EXPONENT expPrev
      63             : #else
      64             : #error  "Unrecognized interface."
      65             : #endif
      66             :         ! Compute the exponent.
      67             : #if     IK_ENABLED
      68             :         !>  \devnote
      69             :         !>  A `real` value of kind \RK32 can represent `integer` values as large as `huge(1_int128) = 170141183460469231731687303715884105727 = 1.70141183E+38 < huge(1._RK32) = 3.40282347E+38 << huge(1._RK64)`.<br>
      70             :         !>  One can envision a distant future human society with advanced computers capable of representing higher precision integer value for which \RK32 or \RK64 would be insufficient.<br>
      71             :         use pm_kind, only: RKC => RKH
      72             :         integer(IKC), parameter :: ZERO = 0_IKC
      73             : #define GET_REAL(x) real(x, RKC)
      74             : #elif   RK_ENABLED
      75             : #define GET_REAL(x) x
      76             :         integer, parameter :: IKC = IK
      77             :         real(RKC), parameter :: ZERO = 0._RKC
      78             : #else
      79             : #error  "Unrecognized interface."
      80             : #endif
      81             :         real(RKC), parameter :: INV_LOG_TWO = 1._RKC / log(2._RKC)
      82       10850 :         CHECK_ASSERTION(__LINE__, 0 < absx, SK_"@getExpNext(): The condition `0 < absx` must hold. absx = "//getStr(absx))
      83       10850 :         if (present(base)) then
      84        9028 :             CHECK_ASSERTION(__LINE__, 1._RKC < GET_REAL(base), SK_"@getExpNext(): The condition `1._RKC < base` must hold. base = "//getStr(base))
      85        9028 :             EXPONENT = GET_ROUND(log(GET_REAL(absx)) / log(GET_REAL(base)))
      86             :         else ! assume the base is 2
      87        1822 :             EXPONENT = GET_ROUND(log(GET_REAL(absx)) * INV_LOG_TWO)
      88             :         end if
      89             : #undef  GET_ROUND
      90             : #undef  GET_REAL
      91             : #undef  EXPONENT
      92             : 
      93             : #else
      94             :         !%%%%%%%%%%%%%%%%%%%%%%%%
      95             : #error  "Unrecognized interface."
      96             :         !%%%%%%%%%%%%%%%%%%%%%%%%
      97             : #endif