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 implementation of the generic interfaces of [pm_sampleQuan](@ref pm_sampleQuan).
      19             : !>
      20             : !>  \finmain
      21             : !>
      22             : !>  \author
      23             : !>  \AmirShahmoradi, Apr 21, 2017, 1:54 AM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
      24             : 
      25             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      26             : 
      27             :         ! Define the quantile index.
      28             : #if     QD0_ENABLED
      29             : #define GET_INDEX(I)I
      30             : #elif   QD1_ENABLED
      31             : #define GET_INDEX(I):, I
      32             : #else
      33             : #error  "Unrecognized interface."
      34             : #endif
      35             :         !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      36             : #if     getQuan_ENABLED && (QD1_ENABLED || QD0_ENABLED)
      37             :         !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      38             : 
      39             : #if     ND1_ENABLED
      40             :         integer(IK), parameter :: dim = 1
      41             : #elif   ND2_ENABLED
      42             :         integer(IK) :: idim, ndim, nsam
      43             : #else
      44             : #error  "Unrecognized interface."
      45             : #endif
      46         109 :         real(TKC) :: ecdf(size(sample, dim, IK))
      47          89 :         real(TKC) :: sampleSorted(size(sample, dim, IK))
      48         828 :         CHECK_ASSERTION(__LINE__, all([0._TKC <= prob .and. prob <= 1._TKC]), SK_"@getQuan(): The condition `all([0. <= prob .and. prob <= 1.])` must hold. prob = "//getStr(prob))
      49             :         ! Define the optional weight argument.
      50             : #if     WNO_ENABLED
      51          33 :         call setECDF(ecdf)
      52             : #elif   getQuan_ENABLED && (WTI_ENABLED || WTR_ENABLED)
      53          94 :         if (present(weisum)) then
      54          56 :             call setECDF(ecdf, weight, weisum)
      55             :         else
      56         314 :             call setECDF(ecdf, weight, sum(weight))
      57             :         end if
      58             : #else
      59             : #error  "Unrecognized interface."
      60             : #endif
      61             :         ! Compute the quantiles.
      62             : #if     ND1_ENABLED
      63     1329488 :         sampleSorted = sample
      64          87 :         call setSorted(sampleSorted)
      65          87 :         call setExtrap(method, ecdf, sampleSorted, prob, quan)
      66             : #elif   ND2_ENABLED
      67          40 :         CHECK_ASSERTION(__LINE__, dim == 1 .or. dim == 2, SK_"@getQuan(): The condition `dim == 1 .or. dim == 2` must hold. dim = "//getStr(dim))
      68          40 :         ndim = size(sample, 3 - dim, IK)
      69          40 :         nsam = size(sample, dim, IK)
      70          40 :         if (dim == 2) then
      71         110 :             do idim = 1, ndim
      72         640 :                 sampleSorted = sample(idim, 1 : nsam)
      73          80 :                 call setSorted(sampleSorted)
      74         110 :                 call setExtrap(method, ecdf, sampleSorted, prob, quan(GET_INDEX(idim)))
      75             :             end do
      76             :         else
      77          40 :             do idim = 1, ndim
      78         180 :                 sampleSorted = sample(1 : nsam, idim)
      79          30 :                 call setSorted(sampleSorted)
      80          40 :                 call setExtrap(method, ecdf, sampleSorted, prob, quan(GET_INDEX(idim)))
      81             :             end do
      82             :         end if
      83             : #endif
      84             : 
      85             : #else
      86             :         !%%%%%%%%%%%%%%%%%%%%%%%%
      87             : #error  "Unrecognized interface."
      88             :         !%%%%%%%%%%%%%%%%%%%%%%%%
      89             : #endif
      90             : #undef  GET_INDEX
      91             : #undef  WEIGHT