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 file contains the implementations of the tests of module [pm_mathExp](@ref pm_mathExp).
      19             : !>
      20             : !>  \fintest
      21             : !>
      22             : !>  \author
      23             : !>  \FatemehBagheri, 12:27 AM Tuesday, February 22, 2022, Dallas, TX
      24             : 
      25             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      26             : 
      27             : #if     IK_ENABLED
      28             :         use pm_kind, only: RKC => RKH
      29             :         integer(IKC), parameter :: LOWER = 2_IKC, UPPER = 100_IKC
      30             :         integer(IKC), parameter :: ZERO = 0_IKC
      31             :         integer(IKC)            :: absx(100)
      32             :         integer(IKC)            :: exponent
      33             : #elif   RK_ENABLED
      34             :         integer(IK)             :: exponent
      35             :         real(RKC)   , parameter :: LOWER = 1.01_RKC, UPPER = 100._RKC
      36             :         real(RKC)   , parameter :: ZERO = 0._RKC
      37             :         real(RKC)               :: absx(100)
      38             : #else
      39             : #error  "Unrecognized interface."
      40             : #endif
      41             : 
      42          18 :         assertion = .true._LK
      43             : 
      44          18 :         call runTestsWith()
      45          18 :         call runTestsWith(base = getUnifRand(LOWER, UPPER))
      46          90 :         call runTestsWith(base = getUnifRand(LOWER, UPPER, s1 = 4_IK))
      47             : 
      48             :         !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      49             : 
      50             :     contains
      51             : 
      52             :         !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      53             : 
      54         108 :         impure elemental subroutine runTestsWith(base)
      55             :             integer(IK) :: i
      56             : #if         IK_ENABLED
      57             :             integer(IKC), intent(in), optional :: base
      58        6060 :             absx = getUnifRand(1_IKC, nint(sqrt(real(huge(0_IKC), RKC)), kind = IKC), size(absx, 1, IK))
      59             : #elif       RK_ENABLED
      60             :             real(RKC), intent(in), optional :: base
      61        4848 :             absx = getUnifRand(2 * epsilon(0._RKC), sqrt(huge(0._RKC)), size(absx, 1, IK))
      62             : #endif
      63       10908 :             do i = 1, size(absx)
      64       10800 :                 exponent = getExpNext(absx(i), base)
      65       10908 :                 call report(absx(i), base)
      66             :             end do
      67             :             !exponent = getExpNext(ZERO, base)
      68             :             !call report(ZERO, base)
      69         108 :         end subroutine
      70             : 
      71             :         !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      72             : 
      73       10800 :         impure elemental subroutine report(absx, base)
      74             : #if         IK_ENABLED
      75             :             integer(IKC), intent(in)            :: absx
      76             :             integer(IKC), intent(in), optional  :: base
      77             :             integer(IKC)                        :: base_def
      78        6000 :             base_def = getOption(2_IKC, base)
      79             : #elif       RK_ENABLED
      80             :             real(RKC)   , intent(in)            :: absx
      81             :             real(RKC)   , intent(in), optional  :: base
      82             :             real(RKC)                           :: base_def
      83        4800 :             base_def = getOption(2._RKC, base)
      84             : #endif
      85       10800 :             assertion = assertion .and. logical(absx <= base_def**exponent, LK)
      86       10800 :             assertion = assertion .and. logical(absx >= base_def**(max(0, int(exponent - 1))) .or. absx == ZERO, LK)
      87       10800 :             if (test%traceable .and. .not. assertion) then
      88             :                 ! LCOV_EXCL_START
      89             :                 call test%disp%skip()
      90             :                 call test%disp%show("exponent")
      91             :                 call test%disp%show( exponent )
      92             :                 call test%disp%show("present(base)")
      93             :                 call test%disp%show( present(base) )
      94             :                 call test%disp%show("base_def")
      95             :                 call test%disp%show( base_def )
      96             : #if             getExpNext_ENABLED
      97             :                 call test%disp%show("[real(RKC) :: base_def**(exponent - 1), absx, base_def**exponent]")
      98             :                 call test%disp%show( [real(RKC) :: base_def**(exponent - 1), absx, base_def**exponent] )
      99             : #elif           getExpPrev_ENABLED
     100             : #else
     101             : #error          "Unrecognized interface."
     102             : #endif
     103             :                 call test%disp%skip()
     104             :                 ! LCOV_EXCL_STOP
     105             :             end if
     106       10800 :             call test%assert(assertion, SK_"The test condition `absx <= base_def**exponent` must hold.", int(__LINE__, IK))
     107       10800 :             call test%assert(assertion, SK_"The test condition `absx >= base_def**(exponent - 1)` must hold.", int(__LINE__, IK))
     108       10800 :         end subroutine