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_mathCompare](@ref pm_mathCompare).
      19             : !>
      20             : !>  \finmain
      21             : !>
      22             : !>  \author
      23             : !>  \AmirShahmoradi, Sunday 3:33 AM, September 19, 2021, Dallas, TX
      24             : 
      25             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      26             : 
      27             :         use pm_except, only: isNAN
      28             :         use pm_except, only: isInf, isInfNeg, isInfPos
      29             :         integer, parameter :: TKC = kind(x)
      30             :         real(TKC) :: reltol_def, abstol_def
      31             :         real(TKC) :: absDiff
      32             : 
      33     4838769 :         if (isNAN(x) .or. isNAN(y)) then
      34             :             close = .false._LK
      35             :             return
      36             :         end if
      37             : 
      38     4837272 :         if (.not. (isInf(x) .or. isInf(y))) then
      39             : 
      40     4834677 :             close = logical(x == y, LK)
      41     4834677 :             if (close) return
      42             : 
      43      899570 :             if (present(reltol)) then
      44       15346 :                 CHECK_ASSERTION(__LINE__, 0._TKC <= reltol, \
      45             :                 SK_"@isClose(): The condition `0. < reltol` must hold. reltol = "//getStr(reltol)) ! fpp
      46        5385 :                 reltol_def = reltol
      47             :             else
      48      431466 :                 reltol_def = epsilon(0._TKC)
      49             :             end if
      50      899570 :             if (present(abstol)) then
      51      884149 :                 CHECK_ASSERTION(__LINE__, 0._TKC <= abstol, \
      52             :                 SK_"@isClose(): The condition `0. <= abstol` must hold. abstol = "//getStr(abstol)) ! fpp
      53      431429 :                 abstol_def = abstol
      54             :             else
      55        5422 :                 abstol_def = tiny(0._TKC)
      56             :             end if
      57      899570 :             absDiff = abs(y - x)
      58             : #if         isCloseReference_ENABLED
      59         296 :             close = logical(absDiff <= abs(reltol_def * x) .or. absDiff <= abstol_def, LK)
      60             : #elif       isCloseStrong_ENABLED
      61         297 :             close = logical((absDiff <= abs(reltol_def * x) .and. absDiff <= abs(reltol_def * y)) .or. absDiff <= abstol_def, LK)
      62             : #elif       isCloseWeak_ENABLED || isCloseDefault_ENABLED
      63      898716 :             close = logical(absDiff <= abs(reltol_def * x) .or. absDiff <= abs(reltol_def * y) .or. absDiff <= abstol_def, LK)
      64             : #elif       isCloseMean_ENABLED
      65         261 :             close = logical(absDiff <= abs(reltol_def * 0.5_TKC * (x + y)) .or. absDiff <= abstol_def, LK)
      66             : #else
      67             : #error      "Unrecognized interface."
      68             : #endif
      69      899570 :             return
      70             :         end if
      71        2595 :         close = (isInfNeg(x) .and. isInfNeg(y)) .or. (isInfPos(x) .and. isInfPos(y))