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_mathNumSys](@ref pm_mathNumSys).
      19             : !>
      20             : !>  \finmain
      21             : !>
      22             : !>  \author
      23             : !>  \AmirShahmoradi, Sunday 3:33 AM, September 19, 2021, Dallas, TX
      24             : 
      25             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      26             : 
      27             : #if     getDecimal_ENABLED || getNumeral_ENABLED
      28             :         character(*,SKC), parameter :: NUM_ALPHA = SKC_"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
      29             : #endif
      30             : 
      31             :         !%%%%%%%%%%%%%%%%%
      32             : #if     getDecimal_ENABLED
      33             :         !%%%%%%%%%%%%%%%%%
      34             : 
      35             :         integer(IKC) :: i, numlen
      36          42 :         numlen = len(numeral, IKC)
      37          42 :         CHECK_ASSERTION(__LINE__, base > 0_IKC, SK_"@getDecimal(): The input `base` must be positive integer. base = "//getStr(base))
      38          42 :         CHECK_ASSERTION(__LINE__, numlen > 0_IKC, SK_"@getDecimal(): The input `numeral` must be non-empty. len(numeral) = "//getStr(numlen))
      39             :         !   \todo
      40             :         !   \pvhigh
      41             :         !   \warning
      42             :         !   The presence of `getStr()` in the followng statement `getStr(numeral), getStr(NUM_ALPHA(1:base))` is because of GNU gfortran bug as of version 11,
      43             :         !   which mistakenly converts the kind of a slices string to the default kind. It MUST be removed as soon as the gfortran bug is resolved.
      44          42 :         CHECK_ASSERTION(__LINE__, verify(getStr(numeral), getStr(NUM_ALPHA(1:base)), kind = IKC) == 0_IKC, \
      45             :         SK_"@getDecimal(): The input `numeral` must be only ASCII digits and the first `base` upper-case English alphabets. base, numeral, NUM_ALPHA(1:base) = " \
      46             :         //getStr(base)//SK_", "//getStr(numeral)//SK_", "//getStr(NUM_ALPHA(1:base)))
      47           0 :         decimal = 0_IKC
      48         222 :         do i = 1_IKC, numlen
      49             :             !   \todo
      50             :             !   \pvhigh
      51             :             !   \warning
      52             :             !   The following fence bypasses gfortran bug as of Version 11. It MUST be removed as soon as GFortran bug is resolved.
      53             : #if         __GFORTRAN__
      54          42 :             block
      55             :                 character(1,SKC) :: numeral_char
      56         180 :                 numeral_char = numeral(i:i)
      57         180 :             decimal = decimal + (index(NUM_ALPHA, numeral_char, kind = IKC) - 1_IKC) * base**(numlen - i)
      58             :             end block
      59             : #else
      60             :             decimal = decimal + (index(NUM_ALPHA, numeral(i:i), kind = IKC) - 1_IKC) * base**(numlen - i)
      61             : #endif
      62             :         end do
      63             : 
      64             :         !%%%%%%%%%%%%%%%%%
      65             : #elif   getNumeral_ENABLED
      66             :         !%%%%%%%%%%%%%%%%%
      67             : 
      68             :         !   \todo
      69             :         !   \warning
      70             :         !   `RK64` is good for handling integers as big as `huge(1_int1024)` that has 306 digits:
      71             :         !   7022238808055921514567598401519627865695222573993385049743362545223932648652381372371
      72             :         !   4248954065443758250044484324763030335464753443131493161268527593544579835065583369088
      73             :         !   0801860555545317367555154113605281582053784524026102900245630757473088050106395169337
      74             :         !   932361665227499793929447186391815763110662594625536
      75             :         !   As of 2022, the largest integer kind is made available by GNU Fortran compiler as `int128` whose huge has only 39 digits: 170141183460469231731687303715884105728
      76             :         integer, parameter :: RK64 = selected_real_kind(15)
      77             :         integer(IKC) :: remainderPlusOne, lamiced
      78             :         integer(IK) :: i, numlen
      79           8 :         CHECK_ASSERTION(__LINE__, range(0_IKC) < precision(0._RK64), \
      80             :         SK_"@getNumeral(): Hello, the distant future user. The condition `range(0_IKC) < precision(0._RK64)` must hold. This is an internal library limitation. Please report this to the developers if they are still alive.")
      81           8 :         CHECK_ASSERTION(__LINE__, base > 0_IKC, SK_"@getNumeral(): The input `base` must be a positive number. base = "//getStr(base))
      82           8 :         CHECK_ASSERTION(__LINE__, decimal > 0_IKC, SK_"@getNumeral(): The input `decimal` must be a positive number. decimal = "//getStr(decimal))
      83           8 :         numlen = int(log10(real(huge(1_IKC),RK64)) / log10(real(base,RK64)), IK) + 1_IK
      84           8 :         allocate(character(numlen,SKC) :: numeral)
      85           0 :         lamiced = decimal
      86          56 :         do i = numlen, 1_IK, -1_IK
      87          56 :             if(lamiced < base) then
      88           8 :                 numeral(i:i) = NUM_ALPHA(lamiced + 1_IK : lamiced + 1_IK)
      89           8 :                 exit
      90             :             end if
      91          48 :             remainderPlusOne = mod(lamiced, base) + 1_IKC
      92          48 :             numeral(i:i) = NUM_ALPHA(remainderPlusOne : remainderPlusOne)
      93          48 :             lamiced = lamiced / base
      94             :         end do
      95           8 :         CHECK_ASSERTION(__LINE__, i > 0_IK, SK_"@getNumeral(): Internal library error occured: i < 1. i = "//getStr(i))
      96           8 :         numeral = numeral(i:numlen)
      97             : 
      98             :         !%%%%%%%%%%%%%%%%%%%%
      99             : #elif   getCountDigit_ENABLED
     100             :         !%%%%%%%%%%%%%%%%%%%%
     101             : 
     102             : #if     1
     103             :         integer(IKC) :: lav
     104         181 :         lav = val / 10_IKC
     105             :         count = 1_IK
     106         574 :         do
     107         755 :             if (lav == 0_IKC) exit
     108         574 :             count = count + 1_IK
     109         574 :             lav = lav / 10_IKC
     110             :         end do
     111             : #else
     112             :         !   \todo
     113             :         !   \warning
     114             :         !   `RK64` is good for handling integers as big as `huge(1_int1024)` that has 306 digits:
     115             :         !   7022238808055921514567598401519627865695222573993385049743362545223932648652381372371
     116             :         !   4248954065443758250044484324763030335464753443131493161268527593544579835065583369088
     117             :         !   0801860555545317367555154113605281582053784524026102900245630757473088050106395169337
     118             :         !   932361665227499793929447186391815763110662594625536
     119             :         !   As of 2022, the largest integer kind is made available by GNU Fortran compiler as `int128` whose huge has only 39 digits: 170141183460469231731687303715884105728
     120             :         !   \todo
     121             :         !   The performance of this algorithm can be improved by converting the integer values to appropriate reals with lower precision than RK64.
     122             :         integer, parameter :: RK64 = selected_real_kind(15)
     123             :         count = int(log10(real(abs(lav), RK64))) + 1_IK
     124             : #endif
     125             : 
     126             :         !%%%%%%%%%%%%%%%%%
     127             : #else
     128             : #error  "Unrecognized interface."
     129             : #endif
     130             :         !%%%%%%%%%%%%%%%%%