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 implementations of [pm_arrayRefine](@ref pm_arrayRefine).
      19             : !>
      20             : !>  \finmain
      21             : !>
      22             : !>  \author
      23             : !>  \AmirShahmoradi, Saturday 1:48 AM, August 20, 2016, Institute for Computational Engineering and Sciences, UT Austin, TX
      24             : 
      25             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      26             : 
      27             :         ! Define array indexing rule.
      28             : #if     SK_ENABLED && D0_ENABLED
      29             : #define GET_INDEX(i) i:i
      30             : #define GET_SIZE(X)len(X, IK)
      31             : #elif   D1_ENABLED || D2_ENABLED
      32             : #define GET_INDEX(i) i
      33             : #define GET_SIZE(X)size(X, 1, IK)
      34             : #else
      35             : #error  "Unrecognized interface."
      36             : #endif
      37             :         !%%%%%%%%%%%%%%%%%
      38             : #if     getRefined_ENABLED
      39             :         !%%%%%%%%%%%%%%%%%
      40             : 
      41         160 :         integer(IK) :: rsize, weisum, weightRefined(size(weight, 1, IK))
      42         890 :         weightRefined = weight
      43        1747 :         arrayRefined = array
      44             : #if     D0_ENABLED || D1_ENABLED
      45          60 :         call setRefined(arrayRefined, weightRefined, skip, rsize)
      46          60 :         if (0_IK < rsize) then
      47         262 :             weisum = sum(weightRefined(1 : rsize), mask = weightRefined(1 : rsize) > 0_IK)
      48        1059 :             arrayRefined = getVerbose(arrayRefined(1 : rsize), weightRefined(1 : rsize), weisum)
      49             :         else
      50           7 :             call setResized(arrayRefined, 0_IK)
      51             :         end if
      52             : #elif   D2_ENABLED
      53         100 :         call setRefined(arrayRefined, dim, weightRefined, skip, rsize)
      54         100 :         if (0_IK < rsize) then
      55         409 :             weisum = sum(weightRefined(1 : rsize), mask = weightRefined(1 : rsize) > 0_IK)
      56          86 :             if (dim == 1_IK) then
      57        2262 :                 arrayRefined = getVerbose(arrayRefined(1 : rsize, :), weightRefined(1 : rsize), weisum, dim)
      58             :             else
      59        2952 :                 arrayRefined = getVerbose(arrayRefined(:, 1 : rsize), weightRefined(1 : rsize), weisum, dim)
      60             :             end if
      61             :         else
      62          14 :             if (dim == 1_IK) then
      63          12 :                 call setResized(arrayRefined, [0_IK, size(array, 2, IK)])
      64             :             else
      65          30 :                 call setResized(arrayRefined, [size(array, 1, IK), 0_IK])
      66             :             end if
      67             :         end if
      68             : #else
      69             : #error  "Unrecognized interface."
      70             : #endif
      71             : 
      72             :         !%%%%%%%%%%%%%%%%%
      73             : #elif   setRefined_ENABLED
      74             :         !%%%%%%%%%%%%%%%%%
      75             : 
      76             :         integer(IK) :: isam
      77         346 :         if (GET_SIZE(array) == 0_IK) then
      78          26 :             rsize = 0_IK
      79           1 :             return
      80             :         end if
      81         319 :         rsize = 0_IK
      82         319 :         call setReweight(weight, skip)
      83             : #if     D0_ENABLED || D1_ENABLED
      84         336 :         CHECK_ASSERTION(__LINE__, size(weight, 1, IK) == GET_SIZE(array), SK_": The condition `size(weight) == size/len(array)` must hold. size(weight), size/len(array) = "//getStr([size(weight, 1, IK), GET_SIZE(array)]))
      85         666 :         do isam = 1, GET_SIZE(array)
      86         666 :             if (0_IK < weight(isam)) then
      87         401 :                 rsize = rsize + 1_IK
      88         401 :                 if (rsize < isam) then ! The only other possibility is equality.
      89         199 :                     weight(rsize) = weight(isam)
      90         199 :                     array(GET_INDEX(rsize)) = array(GET_INDEX(isam))
      91             :                 end if
      92             :             end if
      93             :         end do
      94             : #elif   D2_ENABLED
      95         207 :         CHECK_ASSERTION(__LINE__, dim == 1 .or. dim == 2, SK_": The condition `dim == 1 .or. dim == 2` must hold. dim = "//getStr(dim))
      96         621 :         CHECK_ASSERTION(__LINE__, size(weight, 1, IK) == size(array, dim, IK), SK_": The condition `size(weight) == size(array, dim)` must hold. size(weight), size(array, dim) = "//getStr([size(weight, 1, IK), size(array, dim, IK)]))
      97         207 :         if (dim == 1_IK) then
      98         549 :             do isam = 1, size(array, dim, IK)
      99         549 :                 if (0_IK < weight(isam)) then
     100         347 :                     rsize = rsize + 1_IK
     101         347 :                     if (rsize < isam) then ! The only other possibility is equality.
     102         181 :                         weight(rsize) = weight(isam)
     103         501 :                         array(rsize, :) = array(isam, :)
     104             :                     end if
     105             :                 end if
     106             :             end do
     107             :         else
     108      439289 :             do isam = 1, size(array, dim, IK)
     109      439289 :                 if (0_IK < weight(isam)) then
     110      229879 :                     rsize = rsize + 1_IK
     111      229879 :                     if (rsize < isam) then ! The only other possibility is equality.
     112      229721 :                         weight(rsize) = weight(isam)
     113     1333636 :                         array(:, rsize) = array(:, isam)
     114             :                     end if
     115             :                 end if
     116             :             end do
     117             :         end if
     118             : #else
     119             : #error  "Unrecognized interface."
     120             : #endif
     121             : #else
     122             :         !%%%%%%%%%%%%%%%%%%%%%%%%
     123             : #error  "Unrecognized interface."
     124             :         !%%%%%%%%%%%%%%%%%%%%%%%%
     125             : #endif
     126             : #undef  GET_INDEX
     127             : #undef  GET_SIZE