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 implementations of [pm_math1mexp](@ref pm_math1mexp).
      19             : !>
      20             : !>  \finmain
      21             : !>
      22             : !>  \author
      23             : !>  \AmirShahmoradi, Thursday 1:45 AM, August 22, 2019, Dallas, TX
      24             : 
      25             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      26             : 
      27             : #if     CK_ENABLED
      28             :         complex(CKC), parameter :: ONE = cmplx(1._CKC, 0._CKC, CKC), ZERO = cmplx(0._CKC, 0._CKC, CKC)
      29             : #define GET_REAL(x) x%re
      30             : #elif   RK_ENABLED
      31             :         real(RKC)   , parameter :: ONE = 1._RKC, ZERO = 0._RKC
      32             : #define GET_REAL(x) x
      33             : #else
      34             : #error  "Unrecognized interface."
      35             : #endif
      36             :         integer , parameter :: TKC = kind(onemexp) ! This kind current.
      37             : #if     Seq_ENABLED && CK_ENABLED
      38             :         complex(CKC) :: tsterm, i
      39             : #elif   Seq_ENABLED && RK_ENABLED
      40             :         real(RKC) :: tsterm, i
      41             : #elif   Sel_ENABLED
      42             :         real(TKC), parameter :: NEG_LOG_HUGE = -log(huge(0._TKC))
      43             : #else
      44             : #error  "Unrecognized interface."
      45             : #endif
      46      646344 :         CHECK_ASSERTION(__LINE__, real(x, TKC) < log(huge(0._TKC)), \
      47             :         SK_"@get1mexp(): The condition `real(x, TKC) <= huge(0._TKC)` must hold. x = "//getStr(x))
      48             : #if     Seq_ENABLED
      49      646336 :         if (abs(GET_REAL(x)) < log(2._TKC)) then
      50           0 :             onemexp = x
      51       35339 :             tsterm = x
      52       35339 :             i = 1._TKC
      53             :             do
      54     1323748 :                 i = i + ONE
      55     1323748 :                 tsterm = tsterm * x / i
      56     1323748 :                 onemexp = onemexp + tsterm
      57     1323748 :                 if (abs(GET_REAL(tsterm)) > abs(GET_REAL(onemexp)) * epsilon(0._TKC)) cycle
      58     1206771 :                 exit
      59             :             end do
      60      116977 :             onemexp = -onemexp
      61             :         else
      62      529359 :             onemexp = ONE - exp(x)
      63             :         end if
      64             : #elif   Sel_ENABLED
      65             :         ! Is this really needed? any number smaller than tiny? Yes: zero
      66           8 :         if (abs(GET_REAL(x)) < tiny(0._TKC)) then
      67           0 :             onemexp = ONE
      68           8 :         elseif (GET_REAL(x) < NEG_LOG_HUGE) then
      69           0 :             onemexp = ZERO
      70             :         else
      71           8 :             onemexp = get1mexp(x)
      72             :         end if
      73             : #else
      74             : #error  "Unrecognized interface."
      75             : #endif
      76             : 
      77             : #undef  GET_REAL