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 under the generic interfaces of [pm_sampleScale](@ref pm_sampleScale).
      19             : !>
      20             : !>  \finmain
      21             : !>
      22             : !>  \author
      23             : !>  \AmirShahmoradi, Saturday 2:33 AM, August 22, 2021, Dallas, TX
      24             : 
      25             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      26             : 
      27             :         ! Define the runtime checks.
      28             : #define CHECK_VAL_DIM \
      29             : CHECK_ASSERTION(__LINE__, 1 <= dim .and. dim <= rank(sample), \
      30             : SK_"@setScaled(): The condition `1 <= dim .and. dim <= rank(sample)` must hold. dim, rank(sample) = "//getStr([integer(IK) :: dim, rank(sample)]))
      31             : #define CHECK_LEN_AMOUNT(DIM) \
      32             : CHECK_ASSERTION(__LINE__, size(sample, DIM, IK) == size(amount, 1, IK), \
      33             : SK_"@setScaled(): The condition `size(sample, dim, 1) == size(amount, 1)` must hold. dim, shape(sample), size(amount) = "\
      34             : //getStr([DIM, shape(sample, IK), size(amount, 1, IK)]))
      35             : 
      36             :         !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      37             : #if     getScaled_ENABLED && D1_ENABLED
      38             :         !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      39             : 
      40          24 :         sampleScaled = sample * amount
      41             : 
      42             :         !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      43             : #elif   setScaled_ENABLED && D1_ENABLED
      44             :         !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      45             : 
      46          24 :         sample = sample * amount
      47             : 
      48             :         !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      49             : #elif   getScaled_ENABLED && D2_ENABLED
      50             :         !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      51             : 
      52             : 
      53             :         ! Set the indexing rule.
      54             : #if     ONO_ENABLED
      55             : #define GET_INDEX(I,J)I,J
      56             : #elif   OTH_ENABLED
      57             : #define GET_INDEX(I,J)J,I
      58             : #else
      59             : #error  "Unrecognized interface."
      60             : #endif
      61             :         ! Set the conjugation rule.
      62             : #if     OTH_ENABLED && CK_ENABLED
      63             : #define GET_CONJG(X)conjg(X)
      64             : #elif   ONO_ENABLED || (OTH_ENABLED && RK_ENABLED)
      65             : #define GET_CONJG(X)X
      66             : #else
      67             : #error  "Unrecognized interface."
      68             : #endif
      69             :         integer(IK) :: idim, isam, ndim, nsam
      70          12 :         CHECK_VAL_DIM
      71          28 :         CHECK_LEN_AMOUNT(3 - dim)
      72           4 :         nsam = size(sample, dim, IK)
      73           4 :         ndim = size(sample, 3 - dim, IK)
      74           4 :         if (dim == 2_IK) then
      75             :             do concurrent(idim = 1 : ndim, isam = 1 : nsam)
      76          58 :                 sampleScaled(GET_INDEX(idim, isam)) = GET_CONJG(sample(idim, isam) * amount(idim))
      77             :             end do
      78             :         else
      79             :             do concurrent(idim = 1 : ndim, isam = 1 : nsam)
      80           0 :                 sampleScaled(GET_INDEX(isam, idim)) = GET_CONJG(sample(isam, idim) * amount(idim))
      81             :             end do
      82             :         end if
      83             : #undef  GET_CONJG
      84             : #undef  GET_INDEX
      85             : 
      86             :         !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      87             : #elif   setScaled_ENABLED && D2_ENABLED
      88             :         !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      89             : 
      90             :         integer(IK) :: ell, ndim, nsam
      91           6 :         CHECK_VAL_DIM
      92          14 :         CHECK_LEN_AMOUNT(3 - dim)
      93           2 :         nsam = size(sample, dim, IK)
      94           2 :         ndim = size(sample, 3 - dim, IK)
      95           2 :         if (dim == 2_IK) then
      96             :             do concurrent(ell = 1 : nsam)
      97          32 :                 sample(1 : ndim, ell) = sample(1 : ndim, ell) * amount
      98             :             end do
      99             :         else
     100             :             do concurrent(ell = 1 : ndim)
     101           0 :                 sample(1 : nsam, ell) = sample(1 : nsam, ell) * amount(ell)
     102             :             end do
     103             :         end if
     104             : 
     105             : #else
     106             :         !%%%%%%%%%%%%%%%%%%%%%%%%
     107             : #error  "Unrecognized interface."
     108             :         !%%%%%%%%%%%%%%%%%%%%%%%%
     109             : #endif
     110             : #undef  CHECK_LEN_AMOUNT
     111             : #undef  CHECK_VAL_DIM