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
|