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 procedure implementations of [pm_arrayRange](@ref pm_arrayRange).
      19             : !>
      20             : !>  \finmain
      21             : !>
      22             : !>  \author
      23             : !>  \FatemehBagheri, Wednesday 12:20 PM, September 22, 2021, Dallas, TX
      24             : 
      25             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      26             : 
      27             : #if     !(getRange_ENABLED || setRange_ENABLED)
      28             : #error  "Unrecognized interface."
      29             : #endif
      30             :         ! Set the sizing function.
      31             : #if     D0_ENABLED && SK_ENABLED
      32             :         use pm_kind, only: IKC => IK
      33             :         integer(IKC) :: index
      34             : #define GET_INDEX(i) i:i
      35             : #define GET_SIZE len
      36             : #elif   D1_ENABLED && (IK_ENABLED || RK_ENABLED)
      37             : #define GET_INDEX(i) i
      38             : #define GET_SIZE size
      39             : #else
      40             : #error  "Unrecognized interface."
      41             : #endif
      42             :         !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      43             : #if     (SK_ENABLED || IK_ENABLED) && (D0_ENABLED || D1_ENABLED)
      44             :         !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      45             : 
      46             :         integer(IKC) :: lenRange, irange
      47             : #if     Unit_ENABLED && getRange_ENABLED
      48             :         integer(IKC) :: step
      49      129824 :         if (start < stop) then
      50           2 :             step = 1_IKC
      51             :         else
      52           2 :             step = -1_IKC
      53             :         end if
      54             : #elif   Unit_ENABLED
      55             :         integer(IKC), parameter :: step = 1_IKC
      56             : #elif   Step_ENABLED
      57        6442 :         CHECK_ASSERTION(__LINE__, step /= 0_IKC, SK_"@setRange(): The condition `step /= 0` must hold. step = "//getStr(step))
      58             : #else
      59             : #error  "Unrecognized interface."
      60             : #endif
      61      147576 :         lenRange = GET_SIZE(range, kind = IKC)
      62             : #if     SK_ENABLED && D0_ENABLED
      63           8 :         index = ichar(start, IKC)
      64             : #endif
      65       17756 :         if (0_IKC < lenRange) then
      66      145950 :             range(GET_INDEX(1_IKC)) = start
      67      701153 :             do irange = 2_IKC, lenRange
      68             : #if             SK_ENABLED
      69        2252 :                 index = index + step
      70        3140 :                 range(GET_INDEX(irange)) = char(index, SKC)
      71             : #elif           IK_ENABLED
      72      698013 :                 range(GET_INDEX(irange)) = range(GET_INDEX(irange - 1_IKC)) + step
      73             : #else
      74             : #error          "Unrecognized interface."
      75             : #endif
      76             :             end do
      77             :         end if
      78             : 
      79             :         !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      80             : #elif   D1_ENABLED && RK_ENABLED && Unit_ENABLED && getRange_ENABLED
      81             :         !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      82             : 
      83             :         real(RKC) :: direction, next
      84             :         integer(IK) :: iell, nell
      85          15 :         direction = stop - start
      86          15 :         if (0._RKC < direction) then
      87           6 :             iell = 1; nell = 127
      88           6 :             call setResized(range, nell)
      89           6 :             range(iell) = start
      90             :             do
      91        4044 :                 if (iell < nell) then
      92        4026 :                     next = nearest(range(iell), direction)
      93        4026 :                     if (stop < next) exit
      94        4020 :                     iell = iell + 1
      95        4020 :                     range(iell) = next
      96             :                 else
      97          12 :                     nell = 2 * nell
      98          12 :                     call setResized(range, nell)
      99             :                 end if
     100             :             end do
     101        8064 :             range = range(1:iell)
     102           9 :         elseif (direction < 0._RKC) then
     103           5 :             iell = 1; nell = 127
     104           5 :             call setResized(range, nell)
     105           5 :             range(iell) = start
     106             :             do
     107          38 :                 if (iell < nell) then
     108          33 :                     next = nearest(range(iell), direction)
     109          33 :                     if (next < stop) exit
     110          28 :                     iell = iell + 1
     111          28 :                     range(iell) = next
     112             :                 else
     113           0 :                     nell = 2 * nell
     114           0 :                     call setResized(range, nell)
     115             :                 end if
     116             :             end do
     117          76 :             range = range(1:iell)
     118           4 :         elseif (0._RKC == direction) then
     119          12 :             range = [start]
     120             :         end if
     121             : 
     122             :         !%%%%%%%%%%%%%%%%%%%%%%%
     123             : #elif   D1_ENABLED && RK_ENABLED
     124             :         !%%%%%%%%%%%%%%%%%%%%%%%
     125             : 
     126             :         real(RKC), parameter :: direction = 1._RKC
     127             :         integer(IK) :: iell, nell
     128             : #if     Step_ENABLED
     129        3244 :         CHECK_ASSERTION(__LINE__, step /= 0._RKC, SK_"@setRange(): The condition `step /= 0` must hold. step = "//getStr(step))
     130             : #endif
     131        3251 :         nell = size(range, 1, IK)
     132        3251 :         if (nell == 0_IK) return
     133        3243 :         range(1) = start
     134        5352 :         do iell = 2, nell
     135             : #if         Unit_ENABLED && setRange_ENABLED
     136          42 :             range(iell) = nearest(range(iell - 1), direction)
     137             : #elif       Step_ENABLED && (getRange_ENABLED || setRange_ENABLED)
     138        5310 :             range(iell) = range(iell - 1) + step
     139             : #else
     140             : #error      "Unrecognized interface."
     141             : #endif
     142             :         end do
     143             : 
     144             : #else
     145             :         !%%%%%%%%%%%%%%%%%%%%%%%%
     146             : #error  "Unrecognized interface."
     147             :         !%%%%%%%%%%%%%%%%%%%%%%%%
     148             : #endif
     149             : #undef  GET_INDEX
     150             : #undef  GET_SIZE