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 implementation details of the routines of the module [pm_arrayResize](@ref pm_arrayResize).
      19             : !>
      20             : !>  \finmain
      21             : !>
      22             : !>  \author
      23             : !>  \FatemehBagheri, Wednesday 12:20 AM, October 13, 2021, Dallas, TX
      24             : 
      25             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      26             : 
      27             :         ! Set the indexing rule.
      28             : #if     D0_ENABLED && SK_ENABLED
      29             : #define GET_INDEX(i) i:i
      30             : #define GET_SIZE len
      31             : #elif   D1_ENABLED
      32             : #define GET_INDEX(i) i
      33             : #define GET_SIZE size
      34             : #else
      35             : #error  "Unrecognized interface."
      36             : #endif
      37             :         !%%%%%%%%%%%%%%%%%%
      38             : #if     getShuffled_ENABLED
      39             :         !%%%%%%%%%%%%%%%%%%
      40             : 
      41         488 :         integer(IK) :: i, index(GET_SIZE(array, kind = IK))
      42         244 :         if (present(count)) then
      43         120 :             do concurrent(i = 1_IK : size(index, 1, IK))
      44         757 :                 index(i) = i
      45             :             end do
      46         120 :             call setShuffled(index, count)
      47             : #if         D0_ENABLED && SK_ENABLED
      48          13 :             allocate(character(count,SKC) :: arrayShuffled)
      49             : #elif       D1_ENABLED && SK_ENABLED
      50          26 :             allocate(character(len(array,IK),SKC) :: arrayShuffled(count))
      51             : #elif       D1_ENABLED
      52          96 :             allocate(arrayShuffled(count))
      53             : #else
      54             : #error      "Unrecognized interface."
      55             : #endif
      56             :             do concurrent(i = 1_IK : count)
      57         472 :                 arrayShuffled(GET_INDEX(i)) = array(GET_INDEX(index(i)))
      58             :             end do
      59             :         else
      60         836 :             arrayShuffled = array
      61         124 :             call setShuffled(arrayShuffled)
      62             :         end if
      63             : 
      64             :         !%%%%%%%%%%%%%%%%%%
      65             : #elif   setShuffled_ENABLED
      66             :         !%%%%%%%%%%%%%%%%%%
      67             : 
      68             : #if     D0_ENABLED && SK_ENABLED
      69             :         character(1,SKC) :: temp
      70             : #elif   D1_ENABLED && SK_ENABLED
      71          51 :         character(len(array,IK),SKC) :: temp
      72             : #elif   D1_ENABLED && IK_ENABLED
      73             :         integer(IKC) :: temp
      74             : #elif   D1_ENABLED && LK_ENABLED
      75             :         logical(LKC) :: temp
      76             : #elif   D1_ENABLED && CK_ENABLED
      77             :         complex(CKC) :: temp
      78             : #elif   D1_ENABLED && RK_ENABLED
      79             :         real(RKC) :: temp
      80             : #elif   D1_ENABLED && PSSK_ENABLED
      81             :         type(css_pdt(SKC)) :: temp
      82             : #elif   D1_ENABLED && BSSK_ENABLED
      83           2 :         type(css_type) :: temp
      84             : #else
      85             : #error  "Unrecognized interface."
      86             : #endif
      87             :         integer(IK) :: lenArray, index, randLoc
      88             : #if     RNGD_ENABLED
      89             : #define RNG
      90             : #elif   RNGF_ENABLED || RNGX_ENABLED
      91             : #define RNG rng,
      92             : #else
      93             : #error  "Unrecognized interface"
      94             : #endif
      95             :         !lenArray = GET_SIZE(array, kind = IK)
      96             :         !do index = lenArray, 2_IK, -1_IK
      97             :         !    call setUnifRand(rng, randLoc, 1_IK, index)
      98             :         !    temp = array(GET_INDEX(randLoc))
      99             :         !    array(GET_INDEX(randLoc)) = array(GET_INDEX(index))
     100             :         !    array(GET_INDEX(index)) = temp
     101             :         !end do
     102       12185 :         lenArray = GET_SIZE(array, kind = IK)
     103       12185 :         if (present(count)) then
     104       11657 :             CHECK_ASSERTION(__LINE__, 0_IK <= count, SK_"@setShuffled(): The condition `0 <= count` must hold. count = "//getStr(count)) ! fpp
     105       34971 :             CHECK_ASSERTION(__LINE__, count <= lenArray, SK_"@setShuffled(): The condition `count <= lenArray` must hold. count, lenArray = "//getStr([count, lenArray])) ! fpp
     106       11657 :             randLoc = count
     107             :         else
     108         528 :             randLoc = lenArray - 1_IK
     109             :         end if
     110       37056 :         do index = 1_IK, randLoc
     111       24871 :             call setUnifRand(RNG randLoc, index, lenArray)
     112         225 :             temp = array(GET_INDEX(randLoc))
     113         225 :             array(GET_INDEX(randLoc)) = array(GET_INDEX(index))
     114       37056 :             array(GET_INDEX(index)) = temp
     115             :         end do
     116             : #else
     117             :         !%%%%%%%%%%%%%%%%%%%%%%%
     118             : #error  "Unrecognized interface"
     119             :         !%%%%%%%%%%%%%%%%%%%%%%%
     120             : #endif
     121             : #undef  GET_INDEX
     122             : #undef  GET_SIZE
     123             : #undef  RNG