https://www.cdslab.org/paramonte/fortran/2
Current view: top level - main - pm_distUnifPar@routines.inc.F90 (source / functions) Hit Total Coverage
Test: ParaMonte 2.0.0 :: Serial Fortran - Code Coverage Report Lines: 15 20 75.0 %
Date: 2024-04-08 03:18:57 Functions: 0 0 -
Legend: Lines: hit not hit

          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 the implementation of procedures in [pm_distUnifPar](@ref pm_distUnifPar).
      19             : !>
      20             : !>  \finmain
      21             : !>
      22             : !>  \author
      23             : !>  \AmirShahmoradi, April 23, 2017, 1:36 AM, Institute for Computational Engineering and Sciences (ICES), University of Texas at Austin
      24             : 
      25             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      26             : 
      27             :         !%%%%%%%%%%%%%%%%%%%%%%%
      28             : #if     getUnifParLogPDF_ENABLED
      29             :         !%%%%%%%%%%%%%%%%%%%%%%%
      30             : 
      31             : #if     Cub_ENABLED
      32           4 :         CHECK_ASSERTION(__LINE__, 0_IK < ndim, SK_"@getUnifRecLogPDF(): The condition `0 < ndim` must hold. ndim = "//getStr(ndim))
      33           4 :         logPDF = -ndim * logLenEdge
      34             : #elif   Rec_ENABLED
      35           5 :         logPDF = -sum(logLenEdge)
      36             : #elif   Par_ENABLED
      37             :         integer(IK) :: info
      38           0 :         real(RKC) :: gramian(size(repmat, 1, IK), size(repmat, 2, IK))
      39           0 :         CHECK_ASSERTION(__LINE__, size(repmat, 1, IK) == size(repmat, 2, IK), SK_"@getUnifRecLogPDF(): The condition `size(repmat, 1) == size(repmat, 2)` must hold. shape(repmat) = "//getStr(shape(repmat,IK)))
      40           0 :         gramian = matmul(transpose(repmat), repmat)
      41           0 :         call setMatDetSqrtLog(gramian, uppDia, logPDF, info, gramian, transHerm)
      42           0 :         if (info /= 0_IK) error stop SK_"@getUnifRecLogPDF(): The specified input parallelepiped `repmat` is singular with zero determinant."
      43             :         !logPDF = -sum(log(gramian))
      44             : #else
      45             : #error  "Unrecognized interface."
      46             : #endif
      47             : 
      48             :         !%%%%%%%%%%%%%%%%%%%%%
      49             : #elif   getUnifParRand_ENABLED
      50             :         !%%%%%%%%%%%%%%%%%%%%%
      51             : 
      52             : #if     Cub_ENABLED
      53           2 :         CHECK_ASSERTION(__LINE__, 0_IK < ndim, SK_"@getUnifParRand(): The condition `0 < ndim` must hold. ndim = "//getStr(ndim))
      54             : #endif
      55       12024 :         call setUnifRand(rand)
      56             : #if     DU_ENABLED
      57        1003 :         call setUnifParRand(rand, ub)
      58             : #elif   LU_ENABLED
      59        3003 :         call setUnifParRand(rand, lb, ub)
      60             : #else
      61             : #error  "Unrecognized interface."
      62             : #endif
      63             : 
      64             :         !%%%%%%%%%%%%%%%%%%%%%
      65             : #elif   setUnifParRand_ENABLED
      66             :         !%%%%%%%%%%%%%%%%%%%%%
      67             : 
      68             :         ! Define the default lower bound.
      69             : #if     DU_ENABLED
      70             :         real(RKC), parameter :: lb = 0._RKC
      71             : #endif
      72             :         ! The input uniform random number must be in range `[0, 1)`.
      73       24048 :         CHECK_ASSERTION(__LINE__, all(0._RKC <= rand .and. rand < 1._RKC), SK_"@setUnifParRand(): The condition `all(0. <= rand .and. rand < 1.)` must hold. rand = "//getStr(rand))
      74             :         ! Perform checks.
      75             : #if     Cub_ENABLED
      76             : #define ALL
      77             : #elif   Rec_ENABLED || Par_ENABLED
      78             :         ! Check the length of `lb` and `ub` against `rand`.
      79       58052 :         CHECK_ASSERTION(__LINE__, all(size(rand, 1, IK) == shape(ub, IK)), SK_"@setUnifParRand(): The condition `all(size(rand) == shape(ub))` must hold. size(rand), shape(ub) = "//getStr([size(rand, 1, IK), shape(ub, IK)]))
      80             : #if     LU_ENABLED
      81       18012 :         CHECK_ASSERTION(__LINE__, size(rand, 1, IK) == size(lb, 1, IK), SK_"@setUnifParRand(): The condition `size(rand) == size(lb)` must hold. size(rand), size(lb) = "//getStr([size(rand, 1, IK), size(lb, 1, IK)]))
      82             : #endif
      83             : #else
      84             : #error  "Unrecognized interface."
      85             : #endif
      86             :         ! Generate the random vector.
      87             : #if     Par_ENABLED
      88             : #if     CHECK_ENABLED
      89             :         block
      90             :             integer(IK) :: idim
      91       18012 :             do idim = 1, size(ub, 1, IK)
      92       42028 :                 CHECK_ASSERTION(__LINE__, 0._RKC < norm2(ub(:,idim)), SK_"@setUnifParRand(): The condition `0. < norm2(ub(:,idim))` must hold. idim, ub = "//getStr(idim)//SK_", "//getStr(ub))
      93             :             end do
      94             :         end block
      95             : #endif
      96       72048 :         rand = lb + matmul(ub, rand)
      97             : #elif   Rec_ENABLED || Cub_ENABLED
      98       26104 :         CHECK_ASSERTION(__LINE__, ALL(lb /= ub), SK_"@setUnifParRand(): The condition `all(lb /= ub)` must hold. lb, ub = "//getStr([lb, ub]))
      99        6036 :         rand = (1._RKC - rand) * lb + rand * ub
     100             : #endif
     101             : 
     102             : #else
     103             :         !%%%%%%%%%%%%%%%%%%%%%%%%
     104             : #error  "Unrecognized interface."
     105             :         !%%%%%%%%%%%%%%%%%%%%%%%%
     106             : #endif
     107             : 
     108             : #undef  ALL

ParaMonte: Parallel Monte Carlo and Machine Learning Library 
The Computational Data Science Lab
© Copyright 2012 - 2024