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_arrayCopy](@ref pm_arrayCopy).
      19             : !>
      20             : !>  \finmain
      21             : !>
      22             : !>  \author
      23             : !>  \AmirShahmoradi, April 21, 2017, 1:54 AM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
      24             : 
      25             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      26             : 
      27             : #if     D0_ENABLED && SK_ENABLED
      28             : #define GET_INDEX(i) i:i
      29             : #define GET_SIZE(x) len(x, kind = IK)
      30             : #elif   D1_ENABLED
      31             : #define GET_INDEX(i) i
      32             : #define GET_SIZE(x) size(x, kind = IK)
      33             : #else
      34             : #error  "Unrecognized interface."
      35             : #endif
      36             : 
      37             :         !%%%%%%%%%%%%%%%%%%%%%
      38             : #if     setCopyIndexed_ENABLED
      39             :         !%%%%%%%%%%%%%%%%%%%%%
      40             : 
      41             :         integer(IK) :: i
      42        8428 :         CHECK_ASSERTION(__LINE__, size(indexF, 1, IK) == size(indexT, 1, IK), \
      43             :         SK_"@setCopyIndexed(): The condition `size(indexF) == size(indexT)` must hold. size(indexF), size(indexT) = "\
      44             :         //getStr([size(indexF, 1, IK) == size(indexT, 1, IK)])) ! fpp
      45       74714 :         CHECK_ASSERTION(__LINE__, all(0_IK < indexF) .and. all(indexF <= GET_SIZE(From)), \
      46             :         SK_"@setCopyIndexed(): The condition `all(1 < indexF) .and. all(indexF <= size(From))` must hold. size(From), indexF = "\
      47             :         //getStr([GET_SIZE(From), indexF])) ! fpp
      48       74714 :         CHECK_ASSERTION(__LINE__, all(0_IK < indexT) .and. all(indexT <= GET_SIZE(To  )), \
      49             :         SK_"@setCopyIndexed(): The condition `all(1 < indexT) .and. all(indexT <= size(To  ))` must hold. size(To  ), indexT = "\
      50             :         //getStr([GET_SIZE(To  ), indexT])) ! fpp
      51       19732 :         do i = 1_IK, size(indexF, 1, IK)
      52       19732 :             To(GET_INDEX(indexT(i))) = From(GET_INDEX(indexF(i)))
      53             :         end do
      54             : 
      55             :         !%%%%%%%%%%%%%%%%%%%%%
      56             : #elif   setCopyStrided_ENABLED
      57             :         !%%%%%%%%%%%%%%%%%%%%%
      58             : 
      59             :         integer(IK) :: ifrom, ito
      60             : #if     CHECK_ENABLED
      61       18258 :         if (incf /= 0_IK .and. inct /= 0_IK) CHECK_ASSERTION(__LINE__, (GET_SIZE(From) - 1_IK) / abs(incf) == (GET_SIZE(To) - 1_IK) / abs(inct), \
      62             :         SK_"@setCopyStrided(): The condition `(size(From)-1)/abs(incf) == (size(To)-1)/abs(inct)` must hold. size(From), size(To), incf, inct = "\
      63             :         //getStr([GET_SIZE(From), GET_SIZE(To), incf, inct]))
      64             : #endif
      65        4218 :         if (incf > 0_IK) then
      66             :             ito = 1_IK
      67        1930 :             if (inct < 0_IK) ito = GET_SIZE(To)
      68        1930 :             do ifrom = 1_IK, GET_SIZE(From), incf
      69        1068 :                 To(GET_INDEX(ito)) = From(GET_INDEX(ifrom))
      70       10565 :                 ito = ito + inct
      71             :             end do
      72        2288 :         elseif (incf < 0_IK) then
      73             :             ito = 1_IK
      74        1930 :             if (inct < 0_IK) ito = GET_SIZE(To)
      75        1930 :             do ifrom = GET_SIZE(From), 1_IK, incf
      76        1030 :                 To(GET_INDEX(ito)) = From(GET_INDEX(ifrom))
      77       10847 :                 ito = ito + inct
      78             :             end do
      79         358 :         elseif (inct > 0_IK) then
      80         178 :             do concurrent(ito = 1_IK : GET_SIZE(To) : inct)
      81        1153 :                 To(GET_INDEX(ito)) = From(GET_INDEX(1_IK))
      82             :             end do
      83         180 :         elseif (inct < 0_IK) then
      84         171 :             do concurrent(ito = GET_SIZE(To) : 1_IK : inct)
      85        1239 :                 To(GET_INDEX(ito)) = From(GET_INDEX(1_IK))
      86             :             end do
      87             :         else
      88             :             error stop "The condition `incf /= 0_IK .or. inct /= 0_IK` must hold." ! LCOV_EXCL_LINE
      89             :         end if
      90             : 
      91             : #else
      92             :         !%%%%%%%%%%%%%%%%%%%%%%%%
      93             : #error  "Unrecognized interface."
      94             :         !%%%%%%%%%%%%%%%%%%%%%%%%
      95             : #endif
      96             : 
      97             : #undef GET_INDEX
      98             : #undef GET_SIZE