The ParaMonte Documentation Website
Current view: top level - kernel - Statistics_mod.f90 (source / functions) Hit Total Coverage
Test: ParaMonte 1.5.1 :: Serial Kernel - Code Coverage Report Lines: 941 1003 93.8 %
Date: 2021-01-08 13:03:42 Functions: 83 83 100.0 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       2             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       3             : !!!!
       4             : !!!!   MIT License
       5             : !!!!
       6             : !!!!   ParaMonte: plain powerful parallel Monte Carlo library.
       7             : !!!!
       8             : !!!!   Copyright (C) 2012-present, The Computational Data Science Lab
       9             : !!!!
      10             : !!!!   This file is part of the ParaMonte library.
      11             : !!!!
      12             : !!!!   Permission is hereby granted, free of charge, to any person obtaining a
      13             : !!!!   copy of this software and associated documentation files (the "Software"),
      14             : !!!!   to deal in the Software without restriction, including without limitation
      15             : !!!!   the rights to use, copy, modify, merge, publish, distribute, sublicense,
      16             : !!!!   and/or sell copies of the Software, and to permit persons to whom the
      17             : !!!!   Software is furnished to do so, subject to the following conditions:
      18             : !!!!
      19             : !!!!   The above copyright notice and this permission notice shall be
      20             : !!!!   included in all copies or substantial portions of the Software.
      21             : !!!!
      22             : !!!!   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
      23             : !!!!   EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
      24             : !!!!   MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
      25             : !!!!   IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
      26             : !!!!   DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
      27             : !!!!   OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE
      28             : !!!!   OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
      29             : !!!!
      30             : !!!!   ACKNOWLEDGMENT
      31             : !!!!
      32             : !!!!   ParaMonte is an honor-ware and its currency is acknowledgment and citations.
      33             : !!!!   As per the ParaMonte library license agreement terms, if you use any parts of
      34             : !!!!   this library for any purposes, kindly acknowledge the use of ParaMonte in your
      35             : !!!!   work (education/research/industry/development/...) by citing the ParaMonte
      36             : !!!!   library as described on this page:
      37             : !!!!
      38             : !!!!       https://github.com/cdslaborg/paramonte/blob/main/ACKNOWLEDGMENT.md
      39             : !!!!
      40             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      41             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      42             : 
      43             : !> \brief This module contains the classes and procedures for various statistical computations.
      44             : !> \author Amir Shahmoradi
      45             : 
      46             : module Statistics_mod
      47             : 
      48             :     use Constants_mod, only: RK, IK
      49             : 
      50             :     implicit none
      51             : 
      52             :     !logical, save :: paradramPrintEnabled = .false.
      53             :     !logical, save :: paradisePrintEnabled = .false.
      54             : 
      55             :     character(len=*), parameter :: MODULE_NAME = "@Statistics_mod"
      56             : 
      57             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      58             : 
      59             :     interface getSNormCDF
      60             :         module procedure :: getSNormCDF_SPR, getSNormCDF_DPR
      61             :     end interface getSNormCDF
      62             : 
      63             :     interface getBetaCDF
      64             :         module procedure :: getBetaCDF_SPR, getBetaCDF_DPR
      65             :     end interface getBetaCDF
      66             : 
      67             :     interface getBetaContinuedFraction
      68             :         module procedure :: getBetaContinuedFraction_SPR, getBetaContinuedFraction_DPR
      69             :     end interface getBetaContinuedFraction
      70             : 
      71             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      72             : 
      73             :     interface getMean
      74             :         module procedure :: getMean_2D
      75             :     end interface getMean
      76             : 
      77             :     interface flatten
      78             :         module procedure :: flatten_2D
      79             :     end interface flatten
      80             : 
      81             :     interface getNormData
      82             :         module procedure :: getNormData_2D, normalizeWeightedData_2d
      83             :     end interface getNormData
      84             : 
      85             :     interface getVariance
      86             :         module procedure :: getVariance_1D, getVariance_2D
      87             :     end interface getVariance
      88             : 
      89             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      90             : 
      91             :     interface getLogProbLogn
      92             :         module procedure :: getLogProbLognSP, getLogProbLognMP
      93             :     end interface getLogProbLogn
      94             : 
      95             :     interface getLogProbLognorm
      96             :         module procedure :: getLogProbLognSP, getLogProbLognMP
      97             :     end interface getLogProbLognorm
      98             : 
      99             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     100             : 
     101             :     interface getLogProbNormSP
     102             :         module procedure :: getLogProbNormSP_RK, getLogProbNormSP_CK
     103             :     end interface getLogProbNormSP
     104             : 
     105             :     interface getLogProbNormMP
     106             :         module procedure :: getLogProbNormMP_RK, getLogProbNormMP_CK
     107             :     end interface getLogProbNormMP
     108             : 
     109             :     interface getLogProbMVNSP
     110             :         module procedure :: getLogProbMVNSP_RK, getLogProbMVNSP_CK
     111             :     end interface getLogProbMVNSP
     112             : 
     113             :     interface getLogProbMVNMP
     114             :         module procedure :: getLogProbMVNMP_RK, getLogProbMVNMP_CK
     115             :     end interface getLogProbMVNMP
     116             : 
     117             :     interface getLogProbNorm
     118             :         module procedure :: getLogProbNormSP_RK, getLogProbNormMP_RK
     119             :         module procedure :: getLogProbNormSP_CK, getLogProbNormMP_CK
     120             :     end interface getLogProbNorm
     121             : 
     122             :     interface getLogProbMVN
     123             :         module procedure :: getLogProbMVNSP_RK, getLogProbMVNMP_RK
     124             :         module procedure :: getLogProbMVNSP_CK, getLogProbMVNMP_CK
     125             :     end interface getLogProbMVN
     126             : 
     127             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     128             : 
     129             :     interface getLogProbMixNorm
     130             :         module procedure :: getLogProbMixNormSP_RK, getLogProbMixNormSP_CK
     131             :         module procedure :: getLogProbMixNormMP_RK, getLogProbMixNormMP_CK
     132             :     end interface getLogProbMixNorm
     133             : 
     134             :     interface getLogProbMixMVN
     135             :         module procedure :: getLogProbMixMVNSP_RK, getLogProbMixMVNSP_CK
     136             :         module procedure :: getLogProbMixMVNMP_RK, getLogProbMixMVNMP_CK
     137             :     end interface getLogProbMixMVN
     138             : 
     139             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     140             : 
     141             :     interface getMahalSqSP
     142             :         module procedure :: getMahalSqSP_RK, getMahalSqSP_CK
     143             :     end interface getMahalSqSP
     144             : 
     145             :     interface getMahalSqMP
     146             :         module procedure :: getMahalSqMP_RK, getMahalSqMP_CK
     147             :     end interface getMahalSqMP
     148             : 
     149             :     interface getMahalSq
     150             :         module procedure :: getMahalSqSP_RK, getMahalSqMP_RK
     151             :         module procedure :: getMahalSqSP_CK, getMahalSqMP_CK
     152             :     end interface getMahalSq
     153             : 
     154             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     155             : 
     156             : contains
     157             : 
     158             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     159             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     160             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     161             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     162             : 
     163             : 
     164             :     !> \brief
     165             :     !> Return the square of Mahalanobis distance for a single point. The output is a scalar variable.
     166             :     !>
     167             :     !> \param[in]   nd          :   The number of dimensions of the input `Point`.
     168             :     !> \param[in]   MeanVec     :   The mean vector of the sample.
     169             :     !> \param[in]   InvCovMat   :   The inverse covariance matrix of the sample.
     170             :     !> \param[in]   Point       :   The `Point` whose distance from the sample is to computed.
     171             :     !>
     172             :     !> \return
     173             :     !> `mahalSq` : The Mahalanobis distance squared of the point from
     174             :     !> the sample characterized by the input `MeanVec` and `InvCovMat`.
     175           4 :     pure function getMahalSqSP_RK(nd,MeanVec,InvCovMat,Point) result(mahalSq)
     176             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     177             :         !DEC$ ATTRIBUTES DLLEXPORT :: getMahalSqSP_RK
     178             : #endif
     179             :         use Constants_mod, only: IK, RK
     180             :         implicit none
     181             :         integer(IK), intent(in) :: nd
     182             :         real(RK)   , intent(in) :: MeanVec(nd)
     183             :         real(RK)   , intent(in) :: InvCovMat(nd,nd)        ! Inverse of the covariance matrix
     184             :         real(RK)   , intent(in) :: Point(nd)               ! input data points
     185             :         real(RK)                :: mahalSq
     186          16 :         real(RK)                :: NormedPoint(nd)
     187          16 :         NormedPoint = Point - MeanVec
     188          16 :         mahalSq = dot_product( NormedPoint , matmul(InvCovMat,NormedPoint) )
     189           4 :     end function getMahalSqSP_RK
     190             : 
     191             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     192             : 
     193             :     !> \brief
     194             :     !> Return the square of Mahalanobis distances for an row-wise array of points.
     195             :     !>
     196             :     !> \param[in]   nd          :   The number of dimensions of the input `Point` array.
     197             :     !> \param[in]   np          :   The number of points in the input input `Point` array.
     198             :     !> \param[in]   MeanVec     :   The mean vector of length `nd` of the sample.
     199             :     !> \param[in]   InvCovMat   :   The inverse covariance matrix `(nd,nd)` of the sample.
     200             :     !> \param[in]   Point       :   The `(nd,np)` array of points whose distances squared from the sample are to computed.
     201             :     !>
     202             :     !> \return
     203             :     !> `MahalSq` : A vector of length `np` containing the squares of the Mahalanobis distances
     204             :     !> of the input points from the sample characterized by the input `MeanVec` and `InvCovMat`.
     205             :     !>
     206             :     !> \warning
     207             :     !> For the sake of preserving the purity and computational efficiency of the function,
     208             :     !> if the computation fails at any stage, the first element of output will be returned negative.
     209          20 :     pure function getMahalSqMP_RK(nd,np,MeanVec,InvCovMat,Point) result(MahalSq)
     210             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     211             :         !DEC$ ATTRIBUTES DLLEXPORT :: getMahalSqMP_RK
     212             : #endif
     213           4 :         use Constants_mod, only: IK, RK
     214             :         implicit none
     215             :         integer(IK), intent(in) :: nd,np
     216             :         real(RK), intent(in)    :: MeanVec(nd)
     217             :         real(RK), intent(in)    :: InvCovMat(nd,nd) ! Inverse of the covariance matrix
     218             :         real(RK), intent(in)    :: Point(nd,np)     ! input data points
     219             :         real(RK)                :: MahalSq(np)      ! function return
     220          16 :         real(RK)                :: NormedPoint(nd)
     221             :         integer(IK)             :: ip
     222          12 :         do ip = 1,np
     223          32 :             NormedPoint = Point(1:nd,ip) - MeanVec
     224          32 :             MahalSq(ip) = dot_product( NormedPoint , matmul(InvCovMat,NormedPoint) )
     225          12 :             if (MahalSq(ip)<0._RK) then
     226             :             ! LCOV_EXCL_START
     227             :                 MahalSq(1) = -1._RK
     228             :                 return
     229             :             end if
     230             :             ! LCOV_EXCL_STOP
     231             :         end do
     232           8 :     end function getMahalSqMP_RK
     233             : 
     234             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     235             : 
     236             :     !> \brief
     237             :     !> Return the square of Mahalanobis distance for a single complex point. The output is a scalar variable.
     238             :     !>
     239             :     !> \param[in]   nd          :   The number of dimensions of the input `Point`.
     240             :     !> \param[in]   MeanVec     :   The mean vector of the sample.
     241             :     !> \param[in]   InvCovMat   :   The inverse covariance matrix of the sample.
     242             :     !> \param[in]   Point       :   The `Point` whose distance from the sample is to computed.
     243             :     !>
     244             :     !> \return
     245             :     !> `mahalSq` : The Mahalanobis distance squared of the point from
     246             :     !> the sample characterized by the input `MeanVec` and `InvCovMat`.
     247           4 :     pure function getMahalSqSP_CK(nd,MeanVec,InvCovMat,Point) result(mahalSq)
     248             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     249             :         !DEC$ ATTRIBUTES DLLEXPORT :: getMahalSqSP_CK
     250             : #endif
     251           4 :         use Constants_mod, only: IK, RK, CK
     252             :         implicit none
     253             :         integer(IK), intent(in)  :: nd
     254             :         complex(CK), intent(in)  :: MeanVec(nd)
     255             :         complex(CK), intent(in)  :: InvCovMat(nd,nd) ! Inverse of the covariance matrix
     256             :         complex(CK), intent(in)  :: Point(nd)        ! input data points
     257             :         complex(CK)              :: mahalSq             ! function return
     258          28 :         mahalSq = sum( (Point-MeanVec) * matmul(InvCovMat,Point-MeanVec) )
     259           4 :     end function getMahalSqSP_CK
     260             : 
     261             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     262             : 
     263             :     !> \brief
     264             :     !> Return the square of Mahalanobis distances for an row-wise array of complex-valued points.
     265             :     !>
     266             :     !> \param[in]   nd          :   The number of dimensions of the input `Point` array.
     267             :     !> \param[in]   np          :   The number of points in the input input `Point` array.
     268             :     !> \param[in]   MeanVec     :   The mean vector of length `nd` of the sample.
     269             :     !> \param[in]   InvCovMat   :   The inverse covariance matrix `(nd,nd)` of the sample.
     270             :     !> \param[in]   Point       :   The `(nd,np)` array of points whose distances squared from the sample are to computed.
     271             :     !>
     272             :     !> \return
     273             :     !> `MahalSq` : A vector of length `np` containing the squares of the Mahalanobis distances
     274             :     !> of the input points from the sample characterized by the input `MeanVec` and `InvCovMat`.
     275             :     !>
     276             :     !> \warning
     277             :     !> For the sake of preserving the purity and computational efficiency of the function,
     278             :     !> if the computation fails at any stage, the first element of output will be returned negative.
     279          20 :     pure function getMahalSqMP_CK(nd,np,MeanVec,InvCovMat,Point) result(MahalSq)
     280             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     281             :         !DEC$ ATTRIBUTES DLLEXPORT :: getMahalSqMP_CK
     282             : #endif
     283           4 :         use Constants_mod, only: IK, RK, CK
     284             :         implicit none
     285             :         integer(IK), intent(in)  :: nd,np
     286             :         complex(CK), intent(in)  :: MeanVec(nd)
     287             :         complex(CK), intent(in)  :: InvCovMat(nd,nd) ! Inverse of the covariance matrix
     288             :         complex(CK), intent(in)  :: Point(nd,np)     ! input data points
     289             :         complex(CK)              :: MahalSq(np)         ! function return
     290             :         integer(IK)              :: ip
     291          12 :         do ip = 1,np
     292          16 :             MahalSq(ip) = sum( (Point(1:nd,ip)-MeanVec) * &
     293          64 :             matmul(InvCovMat,Point(1:nd,ip)-MeanVec) )
     294          12 :             if (real(MahalSq(ip))<0._RK) then
     295             :             ! LCOV_EXCL_START
     296             :                 MahalSq(1) = (-1._RK, -1._RK)
     297             :                 return
     298             :             end if
     299             :             ! LCOV_EXCL_STOP
     300             :         end do
     301           8 :     end function getMahalSqMP_CK
     302             : 
     303             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     304             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     305             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     306             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     307             : 
     308           3 :     pure function getLogProbNormSP_RK(mean,inverseVariance,logSqrtInverseVariance,point) result(logProbNorm)
     309             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     310             :         !DEC$ ATTRIBUTES DLLEXPORT :: getLogProbNormSP_RK
     311             : #endif
     312           4 :         use Constants_mod, only: RK, LOGINVSQRT2PI
     313             :         implicit none
     314             :         real(RK), intent(in) :: mean,inverseVariance,logSqrtInverseVariance,point
     315             :         real(RK)             :: logProbNorm
     316           3 :         logProbNorm = LOGINVSQRT2PI + logSqrtInverseVariance - 0.5_RK * inverseVariance * (point-mean)**2
     317           6 :     end function getLogProbNormSP_RK
     318             : 
     319             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     320             : 
     321          15 :     pure function getLogProbNormMP_RK(np,mean,inverseVariance,logSqrtInverseVariance,Point) result(logProbNorm)
     322             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     323             :         !DEC$ ATTRIBUTES DLLEXPORT :: getLogProbNormMP_RK
     324             : #endif
     325           3 :         use Constants_mod, only: LOGINVSQRT2PI
     326             :         implicit none
     327             :         integer(IK), intent(in) :: np
     328             :         real(RK)   , intent(in) :: mean,inverseVariance,logSqrtInverseVariance,Point(np)
     329             :         real(RK)                :: logProbNorm(np)
     330           9 :         logProbNorm = LOGINVSQRT2PI + logSqrtInverseVariance - 0.5_RK * inverseVariance * (Point-mean)**2
     331           3 :     end function getLogProbNormMP_RK
     332             : 
     333             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     334             : 
     335             :     ! NOTE: if MahalSq computation fails, output probability will be returned as NullVal%RK from module Constant_mod.
     336           3 :     pure function getLogProbMVNSP_RK(nd,MeanVec,InvCovMat,logSqrtDetInvCovMat,Point) result(logProbNorm)
     337             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     338             :         !DEC$ ATTRIBUTES DLLEXPORT :: getLogProbMVNSP_RK
     339             : #endif
     340           3 :         use Constants_mod, only: LOGINVSQRT2PI, NullVal
     341             :         implicit none
     342             :         integer(IK), intent(in) :: nd
     343             :         real(RK)   , intent(in) :: MeanVec(nd)
     344             :         real(RK)   , intent(in) :: InvCovMat(nd,nd)
     345             :         real(RK)   , intent(in) :: logSqrtDetInvCovMat
     346             :         real(RK)   , intent(in) :: Point(nd)
     347           3 :         real(RK)                :: logProbNorm, dummy
     348           3 :         dummy = getMahalSqSP_RK(nd,MeanVec,InvCovMat,Point)
     349           3 :         if (dummy<0._RK) then
     350           0 :             logProbNorm = NullVal%RK
     351             :         else
     352           3 :             logProbNorm = nd*LOGINVSQRT2PI + logSqrtDetInvCovMat - 0.5_RK * dummy
     353             :         end if
     354           3 :     end function getLogProbMVNSP_RK
     355             : 
     356             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     357             : 
     358             :     ! NOTE: if MahalSq computation fails, output probability will be returned as NullVal%RK from module Constant_mod.
     359          15 :     pure function getLogProbMVNMP_RK(nd,np,MeanVec,InvCovMat,logSqrtDetInvCovMat,Point) result(logProbNorm)
     360             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     361             :         !DEC$ ATTRIBUTES DLLEXPORT :: getLogProbMVNMP_RK
     362             : #endif
     363           3 :         use Constants_mod, only: LOGINVSQRT2PI, NullVal
     364             :         implicit none
     365             :         integer(IK), intent(in) :: nd,np
     366             :         real(RK)   , intent(in) :: MeanVec(nd)
     367             :         real(RK)   , intent(in) :: InvCovMat(nd,nd)
     368             :         real(RK)   , intent(in) :: logSqrtDetInvCovMat
     369             :         real(RK)   , intent(in) :: Point(nd,np)
     370          12 :         real(RK)                :: logProbNorm(np), Dummy(np)
     371           3 :         Dummy = getMahalSqMP_RK(nd,np,MeanVec,InvCovMat,Point)
     372           3 :         if (Dummy(1)<0._RK) then
     373           0 :             logProbNorm = NullVal%RK
     374             :         else
     375           9 :             logProbNorm = nd*LOGINVSQRT2PI + logSqrtDetInvCovMat - 0.5_RK * Dummy
     376             :         end if
     377           3 :     end function getLogProbMVNMP_RK
     378             : 
     379             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     380             : 
     381           3 :     function getLogProbNormSP_CK(mean,inverseVariance,logSqrtInverseVariance,point) result(logProbNorm)
     382             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     383             :         !DEC$ ATTRIBUTES DLLEXPORT :: getLogProbNormSP_CK
     384             : #endif
     385           3 :         use Constants_mod, only: RK, CK, LOGINVSQRT2PI
     386             :         implicit none
     387             :         complex(CK), intent(in) :: mean,inverseVariance,logSqrtInverseVariance,point
     388             :         complex(CK)             :: logProbNorm
     389           3 :         logProbNorm = LOGINVSQRT2PI + logSqrtInverseVariance - 0.5_RK * inverseVariance * (point-mean)**2
     390           6 :     end function getLogProbNormSP_CK
     391             : 
     392             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     393             : 
     394          15 :     function getLogProbNormMP_CK(np,mean,inverseVariance,logSqrtInverseVariance,Point) result(logProbNorm)
     395             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     396             :         !DEC$ ATTRIBUTES DLLEXPORT :: getLogProbNormMP_CK
     397             : #endif
     398           3 :         use Constants_mod, only: IK, RK, CK, LOGINVSQRT2PI
     399             :         implicit none
     400             :         integer(IK), intent(in) :: np
     401             :         complex(CK)   , intent(in) :: mean,inverseVariance,logSqrtInverseVariance,Point(np)
     402             :         complex(CK)                :: logProbNorm(np)
     403           9 :         logProbNorm = LOGINVSQRT2PI + logSqrtInverseVariance - 0.5_RK * inverseVariance * (Point-mean)**2
     404           3 :     end function getLogProbNormMP_CK
     405             : 
     406             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     407             : 
     408           3 :     function getLogProbMVNSP_CK(nd,MeanVec,InvCovMat,logSqrtDetInvCovMat,Point) result(logProbMVN)
     409             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     410             :         !DEC$ ATTRIBUTES DLLEXPORT :: getLogProbMVNSP_CK
     411             : #endif
     412           3 :         use Constants_mod, only: IK, RK, CK, LOGINVSQRT2PI, NullVal
     413             :         implicit none
     414             :         integer(IK), intent(in) :: nd
     415             :         complex(CK), intent(in) :: MeanVec(nd)
     416             :         complex(CK), intent(in) :: InvCovMat(nd,nd)
     417             :         complex(CK), intent(in) :: logSqrtDetInvCovMat
     418             :         complex(CK), intent(in) :: Point(nd)
     419             :         complex(CK)             :: logProbMVN, dummy
     420           3 :         dummy = getMahalSqSP(nd,MeanVec,InvCovMat,Point)
     421           3 :         if (real(dummy)<0._RK) then
     422           0 :             logProbMVN = NullVal%RK
     423             :         else
     424           3 :             logProbMVN  = nd*LOGINVSQRT2PI + logSqrtDetInvCovMat - 0.5_RK * dummy
     425             :         end if
     426           3 :     end function getLogProbMVNSP_CK
     427             : 
     428             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     429             : 
     430          15 :     function getLogProbMVNMP_CK(nd,np,MeanVec,InvCovMat,logSqrtDetInvCovMat,Point) result(logProbMVN)
     431             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     432             :         !DEC$ ATTRIBUTES DLLEXPORT :: getLogProbMVNMP_CK
     433             : #endif
     434           3 :         use Constants_mod, only: IK, RK, CK, LOGINVSQRT2PI, NullVal
     435             :         implicit none
     436             :         integer(IK), intent(in) :: nd,np
     437             :         complex(CK), intent(in) :: MeanVec(nd)
     438             :         complex(CK), intent(in) :: InvCovMat(nd,nd)
     439             :         complex(CK), intent(in) :: logSqrtDetInvCovMat
     440             :         complex(CK), intent(in) :: Point(nd,np)
     441          12 :         complex(CK)             :: logProbMVN(np), Dummy(np)
     442           3 :         Dummy = getMahalSqMP(nd,np,MeanVec,InvCovMat,Point)
     443           3 :         if (real(Dummy(1))<0._RK) then
     444           0 :             logProbMVN = NullVal%RK
     445             :         else
     446           9 :             logProbMVN  = nd*LOGINVSQRT2PI + logSqrtDetInvCovMat - 0.5_RK * Dummy
     447             :         end if
     448           3 :     end function getLogProbMVNMP_CK
     449             : 
     450             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     451             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     452             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     453             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     454             : 
     455             :     ! SDSP stands for Single-Dimensional Gaussian mixture with Single Point input
     456             :     ! For a proper probability normalization, the sum of the amplitudes must equal one.
     457           1 :     function getLogProbMixNormSP_RK(nmode,LogAmplitude,MeanVec,InvCovMat,LogSqrtDetInvCovMat,point) result(logProbMixNorm)
     458             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     459             :         !DEC$ ATTRIBUTES DLLEXPORT :: getLogProbMixNormSP_RK
     460             : #endif
     461           3 :         use Constants_mod, only: IK, RK, LOGTINY_RK
     462             :         implicit none
     463             :         integer(IK), intent(in) :: nmode
     464             :         real(RK)   , intent(in) :: LogAmplitude(nmode),MeanVec(nmode)
     465             :         real(RK)   , intent(in) :: InvCovMat(nmode),LogSqrtDetInvCovMat(nmode)
     466             :         real(RK)   , intent(in) :: point
     467             :         real(RK)                :: logProbMixNorm
     468           3 :         real(RK)                :: normFac,LogProb(nmode)
     469             :         integer(IK)             :: imode
     470           3 :         do imode = 1, nmode
     471           3 :             LogProb(imode)  = LogAmplitude(imode) + getLogProbNormSP_RK(MeanVec(imode),InvCovMat(imode),LogSqrtDetInvCovMat(imode),point)
     472             :         end do
     473           4 :         normFac = maxval(LogProb)
     474           3 :         LogProb = LogProb - normFac
     475           9 :         where(LogProb<LOGTINY_RK)
     476           1 :             LogProb = 0._RK
     477             :         elsewhere
     478           1 :             LogProb = exp(LogProb)
     479             :         end where
     480           3 :         logProbMixNorm = normFac + log(sum(LogProb))
     481           1 :     end function getLogProbMixNormSP_RK
     482             : 
     483             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     484             : 
     485           5 :   function getLogProbMixNormMP_RK(nmode,np,LogAmplitude,MeanVec,InvCovMat,LogSqrtDetInvCovMat,Point) result(logProbMixNorm)
     486             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     487             :         !DEC$ ATTRIBUTES DLLEXPORT :: getLogProbMixNormMP_RK
     488             : #endif
     489           1 :         use Constants_mod, only: IK, RK, LOGTINY_RK
     490             :         implicit none
     491             :         integer(IK), intent(in) :: nmode,np
     492             :         real(RK)   , intent(in) :: LogAmplitude(nmode),MeanVec(nmode)
     493             :         real(RK)   , intent(in) :: InvCovMat(nmode),LogSqrtDetInvCovMat(nmode)
     494             :         real(RK)   , intent(in) :: Point(np)
     495             :         real(RK)                :: logProbMixNorm(np)
     496          10 :         real(RK)                :: NormFac(np),LogProb(nmode,np)
     497             :         integer(IK)             :: imode, ip
     498           3 :         do imode = 1, nmode
     499           7 :             LogProb(imode,1:np) = LogAmplitude(imode) + getLogProbNormMP_RK(np,MeanVec(imode),InvCovMat(imode),LogSqrtDetInvCovMat(imode),Point)
     500             :         end do
     501           1 :         NormFac = maxval(LogProb,dim=1)
     502           3 :         do ip = 1,np
     503           6 :             LogProb(1:nmode,ip) = LogProb(1:nmode,ip) - NormFac(ip)
     504           6 :             do imode = 1,nmode
     505           6 :                 if ( LogProb(imode,ip) < LOGTINY_RK ) then
     506           0 :                     LogProb(imode,ip) = 0._RK
     507             :                 else
     508           4 :                     LogProb(imode,ip) = exp( LogProb(imode,ip) )
     509             :                 end if
     510             :             end do
     511           7 :             logProbMixNorm(ip) = NormFac(ip) + log(sum(LogProb(1:nmode,ip)))
     512             :         end do
     513           1 :     end function getLogProbMixNormMP_RK
     514             : 
     515             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     516             : 
     517           1 :     function getLogProbMixMVNSP_RK(nmode,nd,LogAmplitude,MeanVec,InvCovMat,LogSqrtDetInvCovMat,Point) result(logProbMixMVN)
     518             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     519             :         !DEC$ ATTRIBUTES DLLEXPORT :: getLogProbMixMVNSP_RK
     520             : #endif
     521           1 :         use Constants_mod, only: IK, RK, LOGTINY_RK
     522             :         implicit none
     523             :         integer(IK), intent(in) :: nmode,nd
     524             :         real(RK)   , intent(in) :: LogAmplitude(nmode), MeanVec(nd,nmode)
     525             :         real(RK)   , intent(in) :: InvCovMat(nd,nd,nmode), LogSqrtDetInvCovMat(nmode)
     526             :         real(RK)   , intent(in) :: Point(nd)
     527             :         real(RK)                :: logProbMixMVN
     528           3 :         real(RK)                :: normFac,LogProb(nmode)
     529             :         integer(IK)             :: imode
     530           3 :         do imode = 1, nmode
     531           3 :             LogProb(imode) = LogAmplitude(imode) + getLogProbMVNSP_RK(nd,MeanVec(1:nd,imode),InvCovMat(1:nd,1:nd,imode),LogSqrtDetInvCovMat(imode),Point)
     532             :         end do
     533           4 :         normFac = maxval(LogProb)
     534           3 :         LogProb = LogProb - normFac
     535           9 :         where(LogProb<LOGTINY_RK)
     536           1 :             LogProb = 0._RK
     537             :         elsewhere
     538           1 :             LogProb = exp(LogProb)
     539             :         end where
     540           3 :         logProbMixMVN = normFac + log(sum(LogProb))
     541           1 :     end function getLogProbMixMVNSP_RK
     542             : 
     543             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     544             : 
     545           5 :   function getLogProbMixMVNMP_RK(nmode,nd,np,LogAmplitude,MeanVec,InvCovMat,LogSqrtDetInvCovMat,Point) result(logProbMixMVN)
     546             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     547             :         !DEC$ ATTRIBUTES DLLEXPORT :: getLogProbMixMVNMP_RK
     548             : #endif
     549           1 :         use Constants_mod, only: IK, RK, LOGTINY_RK
     550             :         implicit none
     551             :         integer(IK), intent(in) :: nmode,nd,np
     552             :         real(RK)   , intent(in) :: LogAmplitude(nmode),MeanVec(nd,nmode)
     553             :         real(RK)   , intent(in) :: InvCovMat(nd,nd,nmode), LogSqrtDetInvCovMat(nmode)
     554             :         real(RK)   , intent(in) :: Point(nd,np)
     555             :         real(RK)                :: logProbMixMVN(np)
     556          10 :         real(RK)                :: NormFac(np),LogProb(nmode,np)
     557             :         integer(IK)             :: imode, ip
     558           3 :         do imode = 1, nmode
     559           4 :             LogProb(imode,1:np) = LogAmplitude(imode) + &
     560          11 :             getLogProbMVNMP_RK(nd,np,MeanVec(1:nd,imode),InvCovMat(1:nd,1:nd,imode),LogSqrtDetInvCovMat(imode),Point)
     561             :         end do
     562           1 :         NormFac = maxval(LogProb,dim=1)
     563           3 :         do ip = 1,np
     564           6 :             LogProb(1:nmode,ip) = LogProb(1:nmode,ip) - NormFac(ip)
     565           6 :             do imode = 1,nmode
     566           6 :                 if ( LogProb(imode,ip)<LOGTINY_RK ) then
     567           2 :                     LogProb(imode,ip) = 0._RK
     568             :                 else
     569           2 :                     LogProb(imode,ip) = exp( LogProb(imode,ip) )
     570             :                 end if
     571             :             end do
     572           7 :         logProbMixMVN(ip) = NormFac(ip) + log(sum(LogProb(1:nmode,ip)))
     573             :         end do
     574           1 :     end function getLogProbMixMVNMP_RK
     575             : 
     576             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     577             : 
     578             :     ! SDSP stands for 1-dimensional Gaussian mixture with scalar input point
     579           1 :     function getLogProbMixNormSP_CK(nmode,LogAmplitude,MeanVec,InvCovMat,LogSqrtDetInvCovMat,point) result(logProbMixNorm)
     580             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     581             :         !DEC$ ATTRIBUTES DLLEXPORT :: getLogProbMixNormSP_CK
     582             : #endif
     583           1 :         use Constants_mod, only: IK, RK, CK, LOGTINY_RK
     584             :         implicit none
     585             :         integer(IK), intent(in) :: nmode
     586             :         complex(CK), intent(in) :: LogAmplitude(nmode),MeanVec(nmode)
     587             :         complex(CK), intent(in) :: InvCovMat(nmode),LogSqrtDetInvCovMat(nmode)
     588             :         complex(CK), intent(in) :: point
     589             :         complex(CK)             :: logProbMixNorm
     590           3 :         complex(CK)             :: normFac,LogProb(nmode)
     591             :         integer(IK)             :: imode
     592           3 :         do imode = 1, nmode
     593           3 :             LogProb(imode) = LogAmplitude(imode) + getLogProbNorm(MeanVec(imode),InvCovMat(imode),LogSqrtDetInvCovMat(imode),point)
     594             :         end do
     595           4 :         normFac = maxval(real(LogProb))
     596           3 :         LogProb = LogProb - normFac
     597           9 :         where(real(LogProb)<LOGTINY_RK)
     598           1 :             LogProb = 0._RK
     599             :         elsewhere
     600           1 :             LogProb = exp(LogProb)
     601             :         end where
     602           3 :         logProbMixNorm = normFac + log(sum(LogProb))
     603           1 :     end function getLogProbMixNormSP_CK
     604             : 
     605             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     606             : 
     607           5 :     function getLogProbMixNormMP_CK(nmode,np,LogAmplitude,MeanVec,InvCovMat,LogSqrtDetInvCovMat,Point) result(logProbMixNorm)
     608             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     609             :         !DEC$ ATTRIBUTES DLLEXPORT :: getLogProbMixNormMP_CK
     610             : #endif
     611           1 :         use Constants_mod, only: IK, RK, CK, LOGTINY_RK
     612             :         implicit none
     613             :         integer(IK), intent(in) :: nmode,np
     614             :         complex(CK), intent(in) :: LogAmplitude(nmode),MeanVec(nmode)
     615             :         complex(CK), intent(in) :: InvCovMat(nmode),LogSqrtDetInvCovMat(nmode)
     616             :         complex(CK), intent(in) :: Point(np)
     617             :         complex(CK)             :: logProbMixNorm(np)
     618          10 :         complex(CK)             :: normFac(np),LogProb(nmode,np)
     619             :         integer(IK)             :: imode, ip
     620           3 :         do imode = 1, nmode
     621           7 :             LogProb(imode,1:np) = LogAmplitude(imode) + getLogProbNorm(np,MeanVec(imode),InvCovMat(imode),LogSqrtDetInvCovMat(imode),Point)
     622             :         end do
     623           9 :         normFac = maxval(real(LogProb),dim=1)
     624           3 :         do ip = 1,np
     625           6 :             LogProb(1:nmode,ip) = LogProb(1:nmode,ip) - normFac(ip)
     626           6 :             do imode = 1,nmode
     627           6 :                 if ( real(LogProb(imode,ip)) < LOGTINY_RK ) then
     628           0 :                     LogProb(imode,ip) = 0._RK
     629             :                 else
     630           4 :                     LogProb(imode,ip) = exp( LogProb(imode,ip) )
     631             :                 end if
     632             :             end do
     633           7 :             logProbMixNorm(ip) = normFac(ip) + log(sum(LogProb(1:nmode,ip)))
     634             :         end do
     635           1 :     end function getLogProbMixNormMP_CK
     636             : 
     637             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     638             : 
     639           1 :   function getLogProbMixMVNSP_CK(nmode,nd,LogAmplitude,MeanVec,InvCovMat,LogSqrtDetInvCovMat,Point) result(logProbMixMVN)
     640             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     641             :         !DEC$ ATTRIBUTES DLLEXPORT :: getLogProbMixMVNSP_CK
     642             : #endif
     643           1 :         use Constants_mod, only: IK, RK, CK, LOGTINY_RK
     644             :         implicit none
     645             :         integer(IK), intent(in) :: nmode,nd
     646             :         complex(CK), intent(in) :: LogAmplitude(nmode), MeanVec(nd,nmode)
     647             :         complex(CK), intent(in) :: InvCovMat(nd,nd,nmode), LogSqrtDetInvCovMat(nmode)
     648             :         complex(CK), intent(in) :: Point(nd)
     649             :         complex(CK)             :: logProbMixMVN
     650           3 :         complex(CK)             :: normFac,LogProb(nmode)
     651             :         integer(IK)             :: imode
     652           3 :         do imode = 1, nmode
     653           3 :             LogProb(imode) = LogAmplitude(imode) + getLogProbMVN(nd,MeanVec(1:nd,imode),InvCovMat(1:nd,1:nd,imode),LogSqrtDetInvCovMat(imode),Point)
     654             :         end do
     655           4 :         normFac = maxval(real(LogProb))
     656           3 :         LogProb = LogProb - normFac
     657           9 :         where(real(LogProb)<LOGTINY_RK)
     658           1 :             LogProb = 0._RK
     659             :         elsewhere
     660           1 :             LogProb = exp(LogProb)
     661             :         end where
     662           3 :         logProbMixMVN = normFac + log(sum(LogProb))
     663           1 :     end function getLogProbMixMVNSP_CK
     664             : 
     665             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     666             : 
     667           5 :     function getLogProbMixMVNMP_CK(nmode,nd,np,LogAmplitude,MeanVec,InvCovMat,LogSqrtDetInvCovMat,Point) result(logProbMixMVN)
     668             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     669             :         !DEC$ ATTRIBUTES DLLEXPORT :: getLogProbMixMVNMP_CK
     670             : #endif
     671           1 :         use Constants_mod, only: IK, RK, CK, LOGTINY_RK
     672             :         implicit none
     673             :         integer(IK), intent(in) :: nmode,nd,np
     674             :         complex(CK), intent(in) :: LogAmplitude(nmode),MeanVec(nd,nmode)
     675             :         complex(CK), intent(in) :: InvCovMat(nd,nd,nmode), LogSqrtDetInvCovMat(nmode)
     676             :         complex(CK), intent(in) :: Point(nd,np)
     677             :         complex(CK)             :: logProbMixMVN(np)
     678          10 :         complex(CK)             :: normFac(np),LogProb(nmode,np)
     679             :         integer(IK)             :: imode, ip
     680           3 :         do imode = 1, nmode
     681           7 :             LogProb(imode,1:np) = LogAmplitude(imode) + getLogProbMVN(nd,np,MeanVec(1:nd,imode),InvCovMat(1:nd,1:nd,imode),LogSqrtDetInvCovMat(imode),Point)
     682             :         end do
     683           9 :         normFac = maxval(real(LogProb),dim=1)
     684           3 :         do ip = 1,np
     685           6 :             LogProb(1:nmode,ip) = LogProb(1:nmode,ip) - normFac(ip)
     686           6 :             do imode = 1,nmode
     687           6 :                 if ( real(LogProb(imode,ip))<LOGTINY_RK ) then
     688           2 :                     LogProb(imode,ip) = 0._RK
     689             :                 else
     690           2 :                     LogProb(imode,ip) = exp( LogProb(imode,ip) )
     691             :                 end if
     692             :             end do
     693           7 :             logProbMixMVN(ip) = normFac(ip) + log(sum(LogProb(1:nmode,ip)))
     694             :         end do
     695           1 :     end function getLogProbMixMVNMP_CK
     696             : 
     697             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     698             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     699             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     700             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     701             : 
     702             :     !include "Statistics_mod@MahalSq_RK.inc.f90"
     703             :     !include "Statistics_mod@MahalSq_CK.inc.f90"
     704             :     !include "Statistics_mod@LogProbGaus_RK.inc.f90"
     705             :     !include "Statistics_mod@LogProbGaus_CK.inc.f90"
     706             :     !include "Statistics_mod@LogProbGausMix_RK.inc.f90"
     707             :     !include "Statistics_mod@LogProbGausMix_CK.inc.f90"
     708             : 
     709             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     710             : 
     711             :     !> \brief
     712             :     !> Flatten the input `Point` array such that each element of the output 
     713             :     !> `FlattenedPoint` array has the same unity weight as elements in the array.
     714             :     !>
     715             :     !> \param[in]       nd      :   The number of dimensions of the input sample.
     716             :     !> \param[in]       np      :   The number of points in the sample.
     717             :     !> \param[in]       Point   :   The array of shape `(nd,np)` containing the sample.
     718             :     !> \param[in]       Weight  :   The vector of length `np` containing the weights of points in the sample.
     719             :     !>                              The values of elements of Weight are allowed to be negative, in which case,
     720             :     !>                              the corresponding elements will be excluded from the output `FlattenedPoint`.
     721             :     !>
     722             :     !> \warning
     723             :     !> Note the shape of the input argument `Point(nd,np)`.
     724             :     !>
     725             :     !> \return
     726             :     !> `FlattenedPoint` : The flattened array whose elements all have the same weight.
     727           5 :     pure function flatten_2D(nd,np,Point,Weight) result(FlattenedPoint)
     728             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     729             :         !DEC$ ATTRIBUTES DLLEXPORT :: flatten_2D
     730             : #endif
     731             :         ! the implementation for one-dimension is very concise and nice: mean = sum(Weight*Point) / sum(Weight)
     732             :         implicit none
     733             :         integer(IK), intent(in) :: np,nd            ! np: number of observations, nd: number of variables for each observation
     734             :         real(RK)   , intent(in) :: Point(nd,np)     ! Point is the data matrix
     735             :         integer(IK), intent(in) :: Weight(np)       ! sample weight
     736             :         integer(IK)             :: ip, iweight, sumWeight, counter
     737             :         real(RK), allocatable   :: FlattenedPoint(:,:)
     738           5 :         sumWeight = 0_IK
     739          49 :         do ip = 1, np
     740          49 :             if (Weight(ip)>0_IK) sumWeight = sumWeight + Weight(ip)
     741             :         end do
     742           5 :         allocate(FlattenedPoint(nd,sumWeight))
     743           5 :         counter = 0_IK
     744          49 :         do ip = 1, np
     745          92 :             do iweight = 1, Weight(ip)
     746          43 :                 counter = counter + 1_IK
     747         213 :                 FlattenedPoint(1:nd,counter) = Point(1:nd,ip)
     748             :             end do
     749             :         end do
     750           1 :     end function flatten_2D
     751             : 
     752             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     753             : 
     754             :     !> \brief
     755             :     !> Return the mean of a sample of multidimensional points.
     756             :     !>
     757             :     !> \param[in]       nd      :   The number of dimensions of the input sample.
     758             :     !> \param[in]       np      :   The number of points in the sample.
     759             :     !> \param[in]       Point   :   The array of shape `(nd,np)` containing the sample.
     760             :     !> \param[in]       Weight  :   The vector of length `np` containing the weights of points in the sample (**optional**, default = vector of ones).
     761             :     !>
     762             :     !> \warning
     763             :     !> Note the shape of the input argument `Point(nd,np)`.
     764             :     !>
     765             :     !> \return
     766             :     !> `Mean` : The output mean vector of length `nd`.
     767          36 :     pure function getMean_2D(nd,np,Point,Weight) result(Mean)
     768             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     769             :         !DEC$ ATTRIBUTES DLLEXPORT :: getMean_2D
     770             : #endif
     771             :         ! the implementation for one-dimension is very concise and nice: mean = sum(Weight*Point) / sum(Weight)
     772             :         implicit none
     773             :         integer(IK), intent(in)             :: np,nd            ! np: number of observations, nd: number of variables for each observation
     774             :         real(RK)   , intent(in)             :: Point(nd,np)     ! Point is the data matrix
     775             :         integer(IK), intent(in), optional   :: Weight(np)       ! sample weight
     776             :         real(RK)                            :: Mean(nd)         ! output mean vector
     777             :         integer(IK)                         :: ip, sumWeight
     778          22 :         Mean = 0._RK
     779           7 :         if (present(Weight)) then
     780           6 :             sumWeight = 0_IK
     781          23 :             do ip = 1,np
     782          17 :                 sumWeight = sumWeight + Weight(ip)
     783          60 :                 Mean = Mean + Weight(ip) * Point(1:nd,ip)
     784             :             end do
     785          18 :             Mean = Mean / sumWeight
     786             :         else
     787           6 :             do ip = 1,np
     788          21 :                 Mean = Mean + Point(1:nd,ip)
     789             :             end do
     790           4 :             Mean = Mean / real(np,kind=RK)
     791             :         end if
     792          12 :     end function getMean_2D
     793             : 
     794             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     795             : 
     796             :     !> \brief
     797             :     !> Return the normalized data with respect to the input mean vector of length `nd`.
     798             :     !>
     799             :     !> \param[in]       nd      :   The number of dimensions of the input sample.
     800             :     !> \param[in]       np      :   The number of points in the sample.
     801             :     !> \param[in]       Mean    :   The mean vector of length `nd`.
     802             :     !> \param[in]       Point   :   The array of shape `(nd,np)` containing the sample.
     803             :     !>
     804             :     !> \return
     805             :     !> `NormData` : The output normalized points array of shape `(np,nd)`.
     806             :     !>
     807             :     !> \remark
     808             :     !> Note the difference in the shape of the input `Point` vs. the output `NormData`.
     809          21 :     pure function getNormData_2D(nd,np,Mean,Point) result(NormData)
     810             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     811             :         !DEC$ ATTRIBUTES DLLEXPORT :: getNormData_2D
     812             : #endif
     813             :         implicit none
     814             :         integer(IK), intent(in)  :: np,nd           ! np is the number of observations, nd is the number of parameters for each observation
     815             :         real(RK)   , intent(in)  :: Mean(nd)        ! Mean vector
     816             :         real(RK)   , intent(in)  :: Point(nd,np)    ! Point is the matrix of the data, CovMat contains the elements of the sample covariance matrix
     817             :         real(RK)                 :: NormData(np,nd)
     818             :         integer(IK)              :: i
     819           6 :         do i = 1,np
     820          21 :             NormData(i,1:nd) = Point(1:nd,i) - Mean
     821             :         end do
     822           8 :     end function getNormData_2D
     823             : 
     824             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     825             : 
     826             :     !> \brief
     827             :     !> Return the normalized 2D data of size `(nd,np)` with respect to the mean of the data along the second dimension of length `np`.
     828             :     !>
     829             :     !> \param[in]   nd          :   The length of the input `Data` matrix along the first dimension.
     830             :     !> \param[in]   np          :   The length of the input `Data` matrix along the second dimension.
     831             :     !> \param[in]   Data        :   The input data series data vector.
     832             :     !> \param[in]   Weight      :   The vector of weights of the input data points (**optional**, default = array of ones).
     833             :     !> \param[in]   tenabled    :   A logical value that, if `.true.` will cause the output `NormData` to have transposed shape
     834             :     !>                              of the input `Point(nd,np)` matrix, that is `(np,nd)` (**optional**, default = `.false.`).
     835             :     !>
     836             :     !> \return
     837             :     !> `NormData` : The integrated autocorrelation (IAC) via the BatchMeans method.
     838             :     !>
     839             :     !> \remark
     840             :     !> Note that np must be large enough to get a meaningful answer.
     841          19 :     pure function normalizeWeightedData_2D(nd, np, Data, Weight, tenabled) result(NormData)
     842             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     843             :         !DEC$ ATTRIBUTES DLLEXPORT :: normalizeWeightedData_2D
     844             : #endif
     845           1 :         use Constants_mod, only: IK, RK
     846             :         implicit none
     847             :         integer(IK) , intent(in)            :: nd, np
     848             :         real(RK)    , intent(in)            :: Data(nd,np)
     849             :         integer(IK) , intent(in), optional  :: Weight(np)
     850             :         logical     , intent(in), optional  :: tenabled
     851             :         real(RK)    , allocatable           :: NormData(:,:)
     852             :         logical                             :: tenabledDefault
     853          51 :         real(RK)                            :: Mean(nd)
     854          17 :         real(RK)                            :: sumWeight
     855             :         integer(IK)                         :: id, ip
     856             : 
     857          17 :         tenabledDefault = .false.
     858          17 :         if (present(tenabled)) tenabledDefault = tenabled
     859             : 
     860          34 :         Mean = 0._RK
     861          17 :         if (present(Weight)) then
     862           2 :             sumWeight = 0._RK
     863       10087 :             do ip = 1, np
     864       10085 :                 sumWeight = sumWeight + Weight(ip)
     865       20172 :                 Mean = Mean + Weight(ip) * Data(1:nd,ip)
     866             :             end do
     867             :         else
     868          15 :             sumWeight = np
     869      149790 :             do ip = 1, np
     870      299565 :                 Mean = Mean + Data(1:nd,ip)
     871             :             end do
     872             :         end if
     873          34 :         Mean = Mean / sumWeight
     874             : 
     875          17 :         if (tenabledDefault) then
     876           2 :             allocate(NormData(np,nd))
     877           2 :             do concurrent(id = 1:nd)
     878       10089 :                 NormData(1:np,id) = Data(id,1:np) - Mean(id)
     879             :             end do
     880             :         else
     881          15 :             allocate(NormData(nd,np))
     882          15 :             do concurrent(id = 1:nd)
     883      149805 :                 NormData(id,1:np) = Data(id,1:np) - Mean(id)
     884             :             end do
     885             :         end if
     886             : 
     887          34 :     end function normalizeWeightedData_2D
     888             : 
     889             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     890             : 
     891             :     !> \brief
     892             :     !> Return the variance of the input vector of values of length `np`.
     893             :     !>
     894             :     !> \param[in]       np          :   The number of points in the sample.
     895             :     !> \param[in]       mean        :   The mean of the vector.
     896             :     !> \param[in]       Point       :   The array of shape `np` containing the sample.
     897             :     !> \param[in]       Weight      :   The vector of weights of the points in the sample (**optional**).
     898             :     !> \param[in]       sumWeight   :   The sum of the vector of weights (**optional**, if `Weight` is also missing).
     899             :     !>
     900             :     !> \return
     901             :     !> `variance` : The variance of the input sample.
     902             :     !>
     903             :     !> \warning
     904             :     !> If `Weight` is present, then `sumWeight` must be also present.
     905             :     !> Why? if mean is already given, it implies that sumWeight is also computed a priori.
     906             :     !>
     907             :     !> \remark
     908             :     !> One also use the concise Fortran syntax to achieve the same goal as this function:
     909             :     !> ```
     910             :     !> mean = sum(Weight*Point) / sum(Weight)
     911             :     !> variance = sum( (Weight*(Point-mean))**2 ) / (sum(Weight)-1)
     912             :     !> ```
     913             :     !> But the above concise version will be slightly slower as it involves three loops instead of two.
     914           3 :     pure function getVariance_1D(np,mean,Point,Weight,sumWeight) result(variance)
     915             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     916             :         !DEC$ ATTRIBUTES DLLEXPORT :: getVariance_1D
     917             : #endif
     918             :         implicit none
     919             :         integer(IK), intent(in)             :: np                       ! np is the number of observations (points) whose variance is to be computed
     920             :         real(RK)   , intent(in)             :: mean                     ! the mean value of the vector Point
     921             :         real(RK)   , intent(in)             :: Point(np)                ! Point is the vector of data
     922             :         integer(IK), intent(in), optional   :: Weight(np), sumWeight    ! sample weight
     923             :         real(RK)                            :: variance                 ! output mean vector
     924             :         integer(IK)                         :: ip
     925           2 :         variance = 0._RK
     926           2 :         if (present(Weight)) then
     927          16 :             do ip = 1,np
     928          16 :                 variance = variance + Weight(ip) * ( Point(ip) - mean )**2
     929             :             end do
     930           1 :             variance = variance / real(sumWeight-1_IK,kind=RK)
     931             :         else
     932          16 :             do ip = 1,np
     933          16 :                 variance = variance + ( Point(ip) - mean )**2
     934             :             end do
     935           1 :             variance = variance / real(np-1_IK,kind=RK)
     936             :         end if
     937          19 :     end function getVariance_1D
     938             : 
     939             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     940             : 
     941             :     !> \brief
     942             :     !> Return the vector of variance of a set of `np` points of `nd` dimensions.
     943             :     !>
     944             :     !> \param[in]       nd          :   The number of dimensions of the input sample.
     945             :     !> \param[in]       np          :   The number of points in the sample.
     946             :     !> \param[in]       Mean        :   The mean vector of the sample.
     947             :     !> \param[in]       Point       :   The array of shape `(nd,np)` containing the sample.
     948             :     !> \param[in]       Weight      :   The vector of weights of the points in the sample of shape `(nd,np)` (**optional**).
     949             :     !>
     950             :     !> \return
     951             :     !> `Variance` : The vector of length `nd` of the variances of the input sample.
     952          12 :     pure function getVariance_2D(nd,np,Mean,Point,Weight) result(Variance)
     953             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     954             :         !DEC$ ATTRIBUTES DLLEXPORT :: getVariance_2D
     955             : #endif
     956             :         ! returns the variance of each row in Point weighted by the corresponding Weight if provided
     957             :         ! pass the Mean vector by calling getMean() or getMean_2D()
     958             :         implicit none
     959             :         integer(IK), intent(in)             :: nd, np           ! np is the number of observations (points) whose variance is to be computed
     960             :         real(RK)   , intent(in)             :: Mean(nd)         ! the Mean value of the vector Point
     961             :         real(RK)   , intent(in)             :: Point(nd,np)     ! Point is the vector of data
     962             :         integer(IK), intent(in), optional   :: Weight(np)       ! sample weight
     963             :         real(RK)                            :: Variance(nd)     ! output Mean vector
     964             :         integer(IK)                         :: ip, sumWeight
     965           8 :         Variance = 0._RK
     966           2 :         if (present(Weight)) then
     967           1 :             sumWeight = 0_IK
     968           6 :             do ip = 1,np
     969           5 :                 sumWeight = sumWeight + Weight(ip)
     970          21 :                 Variance = Variance + Weight(ip) * ( Point(1:nd,ip) - Mean )**2
     971             :             end do
     972           4 :             Variance = Variance / real(sumWeight-1_IK,kind=RK)
     973             :         else
     974           6 :             do ip = 1,np
     975          21 :                 Variance = Variance + ( Point(1:nd,ip) - Mean )**2
     976             :             end do
     977           4 :             Variance = Variance / real(np-1_IK,kind=RK)
     978             :         end if
     979           4 :     end function getVariance_2D
     980             : 
     981             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     982             : 
     983             :     !> \brief
     984             :     !> Return the lower triangle Cholesky Factor of the covariance matrix of a set of points in the lower part of `CholeskyLower`.
     985             :     ! The upper part of `CholeskyLower`, including the diagonal elements of it, will contain the covariance matrix of the sample.
     986             :     ! The output argument `Diagonal`, contains the diagonal terms of Cholesky Factor.
     987             :     !>
     988             :     !> \param[in]       nd              :   The number of dimensions of the input sample.
     989             :     !> \param[in]       np              :   The number of points in the sample.
     990             :     !> \param[in]       Mean            :   The mean vector of the sample.
     991             :     !> \param[in]       Point           :   The array of shape `(nd,np)` containing the sample.
     992             :     !> \param[out]      CholeskyLower   :   The output matrix of shape `(nd,nd)` whose lower triangle contains elements of the Cholesky factor.
     993             :     !>                                      The upper triangle of the matrix contains the covariance matrix of the sample.
     994             :     !> \param[out]      Diagonal        :   The diagonal elements of the Cholesky factor.
     995             :     !>
     996             :     !> \todo
     997             :     !> The efficiency of this code can be further improved.
     998           1 :     subroutine getSamCholFac(nd,np,Mean,Point,CholeskyLower,Diagonal)
     999             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    1000             :         !DEC$ ATTRIBUTES DLLEXPORT :: getSamCholFac
    1001             : #endif
    1002           2 :         use Matrix_mod, only: getCholeskyFactor
    1003             :         implicit none
    1004             :         integer(IK), intent(in)  :: nd,np                  ! np is the number of observations, nd is the number of parameters for each observation
    1005             :         real(RK)   , intent(in)  :: Mean(nd)               ! Mean vector
    1006             :         real(RK)   , intent(in)  :: Point(nd,np)           ! Point is the matrix of the data, CovMat contains the elements of the sample covariance matrix
    1007             :         real(RK)   , intent(out) :: CholeskyLower(nd,nd)   ! Lower Cholesky Factor of the covariance matrix
    1008             :         real(RK)   , intent(out) :: Diagonal(nd)           ! Diagonal elements of the Cholesky factorization
    1009          19 :         real(RK)                 :: NormData(np,nd), npMinusOneInverse
    1010             :         integer(IK)              :: i,j
    1011             : 
    1012           6 :         do i = 1,np
    1013          21 :             NormData(i,1:nd) = Point(1:nd,i) - Mean
    1014             :         end do
    1015             : 
    1016             :         ! Only upper half of CovMat is needed
    1017           1 :         npMinusOneInverse = 1._RK / real(np-1,kind=RK)
    1018           4 :         do j = 1,nd
    1019          10 :             do i = 1,j
    1020             :                 ! Get the covariance matrix elements: only the upper half of CovMat is needed
    1021          39 :                 CholeskyLower(i,j) = dot_product( NormData(1:np,i) , NormData(1:np,j) ) * npMinusOneInverse
    1022             :             end do
    1023             :         end do
    1024             : 
    1025             :         ! XXX: The efficiency can be improved by merging it with the above loops
    1026           1 :         call getCholeskyFactor(nd,CholeskyLower,Diagonal)
    1027             : 
    1028           1 :   end subroutine getSamCholFac
    1029             : 
    1030             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    1031             : 
    1032             :     !> \brief
    1033             :     !> Return the sample mean, covariance matrix, the Mahalanobis distances squared of the points with respect to the sample,
    1034             :     !> and the square root of the determinant of the inverse covariance matrix of the sample.
    1035             :     !>
    1036             :     !> \param[in]       nd                  :   The number of dimensions of the input sample.
    1037             :     !> \param[in]       np                  :   The number of points in the sample.
    1038             :     !> \param[in]       Point               :   The array of shape `(np,nd)` containing the sample.
    1039             :     !> \param[out]      CovMat              :   The output matrix of shape `(nd,nd)` representing the covariance matrix of the input data.
    1040             :     !> \param[out]      Mean                :   The output mean vector of the sample.
    1041             :     !> \param[out]      MahalSq             :   The output Mahalanobis distances squared of the points with respect to the sample (**optional**).
    1042             :     !> \param[out]      InvCovMat           :   The output inverse covariance matrix of the input data (**optional**).
    1043             :     !> \param[out]      sqrtDetInvCovMat    :   The output square root of the determinant of the inverse covariance matrix of the sample (**optional**).
    1044             :     !>
    1045             :     !> \warning
    1046             :     !> If `sqrtDetInvCovMat` is present, then `MahalSq` and `InvCovMat` must be also present.
    1047             :     !>
    1048             :     !> \remark
    1049             :     !> Note the shape of the input `Point(np,nd)`.
    1050             :     !>
    1051             :     !> \remark
    1052             :     !> See also, [getSamCovMeanTrans](@ref getsamcovmeantrans).
    1053             :     !>
    1054             :     !> \remark
    1055             :     !> For more information, see Geisser & Cornfield (1963) "Posterior distributions for multivariate normal parameters".
    1056             :     !> Also, Box and Tiao (1973), "Bayesian Inference in Statistical Analysis" Page 421.
    1057             :     !>
    1058             :     !> \author
    1059             :     !> Amir Shahmoradi, Oct 16, 2009, 11:14 AM, Michigan
    1060           3 :     subroutine getSamCovMean(np,nd,Point,CovMat,Mean,MahalSq,InvCovMat,sqrtDetInvCovMat)
    1061             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    1062             :         !DEC$ ATTRIBUTES DLLEXPORT :: getSamCovMean
    1063             : #endif
    1064           1 :         use Matrix_mod, only: getInvPosDefMatSqrtDet
    1065             :         implicit none
    1066             :         integer(IK), intent(in)             :: np,nd                  ! np is the number of observations, nd is the number of parameters for each observation
    1067             :         real(RK)   , intent(in)             :: Point(np,nd)           ! Point is the matrix of the data, CovMat contains the elements of the sample covariance matrix
    1068             :         real(RK)   , intent(out)            :: CovMat(nd,nd)          ! Covariance matrix of the input data
    1069             :         real(RK)   , intent(out)            :: Mean(nd)               ! Mean vector
    1070             :         real(RK)   , intent(out), optional  :: MahalSq(np)            ! Vector of Mahalanobis Distances Squared, with respect to the mean position of the sample
    1071             :         real(RK)   , intent(out), optional  :: InvCovMat(nd,nd)       ! Inverse Covariance matrix of the input data
    1072             :         real(RK)   , intent(out), optional  :: sqrtDetInvCovMat       ! sqrt determinant of the inverse covariance matrix
    1073          19 :         real(RK)                            :: NormData(np,nd)
    1074           5 :         real(RK)                            :: DummyVec(nd)
    1075             :         integer(IK)                         :: i,j
    1076             : 
    1077           4 :         do j = 1,nd
    1078          18 :             Mean(j) = sum(Point(1:np,j)) / real(np,kind=RK)
    1079          19 :             NormData(1:np,j) = Point(1:np,j) - Mean(j)
    1080             :         end do
    1081           4 :         do i = 1,nd
    1082          13 :             do j = 1,nd
    1083          57 :                 CovMat(i,j) = dot_product(NormData(1:np,i),NormData(1:np,j))/real(np-1,kind=RK)
    1084             :             end do
    1085             :         end do
    1086             : 
    1087           1 :         if (present(sqrtDetInvCovMat)) then   ! Calculate InCovMat, MahalSq, and sqrt Determinant of InCovMat
    1088           4 :             do j = 1,nd
    1089          10 :                 do i = 1,j
    1090           9 :                 InvCovMat(i,j) = CovMat(i,j)    ! Only the upper half of CovMat is needed
    1091             :                 end do
    1092             :             end do
    1093           1 :             call getInvPosDefMatSqrtDet(nd,InvCovMat,sqrtDetInvCovMat)
    1094           6 :             do i = 1,np
    1095          20 :                 do j = 1,nd
    1096          65 :                 DummyVec(j) = dot_product(InvCovMat(1:nd,j),NormData(i,1:nd))
    1097             :                 end do
    1098          21 :                 MahalSq(i) = dot_product(NormData(i,1:nd),DummyVec)
    1099             :             end do
    1100             :         end if
    1101             : 
    1102           1 :     end subroutine getSamCovMean
    1103             : 
    1104             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    1105             : 
    1106             :     !> \brief
    1107             :     !> Return the sample mean, covariance matrix, the Mahalanobis distances squared of the points with respect to the sample,
    1108             :     !> and the square root of the determinant of the inverse covariance matrix of the sample.
    1109             :     !>
    1110             :     !> \param[in]       nd                  :   The number of dimensions of the input sample.
    1111             :     !> \param[in]       np                  :   The number of points in the sample.
    1112             :     !> \param[in]       Point               :   The array of shape `(nd,np)` containing the sample.
    1113             :     !> \param[out]      CovMat              :   The output matrix of shape `(nd,nd)` representing the covariance matrix of the input data.
    1114             :     !> \param[out]      Mean                :   The output mean vector of the sample.
    1115             :     !> \param[out]      MahalSq             :   The output Mahalanobis distances squared of the points with respect to the sample (**optional**).
    1116             :     !> \param[out]      InvCovMat           :   The output inverse covariance matrix of the input data (**optional**).
    1117             :     !> \param[out]      sqrtDetInvCovMat    :   The output square root of the determinant of the inverse covariance matrix of the sample (**optional**).
    1118             :     !>
    1119             :     !> \warning
    1120             :     !> If `sqrtDetInvCovMat` is present, then `MahalSq` and `InvCovMat` must be also present.
    1121             :     !>
    1122             :     !> \remark
    1123             :     !> Note the shape of the input `Point(nd,np)`.
    1124             :     !>
    1125             :     !> \remark
    1126             :     !> This subroutine has the same functionality as [getSamCovMean](@ref getsamcovmean), with the only difference that input data is transposed here on input.
    1127             :     !> Based on the preliminary benchmarks with Intel 2017 ifort, `getSamCovMean()` is slightly faster than `getSamCovMeanTrans()`.
    1128             :     !>
    1129             :     !> \remark
    1130             :     !> For more information, see Geisser & Cornfield (1963) "Posterior distributions for multivariate normal parameters".
    1131             :     !> Also, Box and Tiao (1973), "Bayesian Inference in Statistical Analysis" Page 421.
    1132             :     !>
    1133             :     !> \author
    1134             :     !> Amir Shahmoradi, Oct 16, 2009, 11:14 AM, Michigan
    1135           6 :     subroutine getSamCovMeanTrans(np,nd,Point,CovMat,Mean,MahalSq,InvCovMat,sqrtDetInvCovMat)
    1136             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    1137             :         !DEC$ ATTRIBUTES DLLEXPORT :: getSamCovMeanTrans
    1138             : #endif
    1139             : 
    1140           1 :         use Matrix_mod, only: getInvPosDefMatSqrtDet
    1141             :         implicit none
    1142             :         integer(IK), intent(in)            :: np,nd                  ! np is the number of observations, nd is the number of parameters for each observation
    1143             :         real(RK)   , intent(in)            :: Point(nd,np)           ! Point is the matrix of the data, CovMat contains the elements of the sample covariance matrix
    1144             :         real(RK)   , intent(out)           :: CovMat(nd,nd)          ! Covariance matrix of the input data
    1145             :         real(RK)   , intent(out)           :: Mean(nd)               ! Mean vector
    1146             :         real(RK)   , intent(out), optional :: MahalSq(np)            ! Vector of Mahalanobis Distances Squared, with respect to the mean position of the sample
    1147             :         real(RK)   , intent(out), optional :: InvCovMat(nd,nd)       ! Inverse Covariance matrix of the input data
    1148             :         real(RK)   , intent(out), optional :: sqrtDetInvCovMat       ! sqrt determinant of the inverse covariance matrix
    1149          20 :         real(RK)   , dimension(nd)         :: DummyVec
    1150         144 :         real(RK)   , dimension(nd,np)      :: NormData
    1151             :         integer(IK)                        :: i,j
    1152             : 
    1153          16 :         Mean = 0._RK
    1154          39 :         do i = 1,np
    1155         144 :             do j = 1,nd
    1156         140 :                 Mean(j) = Mean(j) + Point(j,i)
    1157             :             end do
    1158             :         end do
    1159          16 :         Mean = Mean / real(np,kind=RK)
    1160             : 
    1161          39 :         do i = 1,np
    1162         144 :             NormData(1:nd,i) = Point(1:nd,i) - Mean
    1163             :         end do
    1164             : 
    1165          16 :         do i = 1,nd
    1166          52 :             do j = 1,nd
    1167         363 :                 CovMat(i,j) = dot_product(NormData(i,1:np),NormData(j,1:np)) / real(np-1,kind=RK)
    1168             :             end do
    1169             :         end do
    1170             : 
    1171           4 :         if (present(sqrtDetInvCovMat)) then   ! Calculate InCovMat, MahalSq, and sqrt Determinant of InCovMat
    1172           4 :             do j = 1,nd
    1173          10 :                 do i = 1,j
    1174           9 :                 InvCovMat(i,j) = CovMat(i,j)    ! Only the upper half of CovMat is needed
    1175             :                 end do
    1176             :             end do
    1177           1 :             call getInvPosDefMatSqrtDet(nd,InvCovMat,sqrtDetInvCovMat)
    1178           6 :             do i = 1,np
    1179          20 :                 do j = 1,nd
    1180          65 :                 DummyVec(j) = dot_product(InvCovMat(1:nd,j),NormData(1:nd,i))
    1181             :                 end do
    1182          21 :                 MahalSq(i) = dot_product(NormData(1:nd,i),DummyVec)
    1183             :                 !MahalSq = dot_product(NormData(1:nd,i),DummyVec)
    1184             :                 !if (maxMahal<MahalSq) maxMahal = MahalSq
    1185             :             end do
    1186             :             !maxMahal = maxval(MahalSq)
    1187             :         end if
    1188             : 
    1189           4 :     end subroutine getSamCovMeanTrans
    1190             : 
    1191             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    1192             : 
    1193             :     !> \brief
    1194             :     !> Return the sample mean and the upper triangle of the covariance matrix of the input sample.
    1195             :     !>
    1196             :     !> \param[in]       nd                  :   The number of dimensions of the input sample.
    1197             :     !> \param[in]       np                  :   The number of points in the sample.
    1198             :     !> \param[in]       Point               :   The array of shape `(nd,np)` containing the sample.
    1199             :     !> \param[out]      CovMatUpper         :   The output matrix of shape `(nd,nd)` whose upper triangle represents the covariance matrix of the input data.
    1200             :     !> \param[out]      Mean                :   The output mean vector of the sample.
    1201             :     !>
    1202             :     !> \remark
    1203             :     !> Note the shape of the input `Point(nd,np)`.
    1204             :     !>
    1205             :     !> \remark
    1206             :     !> This subroutine has the same functionality as [getSamCovMeanTrans](@ref getsamcovmeantrans), with the only difference
    1207             :     !> only the upper triangle of the covariance matrix is returned. Also, optional arguments are not available.
    1208             :     !> This subroutine is specifically optimized for use in the ParaMonte samplers.
    1209             :     !>
    1210             :     !> \remark
    1211             :     !> For more information, see Geisser & Cornfield (1963) "Posterior distributions for multivariate normal parameters".
    1212             :     !> Also, Box and Tiao (1973), "Bayesian Inference in Statistical Analysis" Page 421.
    1213             :     !>
    1214             :     !> \author
    1215             :     !> Amir Shahmoradi, Oct 16, 2009, 11:14 AM, Michigan
    1216          50 :     subroutine getSamCovUpperMeanTrans(np,nd,Point,CovMatUpper,Mean)
    1217             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    1218             :         !DEC$ ATTRIBUTES DLLEXPORT :: getSamCovUpperMeanTrans
    1219             : #endif
    1220           4 :         use Matrix_mod, only: getInvPosDefMatSqrtDet
    1221             :         implicit none
    1222             :         integer(IK), intent(in)            :: np,nd                  ! np is the number of observations, nd is the number of parameters for each observation
    1223             :         real(RK)   , intent(in)            :: Point(nd,np)           ! Point is the matrix of the data, CovMatUpper contains the elements of the sample covariance matrix
    1224             :         real(RK)   , intent(out)           :: CovMatUpper(nd,nd)     ! Covariance matrix of the input data
    1225             :         real(RK)   , intent(out)           :: Mean(nd)               ! Mean vector
    1226         636 :         real(RK)                           :: npMinusOneInvReal, NormData(nd,np)
    1227             :         integer(IK)                        :: i,j
    1228             : 
    1229         138 :         Mean = 0._RK
    1230         242 :         do i = 1,np
    1231         636 :             do j = 1,nd
    1232         586 :                 Mean(j) = Mean(j) + Point(j,i)
    1233             :             end do
    1234             :         end do
    1235         138 :         Mean = Mean / real(np,kind=RK)
    1236             : 
    1237         242 :         do i = 1,np
    1238         636 :             NormData(1:nd,i) = Point(1:nd,i) - Mean
    1239             :         end do
    1240             : 
    1241          50 :         npMinusOneInvReal = 1._RK / real(np-1,kind=RK)
    1242         138 :         do j = 1,nd
    1243         271 :             do i = 1,j
    1244         882 :                 CovMatUpper(i,j) = dot_product(NormData(i,1:np),NormData(j,1:np)) * npMinusOneInvReal
    1245             :             end do
    1246             :         end do
    1247             : 
    1248          50 :   end subroutine getSamCovUpperMeanTrans
    1249             : 
    1250             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    1251             : 
    1252             :     !> \brief
    1253             :     !> Return the mean and the upper triangle of the covariance matrix of the input *weighted* sample.
    1254             :     !>
    1255             :     !> \param[in]       nd                  :   The number of dimensions of the input sample.
    1256             :     !> \param[in]       sumWeight           :   The sum of all sample weights.
    1257             :     !> \param[in]       np                  :   The number of points in the sample.
    1258             :     !> \param[in]       Point               :   The array of shape `(nd,np)` containing the sample.
    1259             :     !> \param[in]       Weight              :   The integer array of length `np`, representing the weights of individual points in the sample.
    1260             :     !> \param[out]      CovMatUpper         :   The output matrix of shape `(nd,nd)` whose upper triangle represents the covariance matrix of the input data.
    1261             :     !> \param[out]      Mean                :   The output mean vector of the sample.
    1262             :     !>
    1263             :     !> \warning
    1264             :     !> Note the shape of the input argument `Point(nd,np)`.
    1265             :     !>
    1266             :     !> \remark
    1267             :     !> This subroutine has the same functionality as [getSamCovUpperMeanTrans](@ref getsamcovuppermeantrans), with the only difference
    1268             :     !> only the upper triangle of the covariance matrix is returned. Also, optional arguments are not available.
    1269             :     !> This subroutine is specifically optimized for use in the ParaMonte samplers.
    1270             :     !>
    1271             :     !> \remark
    1272             :     !> For more information, see Geisser & Cornfield (1963) "Posterior distributions for multivariate normal parameters".
    1273             :     !> Also, Box and Tiao (1973), "Bayesian Inference in Statistical Analysis" Page 421.
    1274             :     !>
    1275             :     !> \author
    1276             :     !> Amir Shahmoradi, Oct 16, 2009, 11:14 AM, Michigan
    1277       24270 :     subroutine getWeiSamCovUppMeanTrans(np,sumWeight,nd,Point,Weight,CovMatUpper,Mean)
    1278             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    1279             :         !DEC$ ATTRIBUTES DLLEXPORT :: getWeiSamCovUppMeanTrans
    1280             : #endif
    1281             : 
    1282          50 :         use Matrix_mod, only: getInvPosDefMatSqrtDet
    1283             :         implicit none
    1284             :         integer(IK), intent(in)             :: np,nd,sumWeight        ! np is the number of observations, nd is the number of parameters for each observation
    1285             :         integer(IK), intent(in)             :: Weight(np)             ! weights of the points
    1286             :         real(RK)   , intent(in)             :: Point(nd,np)           ! Point is the matrix of the data, CovMatUpper contains the elements of the sample covariance matrix
    1287             :         real(RK)   , intent(out)            :: CovMatUpper(nd,nd)     ! Covariance matrix of the input data
    1288             :         real(RK)   , intent(out)            :: Mean(nd)               ! Mean vector
    1289       24270 :         real(RK)                            :: sumWeightMinusOneInvReal
    1290      536610 :         real(RK)                            :: NormData(nd,np)
    1291             :         integer(IK)                         :: i,j,ip
    1292             : 
    1293       61472 :         Mean = 0._RK
    1294      219716 :         do i = 1,np
    1295      536610 :             do j = 1,nd
    1296      512340 :                 Mean(j) = Mean(j) + Weight(i)*Point(j,i)
    1297             :             end do
    1298             :         end do
    1299       61472 :         Mean = Mean / real(sumWeight,kind=RK)
    1300             : 
    1301      219716 :         do i = 1,np
    1302      536610 :             NormData(1:nd,i) = Point(1:nd,i) - Mean
    1303             :         end do
    1304             : 
    1305       24270 :         sumWeightMinusOneInvReal = 1._RK / real(sumWeight-1,kind=RK)
    1306       61472 :         do j = 1,nd
    1307      111607 :             do i = 1,j
    1308       50135 :                 CovMatUpper(i,j) = 0
    1309      488482 :                 do ip = 1,np
    1310      488482 :                     CovMatUpper(i,j) = CovMatUpper(i,j) + Weight(ip)*NormData(i,ip)*NormData(j,ip)
    1311             :                 end do
    1312       87337 :                 CovMatUpper(i,j) = CovMatUpper(i,j) * sumWeightMinusOneInvReal
    1313             :             end do
    1314             :         end do
    1315             : 
    1316       24270 :     end subroutine getWeiSamCovUppMeanTrans
    1317             : 
    1318             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    1319             : 
    1320             :     !> \brief
    1321             :     !> Given two input sample means and covariance matrices, return the combination of them as a single mean and covariance matrix.
    1322             :     !>
    1323             :     !> \param[in]       nd          :   The number of dimensions of the input sample.
    1324             :     !> \param[in]       npA         :   The number of points in sample `A`.
    1325             :     !> \param[in]       MeanVecA    :   The mean vector of sample `A`.
    1326             :     !> \param[in]       CovMatA     :   The covariance matrix of sample `A`.
    1327             :     !> \param[in]       npB         :   The number of points in sample `B`.
    1328             :     !> \param[in]       MeanVecB    :   The mean vector of sample `B`.
    1329             :     !> \param[in]       CovMatB     :   The covariance matrix of sample `B`.
    1330             :     !> \param[out]      MeanVecAB   :   The output mean vector of the combined sample.
    1331             :     !> \param[out]      CovMatAB    :   The output covariance matrix of the combined sample.
    1332             :     !>
    1333             :     !> \author
    1334             :     !> Amir Shahmoradi, Oct 16, 2009, 11:14 AM, Michigan
    1335             :     !>
    1336             :     !> \remark
    1337             :     !> An exact implementation of this algorithm which needs only the upper triangles of the input matrices and
    1338             :     !> yields only the upper triangle of the covariance matrix is given in [mergeMeanCovUpper](@ref mergemeancovupper).
    1339             :     !> The alternative implementation is much more efficient, by a factor of 6-7 with all compiler optimization flags on.
    1340             :     !>
    1341             :     ! This subroutine uses a recursion equation similar to http://stats.stackexchange.com/questions/97642/how-to-combine-sample-means-and-sample-variances
    1342             :     ! See also: O’Neill, (2014), "Some Useful Moment Results in Sampling Problems".
    1343             :     ! See also: https://en.wikipedia.org/wiki/Algorithms_for_calculating_variance#Covariance
    1344             :     ! See also: https://stats.stackexchange.com/questions/43159/how-to-calculate-pooled-variance-of-two-groups-given-known-group-variances-mean
    1345           1 :     subroutine mergeMeanCov(nd,npA,MeanVecA,CovMatA,npB,MeanVecB,CovMatB,MeanVecAB,CovMatAB)
    1346             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    1347             :         !DEC$ ATTRIBUTES DLLEXPORT :: mergeMeanCov
    1348             : #endif
    1349             :         implicit none
    1350             :         integer(IK), intent(in)       :: nd
    1351             :         integer(IK), intent(in)       :: npA,npB
    1352             :         real(RK)   , intent(in)       :: MeanVecA(nd),CovMatA(nd,nd)
    1353             :         real(RK)   , intent(in)       :: MeanVecB(nd),CovMatB(nd,nd)
    1354             :         real(RK)   , intent(out)      :: MeanVecAB(nd),CovMatAB(nd,nd)
    1355          14 :         real(RK)   , dimension(nd,1)  :: MeanMatA,MeanMatB,MeanMat
    1356          14 :         real(RK)                      :: DistanceSq(nd,nd)
    1357           1 :         real(RK)                      :: npABinverse
    1358             :         integer(IK)                   :: npAB
    1359             : 
    1360           1 :         npAB = npA + npB
    1361           1 :         npABinverse = 1._RK / real(npAB, kind=RK)
    1362           4 :         MeanMatA(1:nd,1) = MeanVecA
    1363           4 :         MeanMatB(1:nd,1) = MeanVecB
    1364             : 
    1365             :         ! Compute the new Mean
    1366             : 
    1367           4 :         MeanVecAB = ( npA * MeanVecA + npB * MeanVecB ) * npABinverse
    1368           4 :         MeanMat(1:nd,1) = MeanVecAB
    1369             : 
    1370             :         ! Compute the new Covariance matrix
    1371             : 
    1372          23 :         DistanceSq = matmul( (MeanMatA-MeanMatB), transpose((MeanMatA-MeanMatB)) ) * npA * npB * npABinverse
    1373          13 :         CovMatAB = ( (npA-1) * CovMatA + (npB-1) * CovMatB + DistanceSq ) / real(npAB-1, kind=RK)
    1374             : 
    1375       24270 :     end subroutine mergeMeanCov
    1376             : 
    1377             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    1378             : 
    1379             : !    !> \brief
    1380             : !    !> Given two input sample means and covariance matrices, return the combination of them as a single mean and covariance matrix.
    1381             : !    !>
    1382             : !    !> \param[in]       nd              :   The number of dimensions of the input sample.
    1383             : !    !> \param[in]       npA             :   The number of points in sample `A`.
    1384             : !    !> \param[in]       MeanVecA        :   The mean vector of sample `A`.
    1385             : !    !> \param[in]       CovMatUpperA    :   The covariance matrix of sample `A`.
    1386             : !    !> \param[in]       npB             :   The number of points in sample `B`.
    1387             : !    !> \param[in]       MeanVecB        :   The mean vector of sample `B`.
    1388             : !    !> \param[in]       CovMatUpperB    :   The covariance matrix of sample `B`.
    1389             : !    !> \param[out]      MeanVecAB       :   The output mean vector of the combined sample.
    1390             : !    !> \param[out]      CovMatUpperAB   :   The output covariance matrix of the combined sample.
    1391             : !    !>
    1392             : !    !> \todo
    1393             : !    !> The efficiency of this algorithm might still be improved by converting the upper triangle covariance matrix to a packed vector.
    1394             : !    !>
    1395             : !    !> \remark
    1396             : !    !> This subroutine is the same as [mergeMeanCov](@ref mergeMeanCov), with the **important difference** that only the
    1397             : !    !> upper triangles and diagonals of the input covariance matrices need to be given by the user: `CovMatUpperA`, `CovMatUpperB`
    1398             : !    !> This alternative implementation is 6-7 times faster, with all compiler optimization flags on.
    1399             : !    !>
    1400             : !    !> \author
    1401             : !    !> Amir Shahmoradi, Nov 24, 2020, 4:19 AM, Dallas, TX
    1402             : !    subroutine mergeMeanCovUpperSlow(nd,npA,MeanVecA,CovMatUpperA,npB,MeanVecB,CovMatUpperB,MeanVecAB,CovMatUpperAB)
    1403             : !#if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    1404             : !        !DEC$ ATTRIBUTES DLLEXPORT :: mergeMeanCovUpperSlow
    1405             : !#endif
    1406             : !        implicit none
    1407             : !        integer(IK), intent(in)             :: nd
    1408             : !        integer(IK), intent(in)             :: npA,npB
    1409             : !        real(RK)   , intent(in)             :: MeanVecA(nd),CovMatUpperA(nd,nd)
    1410             : !        real(RK)   , intent(in)             :: MeanVecB(nd),CovMatUpperB(nd,nd)
    1411             : !        real(RK)   , intent(out)            :: MeanVecAB(nd),CovMatUpperAB(nd,nd)
    1412             : !        real(RK)                            :: npABinverse, npAnpB2npAB
    1413             : !        real(RK)                            :: npA2npAB, npB2npAB
    1414             : !        real(RK)                            :: MeanVecDiffAB(nd)
    1415             : !        integer(IK)                         :: npAB, i, j
    1416             : !
    1417             : !        npAB = npA + npB
    1418             : !        npABinverse = 1._RK / real(npAB, kind=RK)
    1419             : !        npAnpB2npAB = npA * npB * npABinverse
    1420             : !        npA2npAB = npA * npABinverse
    1421             : !        npB2npAB = npB * npABinverse
    1422             : !
    1423             : !        ! Compute the new Mean and Covariance matrix
    1424             : !
    1425             : !        do j = 1, nd
    1426             : !            MeanVecDiffAB(j) = MeanVecA(j) - MeanVecB(j)
    1427             : !            !MeanVecAB(j) = ( npA * MeanVecA(j) + npB * MeanVecB(j) ) * npABinverse
    1428             : !            MeanVecAB(j) = npA2npAB * MeanVecA(j) + npB2npAB * MeanVecB(j)
    1429             : !            do i = 1, j
    1430             : !                CovMatUpperAB(i,j) = ( (npA-1) * CovMatUpperA(i,j) + (npB-1) * CovMatUpperB(i,j) + MeanVecDiffAB(i) * MeanVecDiffAB(j) * npAnpB2npAB ) / real(npAB-1, kind=RK)
    1431             : !            end do
    1432             : !        end do
    1433             : !
    1434             : !
    1435             : !    end subroutine mergeMeanCovUpperSlow
    1436             : 
    1437             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    1438             : 
    1439             :     !> \brief
    1440             :     !> Given two input sample means and covariance matrices, return the combination of them as a single mean and covariance matrix.
    1441             :     !>
    1442             :     !> \param[in]       nd              :   The number of dimensions of the input sample.
    1443             :     !> \param[in]       npA             :   The number of points in sample `A`.
    1444             :     !> \param[in]       MeanVecA        :   The mean vector of sample `A`.
    1445             :     !> \param[in]       CovMatUpperA    :   The covariance matrix of sample `A`.
    1446             :     !> \param[in]       npB             :   The number of points in sample `B`.
    1447             :     !> \param[in]       MeanVecB        :   The mean vector of sample `B`.
    1448             :     !> \param[in]       CovMatUpperB    :   The covariance matrix of sample `B`.
    1449             :     !> \param[out]      MeanVecAB       :   The output mean vector of the combined sample.
    1450             :     !> \param[out]      CovMatUpperAB   :   The output covariance matrix of the combined sample.
    1451             :     !>
    1452             :     !> \remark
    1453             :     !> This subroutine is the same as [mergeMeanCov](@ref mergemeancov), with the **important difference** that only the
    1454             :     !> upper triangles and diagonals of the input covariance matrices need to be given by the user: `CovMatUpperA`, `CovMatUpperB`
    1455             :     !> This alternative implementation is 6-7 times faster, with all compiler optimization flags on.
    1456             :     !> In addition, all computational coefficients are predefined in this implementation,
    1457             :     !> resulting in an extra 10%-15% efficiency gain.
    1458             :     !>
    1459             :     !> \todo
    1460             :     !> The efficiency of this algorithm might still be improved by converting the upper triangle covariance matrix to a packed vector.
    1461             :     !>
    1462             :     !> \author
    1463             :     !> Amir Shahmoradi, Nov 24, 2020, 4:19 AM, Dallas, TX
    1464       23642 :     subroutine mergeMeanCovUpper(nd,npA,MeanVecA,CovMatUpperA,npB,MeanVecB,CovMatUpperB,MeanVecAB,CovMatUpperAB)
    1465             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    1466             :         !DEC$ ATTRIBUTES DLLEXPORT :: mergeMeanCovUpper
    1467             : #endif
    1468             :         implicit none
    1469             :         integer(IK), intent(in)             :: nd
    1470             :         integer(IK), intent(in)             :: npA,npB
    1471             :         real(RK)   , intent(in)             :: MeanVecA(nd),CovMatUpperA(nd,nd)
    1472             :         real(RK)   , intent(in)             :: MeanVecB(nd),CovMatUpperB(nd,nd)
    1473             :         real(RK)   , intent(out)            :: MeanVecAB(nd),CovMatUpperAB(nd,nd)
    1474       59870 :         real(RK)                            :: MeanVecDiffAB(nd)
    1475       23642 :         real(RK)                            :: npAnpB2npAB2npABMinusOne
    1476       23642 :         real(RK)                            :: npAMinusOne2npABMinusOne
    1477       23642 :         real(RK)                            :: npBMinusOne2npABMinusOne
    1478       23642 :         real(RK)                            :: npABMinusOneInverse
    1479       23642 :         real(RK)                            :: npABinverse
    1480       23642 :         real(RK)                            :: npA2npAB
    1481       23642 :         real(RK)                            :: npB2npAB
    1482             :         integer(IK)                         :: npAB, i, j
    1483             : 
    1484       23642 :         npAB = npA + npB
    1485       23642 :         npABinverse = 1._RK / real(npAB, kind=RK)
    1486       23642 :         npABMinusOneInverse = 1._RK / real(npAB-1, kind=RK)
    1487       23642 :         npAnpB2npAB2npABMinusOne = npA * npB * npABinverse * npABMinusOneInverse
    1488       23642 :         npA2npAB = npA * npABinverse
    1489       23642 :         npB2npAB = npB * npABinverse
    1490       23642 :         npAMinusOne2npABMinusOne = (npA - 1_IK) * npABMinusOneInverse
    1491       23642 :         npBMinusOne2npABMinusOne = (npB - 1_IK) * npABMinusOneInverse
    1492             : 
    1493             :         ! Compute the new Mean and Covariance matrix
    1494             : 
    1495       59870 :         do j = 1, nd
    1496       36228 :             MeanVecDiffAB(j) = MeanVecA(j) - MeanVecB(j)
    1497       36228 :             MeanVecAB(j) = npA2npAB * MeanVecA(j) + npB2npAB * MeanVecB(j)
    1498      108685 :             do i = 1, j
    1499       48815 :                 CovMatUpperAB(i,j)  = npAMinusOne2npABMinusOne * CovMatUpperA(i,j) &
    1500       48815 :                                     + npBMinusOne2npABMinusOne * CovMatUpperB(i,j) &
    1501       85043 :                                     + npAnpB2npAB2npABMinusOne * MeanVecDiffAB(i) * MeanVecDiffAB(j)
    1502             :             end do
    1503             :         end do
    1504             : 
    1505             : 
    1506           1 :     end subroutine mergeMeanCovUpper
    1507             : 
    1508             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    1509             : 
    1510             :     !> \brief
    1511             :     !> Given two input sample means and covariance matrices, return the combination of them as a single mean and covariance matrix.
    1512             :     !>
    1513             :     !> \param[in]       nd              :   The number of dimensions of the input sample.
    1514             :     !> \param[in]       npA             :   The number of points in sample `A`.
    1515             :     !> \param[in]       MeanVecA        :   The mean vector of sample `A`.
    1516             :     !> \param[in]       CovMatUpperA    :   The covariance matrix of sample `A`.
    1517             :     !> \param[in]       npB             :   The number of points in sample `B`.
    1518             :     !> \param[inout]    MeanVecB        :   The mean vector of sample `B`.
    1519             :     !> \param[inout]    CovMatUpperB    :   The covariance matrix of sample `B`.
    1520             :     !>
    1521             :     !> \remark
    1522             :     !> This subroutine is the same as [mergeMeanCovUpper](@ref mergemeancovupper), with the **important difference** that
    1523             :     !> the resulting output mean and covariance matrices are written to the input arguments `MeanVecB`, `CovMatUpperB`.
    1524             :     !> This alternative implementation results in another extra 15%-20% efficiency gain. This result is based on
    1525             :     !> the benchmarks with Intel Fortran compiler 19.4 with all compiler optimization flags on.
    1526             :     !>
    1527             :     !> \todo
    1528             :     !> The efficiency of this algorithm might still be improved by converting the upper triangle covariance matrix to a packed vector.
    1529             :     !>
    1530             :     !> \author
    1531             :     !> Amir Shahmoradi, Nov 25, 2020, 1:00 AM, Dallas, TX
    1532           2 :     subroutine mergeMeanCovUpperDense(nd,npA,MeanVecA,CovMatUpperA,npB,MeanVecB,CovMatUpperB)
    1533             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    1534             :         !DEC$ ATTRIBUTES DLLEXPORT :: mergeMeanCovUpperDense
    1535             : #endif
    1536             :         implicit none
    1537             :         integer(IK), intent(in)             :: nd
    1538             :         integer(IK), intent(in)             :: npA,npB
    1539             :         real(RK)   , intent(in)             :: MeanVecA(nd),CovMatUpperA(nd,nd)
    1540             :         real(RK)   , intent(inout)          :: MeanVecB(nd),CovMatUpperB(nd,nd)
    1541           8 :         real(RK)                            :: MeanVecDiffAB(nd)
    1542           2 :         real(RK)                            :: npAnpB2npAB2npABMinusOne
    1543           2 :         real(RK)                            :: npAMinusOne2npABMinusOne
    1544           2 :         real(RK)                            :: npBMinusOne2npABMinusOne
    1545           2 :         real(RK)                            :: npABMinusOneInverse
    1546           2 :         real(RK)                            :: npABinverse
    1547           2 :         real(RK)                            :: npA2npAB
    1548           2 :         real(RK)                            :: npB2npAB
    1549             :         integer(IK)                         :: npAB, i, j
    1550             : 
    1551           2 :         npAB = npA + npB
    1552           2 :         npABinverse = 1._RK / real(npAB, kind=RK)
    1553           2 :         npABMinusOneInverse = 1._RK / real(npAB-1, kind=RK)
    1554           2 :         npAnpB2npAB2npABMinusOne = npA * npB * npABinverse * npABMinusOneInverse
    1555           2 :         npA2npAB = npA * npABinverse
    1556           2 :         npB2npAB = npB * npABinverse
    1557           2 :         npAMinusOne2npABMinusOne = (npA - 1_IK) * npABMinusOneInverse
    1558           2 :         npBMinusOne2npABMinusOne = (npB - 1_IK) * npABMinusOneInverse
    1559             : 
    1560             :         ! Compute the new Mean and Covariance matrix
    1561             : 
    1562           8 :         do j = 1, nd
    1563           6 :             MeanVecDiffAB(j) = MeanVecA(j) - MeanVecB(j)
    1564           6 :             MeanVecB(j) = npA2npAB * MeanVecA(j) + npB2npAB * MeanVecB(j)
    1565          20 :             do i = 1, j
    1566          12 :                 CovMatUpperB(i,j)   = npAMinusOne2npABMinusOne * CovMatUpperA(i,j) &
    1567          12 :                                     + npBMinusOne2npABMinusOne * CovMatUpperB(i,j) &
    1568          18 :                                     + npAnpB2npAB2npABMinusOne * MeanVecDiffAB(i) * MeanVecDiffAB(j)
    1569             :             end do
    1570             :         end do
    1571             : 
    1572       23642 :     end subroutine mergeMeanCovUpperDense
    1573             : 
    1574             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    1575             : 
    1576             :     !> \brief
    1577             :     !> Return a random standard Gaussian deviate with zero mean and unit variance.
    1578             :     !>
    1579             :     !> \return
    1580             :     !> `randGaus` : The random standard Gaussian deviate with zero mean and unit variance.
    1581             :     !>
    1582             :     !> \remark
    1583             :     !> See also, Numerical Recipes in Fortran, by Press et al. (1990)
    1584             :     !>
    1585             :     !> \author
    1586             :     !> Amir Shahmoradi, Oct 16, 2009, 11:14 AM, Michigan
    1587      572752 :     function getRandGaus() result(randGaus)
    1588             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    1589             :         !DEC$ ATTRIBUTES DLLEXPORT :: getRandGaus
    1590             : #endif
    1591             : 
    1592             :         implicit none
    1593             :         integer(IK), save :: iset=0
    1594             :         real(RK)   , save :: gset
    1595      572752 :         real(RK)          :: fac,rsq,vec(2)
    1596             :         real(RK)          :: randGaus
    1597             : 
    1598      572752 :         if (iset == 0_IK) then
    1599       77453 :             do
    1600             :                 !block
    1601             :                 !integer :: i, n
    1602             :                 !real(RK) :: unifrnd(30)
    1603             :                 !!integer, dimension(:), allocatable :: seed
    1604             :                 !if (paradramPrintEnabled .or. paradisePrintEnabled) then
    1605             :                 !    !do i = 1, 22
    1606             :                 !    call random_number(unifrnd)
    1607             :                 !    write(*,"(*(g0,:,'"//new_line("a")//"'))") unifrnd
    1608             :                 !    !end do
    1609             :                 !    !call random_seed(size = n); allocate(seed(n))
    1610             :                 !    !call random_seed(get = seed)
    1611             :                 !    !write(*,"(*(g0,:,' '))") seed
    1612             :                 !    !write(*,"(*(g0,:,' '))") StateOld
    1613             :                 !    !write(*,"(*(g0,:,' '))") StateNew
    1614             :                 !    !write(*,"(*(g0,:,' '))") CholeskyLower
    1615             :                 !    !write(*,"(*(g0,:,' '))") domainCheckCounter
    1616             :                 !    paradisePrintEnabled = .false.
    1617             :                 !    paradramPrintEnabled = .false.
    1618             :                 !end if
    1619             :                 !end block
    1620      363829 :                 call random_number(vec)
    1621     1091490 :                 vec = 2._RK*vec - 1._RK
    1622      363829 :                 rsq = vec(1)**2 + vec(2)**2
    1623      363829 :                 if ( rsq > 0._RK .and. rsq < 1._RK ) exit
    1624             :             end do
    1625      286376 :             fac = sqrt(-2._RK*log(rsq)/rsq)
    1626      286376 :             gset = vec(1)*fac
    1627      286376 :             randGaus = vec(2)*fac
    1628      286376 :             iset = 1_IK
    1629             :         else
    1630      286376 :             randGaus = gset
    1631      286376 :             iset = 0_IK
    1632             :         endif
    1633             : 
    1634      572754 :     end function getRandGaus
    1635             : 
    1636             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    1637             : 
    1638             :     !> \brief
    1639             :     !> Return a random Gaussian deviate with the given mean and standard deviation.
    1640             :     !>
    1641             :     !> \param[in]       mean    :   The mean of the Gaussian distribution.
    1642             :     !> \param[in]       std     :   The standard deviation of the Gaussian distribution. It must be a positive real number.
    1643             :     !>
    1644             :     !> \return
    1645             :     !> `randNorm` : A normally distributed deviate with the given mean and standard deviation.
    1646             :     !>
    1647             :     !> \author
    1648             :     !> Amir Shahmoradi, Oct 16, 2009, 11:14 AM, Michigan
    1649           1 :     function getRandNorm(mean,std) result(randNorm)
    1650             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    1651             :         !DEC$ ATTRIBUTES DLLEXPORT :: getRandNorm
    1652             : #endif
    1653             :         implicit none
    1654             :         real(RK), intent(in)    :: mean, std
    1655             :         real(RK)                :: randNorm
    1656           2 :         randNorm = mean + std * getRandGaus()
    1657      572753 :     end function getRandNorm
    1658             : 
    1659             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    1660             : 
    1661             :     !> \brief
    1662             :     !> Return a log-normally distributed deviate with the given mean and standard deviation.
    1663             :     !>
    1664             :     !> \param[in]       mean    :   The mean of the Lognormal distribution.
    1665             :     !> \param[in]       std     :   The standard deviation of the Lognormal distribution. It must be a positive real number.
    1666             :     !>
    1667             :     !> \return
    1668             :     !> `randLogn` : A Lognormally distributed deviate with the given mean and standard deviation.
    1669             :     !>
    1670             :     !> \author
    1671             :     !> Amir Shahmoradi, Oct 16, 2009, 11:14 AM, Michigan
    1672           1 :     function getRandLogn(mean,std) result(randLogn)
    1673             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    1674             :         !DEC$ ATTRIBUTES DLLEXPORT :: getRandLogn
    1675             : #endif
    1676             :         implicit none
    1677             :         real(RK), intent(in)    :: mean, std
    1678             :         real(RK)                :: randLogn
    1679           2 :         randLogn = exp( mean + std*getRandGaus() )
    1680           2 :     end function getRandLogn
    1681             : 
    1682             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    1683             : 
    1684             :     ! This subroutine is legacy and slow. use getRandMVN() in this same module.
    1685             :     ! Given the mean vector MeanVec and the covariance matrix CovMat, this subroutine generates a random vector x (of length nd>=2)
    1686             :     ! from an nd-dimensional multivariate normal distribution.
    1687             :     ! First a vector of nd standard normal random deviates is generated,
    1688             :     ! then this vector is multiplied by the Cholesky decomposition of the covariance matrix,
    1689             :     ! then the vector MeanVec is added to the resulting vector, and is stored in the output vector x.
    1690             :     ! ATTENTION: Only the upper half of the covariance matrix (plus the diagonal terms) need to be given in the input.
    1691             :     ! in the ouput, the upper half and diagonal part will still be the covariance matrix, while the lower half will be
    1692             :     ! the Cholesky decomposition elements (excluding its diagonal terms that are provided only in the vector Diagonal).
    1693             :     ! USES choldc.f90, getRandGaus.f90
    1694             :     !> Amir Shahmoradi, March 22, 2012, 2:21 PM, IFS, UTEXAS
    1695           1 :     subroutine getMVNDev(nd,MeanVec,CovMat,X)
    1696             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    1697             :         !DEC$ ATTRIBUTES DLLEXPORT :: getMVNDev
    1698             : #endif
    1699             : 
    1700             :         use iso_fortran_env, only: output_unit
    1701           1 :         use Matrix_mod, only: getCholeskyFactor
    1702             : 
    1703             :         implicit none
    1704             :         integer(IK), intent(in)  :: nd
    1705             :         real(RK)   , intent(in)  :: MeanVec(nd), CovMat(nd,nd)
    1706             :         real(RK)   , intent(out) :: X(nd)
    1707          11 :         real(RK)                 :: CholeskyLower(nd,nd), Diagonal(nd), DummyVec(nd)
    1708             :         integer(IK)              :: i
    1709             : 
    1710           7 :         CholeskyLower = CovMat
    1711           1 :         call getCholeskyFactor(nd,CholeskyLower,Diagonal)
    1712           1 :         if (Diagonal(1)<0._RK) then
    1713             :         ! LCOV_EXCL_START
    1714             :             write(output_unit,"(A)") "getCholeskyFactor() failed in getMVNDev()"
    1715             :             error stop
    1716             :         end if
    1717             :         ! LCOV_EXCL_STOP
    1718           3 :         do i=1,nd
    1719           2 :             DummyVec(i) = getRandGaus()
    1720           3 :             x(i) = DummyVec(i) * Diagonal(i)
    1721             :         end do
    1722           2 :         do i=2,nd
    1723           3 :             x(i) = x(i) + dot_product(CholeskyLower(i,1:i-1),DummyVec(1:i-1))
    1724             :         end do
    1725           3 :         x = x + MeanVec
    1726             : 
    1727           1 :   end subroutine getMVNDev
    1728             : 
    1729             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    1730             : 
    1731             :     ! This subroutine is legacy and slow. use getRandMVU() in this same module.
    1732             :     ! Given the mean vector MeanVec and the covariance matrix CovMat, this subroutine generates a random vector X (of length nd>=2)
    1733             :     ! from an nd-dimensional multivariate ellipsoidal uniform distribution, such that getMVUDev() is randomly distributed inside the nd-dimensional ellipsoid.
    1734             :     ! ATTENTION: Only the upper half of the covariance matrix (plus the diagonal terms) need to be given in the input.
    1735             :     ! in the ouput, the upper half and diagonal part will still be the covariance matrix, while the lower half will be
    1736             :     ! the Cholesky decomposition elements (excluding its diagonal terms that are provided only in the vector Diagonal).
    1737             :     ! USES getCholeskyFactor.f90, getRandGaus.f90
    1738             :     !> Amir Shahmoradi, April 25, 2016, 2:21 PM, IFS, UTEXAS
    1739           1 :     subroutine getMVUDev(nd,MeanVec,CovMat,X)
    1740             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    1741             :         !DEC$ ATTRIBUTES DLLEXPORT :: getMVUDev
    1742             : #endif
    1743             : 
    1744           1 :         use Matrix_mod, only: getCholeskyFactor
    1745             : 
    1746             :         implicit none
    1747             :         integer(IK), intent(in)  :: nd
    1748             :         real(RK)   , intent(in)  :: MeanVec(nd)
    1749             :         real(RK)   , intent(in)  :: CovMat(nd,nd)
    1750             :         real(RK)   , intent(out) :: X(nd)
    1751          11 :         real(RK)                 :: Diagonal(nd), DummyVec(nd), CholeskyLower(nd,nd), dummy
    1752             :         integer(IK)              :: i
    1753             : 
    1754           7 :         CholeskyLower = CovMat
    1755           1 :         call getCholeskyFactor(nd,CholeskyLower,Diagonal)
    1756           1 :         if (Diagonal(1)<0._RK) then
    1757             :         ! LCOV_EXCL_START
    1758             :             error stop
    1759             :             !call abortProgram( output_unit , 1 , 1 , 'Statitistics@getMVUDev()@getCholeskyFactor() failed.' )
    1760             :         end if
    1761             :         ! LCOV_EXCL_STOP
    1762           3 :         do i=1,nd
    1763           3 :             DummyVec(i) = getRandGaus()
    1764             :         end do
    1765           1 :         call random_number(dummy)
    1766           3 :         dummy = (dummy**(1._RK/real(nd,kind=RK)))/norm2(DummyVec)  ! Now DummyVec is a uniformly drawn point from inside of nd-D sphere.
    1767           3 :         DummyVec = dummy*DummyVec
    1768             : 
    1769             :         ! Now transform this point to a point inside the ellipsoid.
    1770           3 :         do i=1,nd
    1771           3 :             X(i) = DummyVec(i)*Diagonal(i)
    1772             :         end do
    1773             : 
    1774           2 :         do i=2,nd
    1775           3 :             X(i) = X(i) + dot_product(CholeskyLower(i,1:i-1),DummyVec(1:i-1))
    1776             :         end do
    1777             : 
    1778           3 :         X = X + MeanVec
    1779             : 
    1780           1 :     end subroutine getMVUDev
    1781             : 
    1782             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    1783             : 
    1784             :     !> \brief
    1785             :     !> Return a MultiVariate Normal (MVN) random vector with the given mean and
    1786             :     !> covariance matrix represented by the the input Cholesky factorization.
    1787             :     !>
    1788             :     !> \param[in]   nd              :   The number of dimensions of the MVN distribution.
    1789             :     !> \param[in]   MeanVec         :   The mean vector of the MVN distribution.
    1790             :     !> \param[in]   CholeskyLower   :   The Cholesky lower triangle of the covariance matrix of the MVN distribution.
    1791             :     !> \param[in]   Diagonal        :   The Diagonal elements of the Cholesky lower triangle of the covariance matrix of the MVN distribution.
    1792             :     !>
    1793             :     !> \return
    1794             :     !> `RandMVN` : The randomly generated MVN vector.
    1795             :     !>
    1796             :     !> \author
    1797             :     !> Amir Shahmoradi, April 23, 2017, 12:36 AM, ICES, UTEXAS
    1798     1120830 :     function getRandMVN(nd,MeanVec,CholeskyLower,Diagonal) result(RandMVN)
    1799             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    1800             :         !DEC$ ATTRIBUTES DLLEXPORT :: getRandMVN
    1801             : #endif
    1802             :         implicit none
    1803             :         integer(IK), intent(in) :: nd
    1804             :         real(RK)   , intent(in) :: MeanVec(nd)
    1805             :         real(RK)   , intent(in) :: CholeskyLower(nd,nd), Diagonal(nd)   ! Cholesky lower triangle and its diagonal terms, calculated from the input CovMat.
    1806      235108 :         real(RK)                :: RandMVN(nd), dummy
    1807             :         integer(IK)             :: j,i
    1808      650617 :         RandMVN = MeanVec
    1809      650617 :         do j = 1,nd
    1810      415509 :             dummy = getRandGaus()
    1811      415509 :             RandMVN(j) = RandMVN(j) + Diagonal(j) * dummy
    1812      831018 :             do i = j+1,nd
    1813      595910 :                 RandMVN(i) = RandMVN(i) + CholeskyLower(i,j) * dummy
    1814             :             end do
    1815             :         end do
    1816      235109 :     end function getRandMVN
    1817             : 
    1818             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    1819             : 
    1820             : !    ! Given an input Mean vector of length nd, Covariance Matrix of dimension (nd,nd), as well as a vector of integers representing
    1821             : !    ! the variables (corresponding to CovMat columns) that are given
    1822             : !    ! This subroutine gives out a conditional Multivariate Normal Random deviate.
    1823             : !    ! random p-tivariate normal deviate, given that the first pg variables x1 are given (i.e. fixed).
    1824             : !    ! For a review of Multivariate Normal distribution: Applied Multivariate Statistical Analysis, Johnson, Wichern, 1998, 4th ed.
    1825             : !    !> Amir Shahmoradi, Oct 20, 2009, 9:12 PM, MTU
    1826             : !    function getCondRandMVN(nd,MeanVec,CovMat,nIndIndx,IndIndx) result(CondRandMVN)
    1827             : !        use Matrix_mod, only: getRegresCoef
    1828             : !        implicit none
    1829             : !        integer(IK), intent(in) :: nd, nIndIndx, IndIndx(nIndIndx)
    1830             : !        real(RK)   , intent(in) :: MeanVec(nd), CovMat(nd,nd)
    1831             : !        real(RK)                :: CondRandMVN(nd),
    1832             : !        integer(IK)             :: j, i
    1833             : !    end function getCondRandMVN
    1834             : 
    1835             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    1836             : 
    1837             :     !> \brief
    1838             :     !> Given the Cholesky Lower triangle and diagonals of a given covariance matrix, this function return one point uniformly
    1839             :     !> randomly drawn from inside of an `nd`-ellipsoid, whose `nd` elements `RandMVU(i), i=1:nd` are guaranteed
    1840             :     !> to be in the range:
    1841             :     !> ```
    1842             :     !> MeanVec(i) - sqrt(CovMat(i,i)) < RandMVU(i) < MeanVec(i) + sqrt(CovMat(i,i))
    1843             :     !> ```
    1844             :     !>
    1845             :     !> \param[in]   nd              :   The number of dimensions of the MVU distribution.
    1846             :     !> \param[in]   MeanVec         :   The mean vector of the MVU distribution.
    1847             :     !> \param[in]   CholeskyLower   :   The Cholesky lower triangle of the covariance matrix of the MVU distribution.
    1848             :     !> \param[in]   Diagonal        :   The Diagonal elements of the Cholesky lower triangle of the covariance matrix of the MVU distribution.
    1849             :     !>
    1850             :     !> \return
    1851             :     !> `RandMVU` : The randomly generated MVU vector.
    1852             :     !>
    1853             :     !> \author
    1854             :     !> Amir Shahmoradi, April 23, 2017, 1:36 AM, ICES, UTEXAS
    1855      369130 :     function getRandMVU(nd,MeanVec,CholeskyLower,Diagonal) result(RandMVU)
    1856             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    1857             :         !DEC$ ATTRIBUTES DLLEXPORT :: getRandMVU
    1858             : #endif
    1859             :         implicit none
    1860             :         integer(IK), intent(in) :: nd
    1861             :         real(RK)   , intent(in) :: MeanVec(nd)
    1862             :         real(RK)   , intent(in) :: CholeskyLower(nd,nd) ! Cholesky lower triangle, calculated from the input CovMat.
    1863             :         real(RK)   , intent(in) :: Diagonal(nd)         ! Cholesky diagonal terms, calculated from the input CovMat.
    1864      294995 :         real(RK)                :: RandMVU(nd), dummy, DummyVec(nd), sumSqDummyVec
    1865             :         integer(IK)             :: i,j
    1866       74135 :         sumSqDummyVec = 0._RK
    1867      220860 :         do j=1,nd
    1868      146725 :             DummyVec(j) = getRandGaus()
    1869      220860 :             sumSqDummyVec = sumSqDummyVec + DummyVec(j)**2
    1870             :         end do
    1871       74135 :         call random_number(dummy)
    1872       74135 :         dummy = dummy**(1._RK/nd) / sqrt(sumSqDummyVec)
    1873      220860 :         DummyVec = DummyVec * dummy  ! a uniform random point from inside of nd-sphere
    1874      220860 :         RandMVU = MeanVec
    1875      220860 :         do j = 1,nd
    1876      146725 :             RandMVU(j) = RandMVU(j) + Diagonal(j) * DummyVec(j)
    1877      293450 :             do i = j+1,nd
    1878      219315 :                 RandMVU(i) = RandMVU(i) + CholeskyLower(i,j) * DummyVec(j)
    1879             :             end do
    1880             :         end do
    1881      309243 :     end function getRandMVU
    1882             : 
    1883             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    1884             : 
    1885             :     !> \brief
    1886             :     !> Return `.true.` if the input `NormedPoint` (normalized with respect to the center of the target ellipsoid) is
    1887             :     !> within or on the boundary of the ellipsoid whose boundary is described by the representative matrix
    1888             :     !> \f$ \Sigma \f$ (`RepMat`), such that,
    1889             :     !> \f{equation}{
    1890             :     !> X^T ~ \Sigma^{-1} ~ X = 1 ~,
    1891             :     !> \f}
    1892             :     !> for all \f$X\f$ on the boundary.
    1893             :     !>
    1894             :     !> \param[in]   nd          :   The number of dimensions of the ellipsoid (the size of `NormedPoint`).
    1895             :     !> \param[in]   NormedPoint :   The input point, normalized with respect to the center of the ellipsoid,
    1896             :     !>                                  whose location with respect to the ellipsoid boundary is to be determined.
    1897             :     !> \param[in]   InvRepMat   :   The inverse of the representative matrix of the target ellipsoid.
    1898             :     !>
    1899             :     !> \return
    1900             :     !> `isInsideEllipsoid` : The logical value indicating whether the input point is inside or on the boundary of the target ellipsoid.
    1901             :     !>
    1902             :     !> \remark
    1903             :     !> Note that the input matrix is the inverse of `RepMat`: `InvRepMat`.
    1904             :     !>
    1905             :     !> \author
    1906             :     !> Amir Shahmoradi, April 23, 2017, 1:36 AM, ICES, UTEXAS
    1907           5 :     pure function isInsideEllipsoid(nd,NormedPoint,InvRepMat)
    1908             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    1909             :         !DEC$ ATTRIBUTES DLLEXPORT :: isInsideEllipsoid
    1910             : #endif
    1911       74135 :         use Math_mod, only: getLogVolEllipsoid
    1912             :         implicit none
    1913             :         integer(IK), intent(in) :: nd
    1914             :         real(RK)   , intent(in) :: NormedPoint(nd)
    1915             :         real(RK)   , intent(in) :: InvRepMat(nd,nd)
    1916             :         logical                 :: isInsideEllipsoid
    1917          15 :         isInsideEllipsoid = dot_product(NormedPoint,matmul(InvRepMat,NormedPoint)) <= 1._RK
    1918           5 :     end function isInsideEllipsoid
    1919             : 
    1920             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    1921             : 
    1922             :     !> \brief
    1923             :     !> Return the natural logarithm of the probability density function value of a point uniformly distributed within an ellipsoid,
    1924             :     !> whose logarithm of the square root of the determinant of its representative covariance matrix is given by `logSqrtDetCovMat`.
    1925             :     !>
    1926             :     !> \param[in]   nd                  :   The number of dimensions of the MVU distribution.
    1927             :     !> \param[in]   logSqrtDetCovMat    :   The logarithm of the square root of the determinant of
    1928             :     !>                                      the inverse of the representative covariance matrix of the ellipsoid.
    1929             :     !>
    1930             :     !> \return
    1931             :     !> `logProbMVU` :   The natural logarithm of the probability density function value
    1932             :     !>                  of a point uniformly distributed within the target ellipsoid.
    1933             :     !>
    1934             :     !> \author
    1935             :     !> Amir Shahmoradi, April 23, 2017, 1:36 AM, ICES, UTEXAS
    1936           1 :     pure function getLogProbMVU(nd,logSqrtDetCovMat) result(logProbMVU)
    1937             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    1938             :         !DEC$ ATTRIBUTES DLLEXPORT :: getLogProbMVU
    1939             : #endif
    1940           5 :         use Math_mod, only: getLogVolEllipsoid
    1941             :         implicit none
    1942             :         integer(IK), intent(in) :: nd
    1943             :         real(RK)   , intent(in) :: logSqrtDetCovMat
    1944             :         real(RK)                :: logProbMVU
    1945           1 :         logProbMVU = -getLogVolEllipsoid(nd,logSqrtDetCovMat)
    1946           2 :     end function getLogProbMVU
    1947             : 
    1948             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    1949             : 
    1950             :     !> \brief
    1951             :     !> Return a random point on the target ellipsoid by projecting a random point uniformly distributed within the ellipsoid on its boundary.
    1952             :     !>
    1953             :     !> \param[in]   nd              :   The number of dimensions of the ellipsoid.
    1954             :     !> \param[in]   MeanVec         :   The mean vector (center) of the ellipsoid.
    1955             :     !> \param[in]   CholeskyLower   :   The Cholesky lower triangle of the representative covariance matrix of the ellipsoid.
    1956             :     !> \param[in]   Diagonal        :   The Diagonal elements of the Cholesky lower triangle of the representative covariance matrix of the ellipsoid.
    1957             :     !>
    1958             :     !> \return
    1959             :     !> `RandPointOnEllipsoid` : A random point on the target ellipsoid by projecting a random
    1960             :     !>                          point uniformly distributed within the ellipsoid on its boundary.
    1961             :     !>
    1962             :     !> \remark
    1963             :     !> This is algorithm is similar to [getRandMVU](@ref getrandmvu), with the only difference that
    1964             :     !> points are drawn randomly from the surface of the ellipsoid instead of inside of its interior.
    1965             :     !>
    1966             :     !> \remark
    1967             :     !> Note that the distribution of points on the surface of the ellipsoid is **NOT** uniform.
    1968             :     !> Regions of high curvature will have more points randomly sampled from them.
    1969             :     !> Generating uniform random points on arbitrary-dimension ellipsoids is not a task with trivial solution!
    1970             :     !>
    1971             :     !> \todo
    1972             :     !> The performance of this algorithm can be further improved.
    1973             :     !>
    1974             :     !> \author
    1975             :     !> Amir Shahmoradi, April 23, 2017, 1:36 AM, ICES, UTEXAS
    1976           5 :     function getRandPointOnEllipsoid(nd,MeanVec,CholeskyLower,Diagonal) result(RandPointOnEllipsoid)
    1977             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    1978             :         !DEC$ ATTRIBUTES DLLEXPORT :: getRandPointOnEllipsoid
    1979             : #endif
    1980             :         implicit none
    1981             :         integer(IK), intent(in) :: nd
    1982             :         real(RK)   , intent(in) :: MeanVec(nd)
    1983             :         real(RK)   , intent(in) :: CholeskyLower(nd,nd) ! Cholesky lower triangle, calculated from the MVN CovMat.
    1984             :         real(RK)   , intent(in) :: Diagonal(nd)         ! Cholesky diagonal terms, calculated from the MVN CovMat.
    1985           4 :         real(RK)                :: RandPointOnEllipsoid(nd), DummyVec(nd), sumSqDummyVec
    1986             :         integer(IK)             :: i,j
    1987           1 :         sumSqDummyVec = 0._RK
    1988           3 :         do j=1,nd
    1989           2 :             DummyVec(j) = getRandGaus()
    1990           3 :             sumSqDummyVec = sumSqDummyVec + DummyVec(j)**2
    1991             :         end do
    1992           3 :         DummyVec = DummyVec / sqrt(sumSqDummyVec)    ! DummyVec is a random point on the surface of nd-sphere.
    1993           3 :         RandPointOnEllipsoid = 0._RK
    1994           3 :         do j = 1,nd
    1995           2 :             RandPointOnEllipsoid(j) = RandPointOnEllipsoid(j) + Diagonal(j) * DummyVec(j)
    1996           4 :             do i = j+1,nd
    1997           3 :                 RandPointOnEllipsoid(i) = RandPointOnEllipsoid(i) + CholeskyLower(i,j) * DummyVec(j)
    1998             :             end do
    1999             :         end do
    2000           3 :         RandPointOnEllipsoid = RandPointOnEllipsoid + MeanVec
    2001           2 :     end function getRandPointOnEllipsoid
    2002             : 
    2003             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2004             : 
    2005             :     !> \brief
    2006             :     !> Return the natural logarithm of the Lognormal probability density function.
    2007             :     !>
    2008             :     !> \param[in]   logMean                 :   The mean of the Lognormal distribution.
    2009             :     !> \param[in]   inverseVariance         :   The inverse variance of the Lognormal distribution.
    2010             :     !> \param[in]   logSqrtInverseVariance  :   The natural logarithm of the square root of the inverse variance of the Lognormal distribution.
    2011             :     !> \param[in]   logPoint                :   The natural logarithm of the point at which the Lognormal PDF must be computed.
    2012             :     !>
    2013             :     !> \return
    2014             :     !> `logProbLogn` : The natural logarithm of the Lognormal probability density function.
    2015             :     !>
    2016             :     !> \author
    2017             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2018        1298 :     pure function getLogProbLognSP(logMean,inverseVariance,logSqrtInverseVariance,logPoint) result(logProbLogn)
    2019             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2020             :         !DEC$ ATTRIBUTES DLLEXPORT :: getLogProbLognSP
    2021             : #endif
    2022           1 :         use Constants_mod, only: LOGINVSQRT2PI
    2023             :         implicit none
    2024             :         real(RK), intent(in) :: logMean,inverseVariance,logSqrtInverseVariance,logPoint
    2025             :         real(RK)             :: logProbLogn
    2026        1298 :         logProbLogn = LOGINVSQRT2PI + logSqrtInverseVariance - logPoint - 0.5_RK * inverseVariance * (logPoint-logMean)**2
    2027        2596 :     end function getLogProbLognSP
    2028             : 
    2029             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2030             : 
    2031             :     !> \brief
    2032             :     !> Return the natural logarithm of the Lognormal probability density function.
    2033             :     !>
    2034             :     !> \param[in]   np                      :   The size of the input vector of points represented by `LogPoint`.
    2035             :     !> \param[in]   logMean                 :   The mean of the Lognormal distribution.
    2036             :     !> \param[in]   inverseVariance         :   The inverse variance of the Lognormal distribution.
    2037             :     !> \param[in]   logSqrtInverseVariance  :   The natural logarithm of the square root of the inverse variance of the Lognormal distribution.
    2038             :     !> \param[in]   LogPoint                :   The natural logarithm of the vector of points at which the Lognormal PDF must be computed.
    2039             :     !>
    2040             :     !> \return
    2041             :     !> `logProbLogn` : The natural logarithm of the Lognormal probability density function.
    2042             :     !>
    2043             :     !> \author
    2044             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2045          12 :     pure function getLogProbLognMP(np,logMean,inverseVariance,logSqrtInverseVariance,LogPoint) result(logProbLogn)
    2046             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2047             :         !DEC$ ATTRIBUTES DLLEXPORT :: getLogProbLognMP
    2048             : #endif
    2049        1298 :         use Constants_mod, only: LOGINVSQRT2PI
    2050             :         implicit none
    2051             :         integer(IK), intent(in) :: np
    2052             :         real(RK)   , intent(in) :: logMean,inverseVariance,logSqrtInverseVariance,LogPoint(np)
    2053             :         real(RK)                :: logProbLogn(np)
    2054           8 :         logProbLogn = LOGINVSQRT2PI + logSqrtInverseVariance - LogPoint - 0.5_RK * inverseVariance * (LogPoint-logMean)**2
    2055           2 :     end function getLogProbLognMP
    2056             : 
    2057             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2058             : 
    2059             :     !> \brief
    2060             :     !> Return a single-precision uniformly-distributed random real-valued number in the range `[0,1]`.
    2061             :     !>
    2062             :     !> \param[inout]    idum    :   The input integer random seed with the `save` attribute.
    2063             :     !>
    2064             :     !> \return
    2065             :     !> `randRealLecuyer`        :   A single-precision uniformly-distributed random real-valued number in the range `[0,1]`.
    2066             :     !>
    2067             :     !> \warning
    2068             :     !> Do not change the value of `idum` between calls.
    2069             :     !>
    2070             :     !> \remark
    2071             :     !> This routine is guaranteed to random numbers with priodicity larger than `~2*10**18` random numbers.
    2072             :     !> For more info see Press et al. (1990) Numerical Recipes.
    2073             :     !>
    2074             :     !> \remark
    2075             :     !> This routine is solely kept for backward compatibility reasons.
    2076             :     !> The Fortran intrinsic subroutine `random_number()` is recommended to be used against this function.
    2077             :     !>
    2078             :     !> \author
    2079             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2080         200 :     function getRandRealLecuyer(idum) result(randRealLecuyer)
    2081             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2082             :         !DEC$ ATTRIBUTES DLLEXPORT :: getRandRealLecuyer
    2083             : #endif
    2084             :         implicit none
    2085             :         integer(IK), intent(inout) :: idum
    2086             :         integer(IK), parameter     :: im1=2147483563, im2=2147483399, imm1=im1-1, ia1=40014, ia2=40692
    2087             :         integer(IK), parameter     :: iq1=53668, iq2=52774, ir1=12211, ir2=3791, ntab=32, ndiv=1+imm1/ntab
    2088             :         real(RK)   , parameter     :: am=1._RK/real(im1,kind=RK), eps=1.2e-7_RK, rnmx=1._RK-eps
    2089             :         real(RK)                   :: randRealLecuyer
    2090             :         integer(IK)                :: idum2,j,k,iv(ntab),iy
    2091             :         save                       :: iv, iy, idum2
    2092             :         data idum2/123456789/, iv/ntab*0/, iy/0/
    2093         200 :         if (idum <= 0) then
    2094           0 :             idum = max(-idum,1)
    2095           0 :             idum2 = idum
    2096           0 :             do j = ntab+8,1,-1
    2097           0 :                 k = idum/iq1
    2098           0 :                 idum = ia1*(idum-k*iq1)-k*ir1
    2099           0 :                 if (idum < 0) idum = idum+im1
    2100           0 :                 if (j <= ntab) iv(j) = idum
    2101             :             end do
    2102           0 :             iy = iv(1)
    2103             :         endif
    2104         200 :         k = idum/iq1
    2105         200 :         idum = ia1*(idum-k*iq1)-k*ir1
    2106         200 :         if (idum < 0) idum=idum+im1
    2107         200 :         k = idum2/iq2
    2108         200 :         idum2 = ia2*(idum2-k*iq2)-k*ir2
    2109         200 :         if (idum2 < 0) idum2=idum2+im2
    2110         200 :         j = 1+iy/ndiv
    2111         200 :         iy = iv(j)-idum2
    2112         200 :         iv(j) = idum
    2113         200 :         if(iy < 1)iy = iy+imm1
    2114         200 :         randRealLecuyer = min(am*iy,rnmx)
    2115         202 :     end function getRandRealLecuyer
    2116             : 
    2117             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2118             : 
    2119             :     !> \brief
    2120             :     !> Return an integer uniformly-distributed random integer-valued number in the range `[lowerBound , upperBound]`.
    2121             :     !>
    2122             :     !> \param[in]       lowerBound  :   The inclusive integer lower bound of the integer uniform distribution.
    2123             :     !> \param[in]       upperBound  :   The inclusive integer upper bound of the integer uniform distribution.
    2124             :     !> \param[inout]    idum        :   The input integer random seed with the `save` attribute.
    2125             :     !>
    2126             :     !> \return
    2127             :     !> `randRealLecuyer`    : A uniformly-distributed random integer-valued number in the range `[lowerBound , upperBound]`.
    2128             :     !>
    2129             :     !> \warning
    2130             :     !> Do not change the value of `idum` between calls.
    2131             :     !>
    2132             :     !> \remark
    2133             :     !> This routine is guaranteed to random numbers with priodicity larger than `~2*10**18` random numbers.
    2134             :     !> For more info see Press et al. (1990) Numerical Recipes.
    2135             :     !>
    2136             :     !> \remark
    2137             :     !> This routine is solely kept for backward compatibility reasons.
    2138             :     !> The [getRandInt](@ref getrandint) is recommended to be used against this routine.
    2139             :     !>
    2140             :     !> \author
    2141             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2142         100 :     function getRandIntLecuyer(lowerBound,upperBound,idum)
    2143             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2144             :         !DEC$ ATTRIBUTES DLLEXPORT :: getRandIntLecuyer
    2145             : #endif
    2146             :         implicit none
    2147             :         integer(IK), intent(in)    :: lowerBound,upperBound
    2148             :         integer(IK), intent(inout) :: idum
    2149             :         integer(IK)                :: getRandIntLecuyer
    2150         200 :         getRandIntLecuyer = lowerBound + nint( getRandRealLecuyer(idum)*real(upperBound-lowerBound,kind=RK) )
    2151         300 :     end function getRandIntLecuyer
    2152             : 
    2153             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2154             : 
    2155             :     !> \brief
    2156             :     !> Return an integer uniformly-distributed random integer-valued number in the range `[lowerBound , upperBound]`.
    2157             :     !>
    2158             :     !> \param[in]       lowerBound  :   The lower bound of the integer uniform distribution.
    2159             :     !> \param[in]       upperBound  :   The upper bound of the integer uniform distribution.
    2160             :     !>
    2161             :     !> \return
    2162             :     !> `randInt` : A uniformly-distributed random integer-valued number in the range `[lowerBound , upperBound]`.
    2163             :     !>
    2164             :     !> \author
    2165             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2166       20044 :     function getRandInt(lowerBound,upperBound) result(randInt)
    2167             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2168             :         !DEC$ ATTRIBUTES DLLEXPORT :: getRandInt
    2169             : #endif
    2170             :         implicit none
    2171             :         integer(IK), intent(in) :: lowerBound,upperBound
    2172       20044 :         real(RK)                :: dummy
    2173             :         integer(IK)             :: randInt
    2174       20044 :         call random_number(dummy)
    2175       20044 :         randInt = lowerBound + nint( dummy*real(upperBound-lowerBound,kind=RK) )
    2176       20144 :     end function getRandInt
    2177             : 
    2178             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2179             : 
    2180             :     !> \brief
    2181             :     !> Return an integer uniformly-distributed random integer-valued number in the range `[lowerBound , upperBound]` using
    2182             :     !> the built-in random number generator of Fortran.
    2183             :     !>
    2184             :     !> \param[in]       lowerBound  :   The lower bound of the integer uniform distribution.
    2185             :     !> \param[in]       upperBound  :   The upper bound of the integer uniform distribution.
    2186             :     !>
    2187             :     !> \return
    2188             :     !> `randUniform`    : A uniformly-distributed random real-valued number in the range `[lowerBound , upperBound]`.
    2189             :     !>
    2190             :     !> \author
    2191             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2192         100 :     function getRandUniform(lowerBound,upperBound) result(randUniform)
    2193             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2194             :         !DEC$ ATTRIBUTES DLLEXPORT :: getRandUniform
    2195             : #endif
    2196             :         implicit none
    2197             :         real(RK), intent(in)    :: lowerBound, upperBound
    2198             :         real(RK)                :: randUniform
    2199         100 :         call random_number(randUniform)
    2200         100 :         randUniform = lowerBound + randUniform * (upperBound - lowerBound)
    2201       20144 :     end function getRandUniform
    2202             : 
    2203             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2204             : 
    2205             :     !> \brief
    2206             :     !> Return a Gamma-distributed random number, following the prescription in the GSL library.
    2207             :     !>
    2208             :     !> \param[in]       alpha   :   The shape parameter of the Gamma distribution.
    2209             :     !>
    2210             :     !> \return
    2211             :     !> `randGamma`    : A Gamma-distributed random real-valued number in the range `[0,+Infinity]`.
    2212             :     !>
    2213             :     !> \warning
    2214             :     !> The condition `alpha > 0` must hold, otherwise the negative value `-1` will be returned to indicate the occurrence of error.
    2215             :     !>
    2216             :     !> \author
    2217             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2218         501 :     function getRandGamma(alpha) result(randGamma)
    2219             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2220             :         !DEC$ ATTRIBUTES DLLEXPORT :: getRandGamma
    2221             : #endif
    2222             :         implicit none
    2223             :         real(RK), intent(in) :: alpha
    2224             :         real(RK)             :: randGamma
    2225         501 :         real(RK)             :: c,u,v,z
    2226         501 :         if (alpha<=0._RK) then  ! illegal value of alpha
    2227           1 :             randGamma = -1._RK
    2228           1 :             return
    2229             :         else
    2230         500 :             randGamma = alpha
    2231         500 :             if (randGamma<1._RK) randGamma = randGamma + 1._RK
    2232         500 :             randGamma = randGamma - 0.3333333333333333_RK
    2233         500 :             c = 3._RK*sqrt(randGamma)
    2234         500 :             c = 1._RK / c
    2235           9 :             do
    2236           0 :                 do
    2237         509 :                     z = getRandGaus()
    2238         509 :                     v = 1._RK + c*z
    2239         509 :                     if (v<=0._RK) cycle
    2240         509 :                     exit
    2241             :                 end do
    2242         509 :                 v = v**3
    2243         509 :                 call random_number(u)
    2244         509 :                 if ( log(u) >= 0.5_RK * z**2 + randGamma * ( 1._RK - v + log(v) ) ) cycle
    2245         500 :                 randGamma = randGamma * v
    2246         500 :                 exit
    2247             :             end do
    2248         500 :             if (alpha<1._RK) then
    2249           0 :                 call random_number(u)
    2250           0 :                 randGamma = randGamma * u**(1._RK/alpha)
    2251             :             end if
    2252             :         end if
    2253         601 :     end function getRandGamma
    2254             : 
    2255             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2256             : 
    2257             :     !> \brief
    2258             :     !> Return a Gamma-distributed random number, whose shape parameter `alpha` is an integer.
    2259             :     !>
    2260             :     !> \param[in]       alpha   :   The shape integer parameter of the Gamma distribution.
    2261             :     !>
    2262             :     !> \return
    2263             :     !> `randGamma`    : A Gamma-distributed random real-valued number in the range `[0,+Infinity]`.
    2264             :     !>
    2265             :     !> \warning
    2266             :     !> The condition `alpha > 1` must hold, otherwise the negative value `-1` will be returned to indicate the occurrence of error.
    2267             :     !>
    2268             :     !> \author
    2269             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2270         101 :     function getRandGammaIntShape(alpha) result(randGamma)
    2271             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2272             :         !DEC$ ATTRIBUTES DLLEXPORT :: getRandGammaIntShape
    2273             : #endif
    2274             :         implicit none
    2275             :         integer(IK), intent(in) :: alpha
    2276             :         real(RK)                :: randGamma
    2277         101 :         real(RK)                :: am,e,h,s,x,y,Vector(2),Array(5)
    2278         101 :         if (alpha < 1) then  ! illegal value of alpha
    2279           1 :             randGamma = -1._RK
    2280           1 :             return
    2281         100 :         elseif (alpha < 6) then
    2282         100 :             call random_number(Array(1:alpha))
    2283         300 :             x = -log(product(Array(1:alpha)))
    2284             :         else    ! use rejection sampling
    2285           0 :             do
    2286           0 :                 call random_number(Vector)
    2287           0 :                 Vector(2) = 2._RK*Vector(2)-1._RK
    2288           0 :                 if (dot_product(Vector,Vector) > 1._RK) cycle
    2289           0 :                 y = Vector(2) / Vector(1)
    2290           0 :                 am = alpha - 1
    2291           0 :                 s = sqrt(2._RK*am + 1._RK)
    2292           0 :                 x = s*y + am
    2293           0 :                 if (x <= 0.0) cycle
    2294           0 :                 e = (1._RK+y**2) * exp(am*log(x/am)-s*y)
    2295           0 :                 call random_number(h)
    2296           0 :                 if (h <= e) exit
    2297             :             end do
    2298             :         end if
    2299         100 :         randGamma = x
    2300         602 :     end function getRandGammaIntShape
    2301             : 
    2302             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2303             : 
    2304             :     !> \brief
    2305             :     !> Return a random Beta-distributed variable.
    2306             :     !>
    2307             :     !> \param[in]       alpha   :   The first shape parameter of the Beta distribution.
    2308             :     !> \param[in]       beta    :   The second shape parameter of the Beta distribution.
    2309             :     !>
    2310             :     !> \return
    2311             :     !> `randBeta`   : A Beta-distributed random real-valued number in the range `[0,1]`.
    2312             :     !>
    2313             :     !> \warning
    2314             :     !> The conditions `alpha > 0` and `beta > 0` must hold, otherwise the negative
    2315             :     !> value `-1` will be returned to indicate the occurrence of error.
    2316             :     !>
    2317             :     !> \author
    2318             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2319         203 :     function getRandBeta(alpha,beta) result(randBeta)
    2320             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2321             :         !DEC$ ATTRIBUTES DLLEXPORT :: getRandBeta
    2322             : #endif
    2323             :         implicit none
    2324             :         real(RK), intent(in) :: alpha,beta
    2325             :         real(RK)             :: randBeta
    2326         203 :         real(RK)             :: x
    2327         203 :         if ( alpha>0._RK .and. beta>0._RK ) then
    2328         200 :             x = getRandGamma(alpha)
    2329         200 :             randBeta = x / ( x + getRandGamma(beta) )
    2330             :         else ! illegal value of alpha or beta
    2331           3 :             randBeta = -1._RK
    2332             :         end if
    2333         304 :     end function getRandBeta
    2334             : 
    2335             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2336             : 
    2337             :     !> \brief
    2338             :     !> Return a random Exponential-distributed value whose inverse mean is given as input.
    2339             :     !>
    2340             :     !> \param[in]   invMean :   The inverse of the mean of the Exponential distribution.
    2341             :     !>
    2342             :     !> \return
    2343             :     !> `randExp` : An Exponential-distributed random real-valued number in the range `[0,+Infinity]` with mean `1 / invMean`.
    2344             :     !>
    2345             :     !> \warning
    2346             :     !> It is the user's onus to ensure `invMean > 0` on input. This condition will NOT be checked by this routine.
    2347             :     !>
    2348             :     !> \author
    2349             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2350         100 :     function getRandExpWithInvMean(invMean) result(randExp)
    2351             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2352             :         !DEC$ ATTRIBUTES DLLEXPORT :: getRandExpWithInvMean
    2353             : #endif
    2354             :         implicit none
    2355             :         real(RK), intent(in)    :: invMean
    2356             :         real(RK)                :: randExp
    2357         100 :         call random_number(randExp)
    2358         100 :         randExp = -log(randExp) * invMean
    2359         303 :     end function getRandExpWithInvMean
    2360             : 
    2361             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2362             : 
    2363             :     !> \brief
    2364             :     !> Return a random Exponential-distributed value whose mean is \f$\lambda = 1\f$.
    2365             :     !>
    2366             :     !> \return
    2367             :     !> `randExp` : A random Exponential-distributed value whose mean \f$\lambda = 1\f$.
    2368             :     !>
    2369             :     !> \author
    2370             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2371         100 :     function getRandExp() result(randExp)
    2372             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2373             :         !DEC$ ATTRIBUTES DLLEXPORT :: getRandExp
    2374             : #endif
    2375             :         implicit none
    2376             :         real(RK) :: randExp
    2377         100 :         call random_number(randExp)
    2378         100 :         randExp = -log(randExp)
    2379         200 :     end function getRandExp
    2380             : 
    2381             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2382             : 
    2383             :     !> \brief
    2384             :     !> Return a random correlation matrix.
    2385             :     !>
    2386             :     !> \param[in]   nd  :   The rank of the correlation matrix.
    2387             :     !> \param[in]   eta :   The parameter that roughly represents the shape parameters of the Beta distribution.
    2388             :     !>                      The larger the value of `eta` is, the more homogeneous the correlation matrix will look.
    2389             :     !>                      In other words, set this parameter to some small number to generate strong random correlations
    2390             :     !>                      in the output random correlation matrix.
    2391             :     !>
    2392             :     !> \return
    2393             :     !> `RandCorMat` : A random correlation matrix.
    2394             :     !>
    2395             :     !> \warning
    2396             :     !> The conditions `nd > 1` and `eta > 0.0` must hold, otherwise the first element of
    2397             :     !> output, `getRandCorMat(1,1)`, will be set to `-1` to indicate the occurrence of an error.
    2398             :     !>
    2399             :     !> \author
    2400             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2401         927 :     function getRandCorMat(nd,eta) result(RandCorMat)
    2402             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2403             :         !DEC$ ATTRIBUTES DLLEXPORT :: getRandCorMat
    2404             : #endif
    2405         100 :         use Matrix_mod, only: getCholeskyFactor
    2406             :         implicit none
    2407             :         integer(IK), intent(in) :: nd
    2408             :         real(RK)   , intent(in) :: eta
    2409         103 :         real(RK)                :: RandCorMat(nd,nd), dummy
    2410         515 :         real(RK)                :: beta,sumSqDummyVec,DummyVec(nd-1),W(nd-1),Diagonal(nd-1)
    2411             :         integer(IK)             :: m,j,i
    2412             : 
    2413         103 :         if (nd<2_IK .or. eta<=0._RK) then  ! illegal value for eta.
    2414           3 :             RandCorMat(1,1) = -1._RK
    2415           3 :             return
    2416             :         end if
    2417             : 
    2418         300 :         do m = 1,nd
    2419         300 :             RandCorMat(m,m) = 1._RK
    2420             :         end do
    2421         100 :         beta = eta + 0.5_RK*(nd-2._RK)
    2422         100 :         dummy = getRandBeta(beta,beta)
    2423         100 :         if (dummy<=0._RK .or. dummy>=1._RK) then
    2424             :         ! LCOV_EXCL_START
    2425             :             error stop
    2426             :             !call abortProgram( output_unit , 1 , 1 , 'Statitistics@getRandCorMat() failed. Random Beta variable out of bound: ' // num2str(dummy) )
    2427             :         end if
    2428             :         ! LCOV_EXCL_STOP
    2429         100 :         RandCorMat(1,2) = 2._RK * dummy - 1._RK ! for the moment, only the upper half of RandCorMat is needed, the lower half will contain cholesky lower triangle.
    2430             : 
    2431         100 :         do m = 2,nd-1
    2432           0 :             beta = beta - 0.5_RK
    2433           0 :             sumSqDummyVec = 0._RK
    2434           0 :             do j=1,m
    2435           0 :                 DummyVec(j) = getRandGaus()
    2436           0 :                 sumSqDummyVec = sumSqDummyVec + DummyVec(j)**2
    2437             :             end do
    2438           0 :             DummyVec(1:m) = DummyVec(1:m) / sqrt(sumSqDummyVec)   ! DummyVec is now a uniform random point from inside of m-sphere
    2439           0 :             dummy = getRandBeta(0.5e0_RK*m,beta)
    2440           0 :             W(1:m) = sqrt(dummy) * DummyVec(1:m)
    2441           0 :             call getCholeskyFactor(m,RandCorMat(1:m,1:m),Diagonal(1:m))
    2442           0 :             if (Diagonal(1)<0._RK) then
    2443           0 :                 error stop
    2444             :                 !call abortProgram( output_unit , 1 , 1 , 'Statitistics@getRandCorMat()@getCholeskyFactor() failed.' )
    2445             :             end if
    2446           0 :             DummyVec(1:m) = 0._RK
    2447           0 :             do j = 1,m
    2448           0 :                 DummyVec(j) = DummyVec(j) + Diagonal(j) * W(j)
    2449           0 :                 do i = j+1,m
    2450           0 :                     DummyVec(i) = DummyVec(i) + RandCorMat(i,j) * DummyVec(j)
    2451             :                 end do
    2452             :             end do
    2453         100 :             RandCorMat(1:m,m+1) = DummyVec(1:m)
    2454             :         end do
    2455         200 :         do i=1,nd-1
    2456         300 :             RandCorMat(i+1:nd,i) = RandCorMat(i,i+1:nd)
    2457             :         end do
    2458         206 :   end function getRandCorMat
    2459             : 
    2460             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2461             : 
    2462             : !  function getRandCorMat(nd,eta)    ! based on the idea of LKJ (2007). But there is something wrong with this routine
    2463             : !    use Matrix_mod, only: getCholeskyFactor
    2464             : !    implicit none
    2465             : !    !integer, intent(in) :: nd,eta
    2466             : !    integer, intent(in) :: nd
    2467             : !    real(RK), intent(in) :: eta
    2468             : !    integer :: m,mNew,j,i
    2469             : !    real(RK) :: getRandCorMat(nd,nd), dummy, failureCounter
    2470             : !    real(RK) :: beta,sumSqDummyVec,DummyVec(nd-1),W(nd-1),Diagonal(nd-1)
    2471             : !
    2472             : !    if (nd<2 .or. eta<=0._RK) then  ! illegal value for eta. set getRandCorMat=0, return
    2473             : !      getRandCorMat = -1._RK
    2474             : !      return
    2475             : !    end if
    2476             : !
    2477             : !    do m = 1,nd
    2478             : !      getRandCorMat(m,m) = 1._RK
    2479             : !    end do
    2480             : !    beta = eta + 0.5_RK*(nd-2._RK)
    2481             : !
    2482             : !    do
    2483             : !      dummy = getRandBeta(beta,beta)
    2484             : !      if (dummy>0._RK .and. dummy<1._RK) exit
    2485             : !      write(*,*) "**Warning** random Beta variable out of bound.", dummy
    2486             : !      write(*,*) "Something is wrong with getRandBeta()."
    2487             : !      cycle
    2488             : !    end do
    2489             : !    getRandCorMat(1,2) = 2._RK * dummy - 1._RK    ! for the moment, only the upper half of getRandCorMat is needed, the lower half will contain cholesky lower triangle.
    2490             : !
    2491             : !    m = 2
    2492             : !    call getCholeskyFactor(m,getRandCorMat(1:m,1:m),Diagonal(1:m))
    2493             : !
    2494             : !    failureCounter = 0
    2495             : !    onionLayer: do
    2496             : !
    2497             : !      beta = beta - 0.5_RK
    2498             : !
    2499             : !      sumSqDummyVec = 0._RK
    2500             : !      do j=1,m
    2501             : !        DummyVec(j) = getRandGaus()
    2502             : !        sumSqDummyVec = sumSqDummyVec + DummyVec(j)**2
    2503             : !      end do
    2504             : !      DummyVec(1:m) = DummyVec(1:m) / sqrt(sumSqDummyVec)   ! DummyVec is now a uniform random point from inside of m-sphere
    2505             : !
    2506             : !      mNew = m + 1
    2507             : !      posDefCheck: do
    2508             : !
    2509             : !        do
    2510             : !          dummy = getRandBeta(0.5_RK*m,beta)
    2511             : !          if (dummy>0._RK .and. dummy<1._RK) exit
    2512             : !          write(*,*) "**Warning** random Beta variable out of bound.", dummy
    2513             : !          write(*,*) "Something is wrong with getRandBeta()."
    2514             : !          read(*,*)
    2515             : !          cycle
    2516             : !        end do
    2517             : !        W(1:m) = sqrt(dummy) * DummyVec(1:m)
    2518             : !
    2519             : !        getRandCorMat(1:m,mNew) = 0._RK
    2520             : !        do j = 1,m
    2521             : !          getRandCorMat(j,mNew) = getRandCorMat(j,mNew) + Diagonal(j) * W(j)
    2522             : !          do i = j+1,m
    2523             : !            getRandCorMat(i,mNew) = getRandCorMat(i,mNew) + getRandCorMat(i,j) * getRandCorMat(j,mNew)
    2524             : !          end do
    2525             : !        end do
    2526             : !
    2527             : !
    2528             : !        call getCholeskyFactor(mNew,getRandCorMat(1:mNew,1:mNew),Diagonal(1:mNew))  ! Now check if the new matrix is positive-definite, then proceed with the next layer
    2529             : !        if (Diagonal(1)<0._RK) then
    2530             : !          failureCounter = failureCounter + 1
    2531             : !          cycle posDefCheck
    2532             : !          !write(*,*) "Cholesky factorization failed in getRandCorMat()."
    2533             : !          !write(*,*) m
    2534             : !          !write(*,*) getRandCorMat(1:m,1:m)
    2535             : !          !stop
    2536             : !        end if
    2537             : !        exit posDefCheck
    2538             : !
    2539             : !      end do posDefCheck
    2540             : !
    2541             : !      if (mNew==nd) exit onionLayer
    2542             : !      m = mNew
    2543             : !
    2544             : !    end do onionLayer
    2545             : !
    2546             : !    if (failureCounter>0) write(*,*) 'failureRatio: ', dble(failureCounter)/dble(nd-2)
    2547             : !    do i=1,nd-1
    2548             : !      getRandCorMat(i+1:nd,i) = getRandCorMat(i,i+1:nd)
    2549             : !    end do
    2550             : !
    2551             : !  end function getRandCorMat
    2552             : 
    2553             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2554             : 
    2555             :     !> \brief
    2556             :     !> Returns a random correlation matrix using Monte Carlo rejection method.
    2557             :     !>
    2558             :     !> \param[in]   nd      :   The rank of the correlation matrix.
    2559             :     !> \param[in]   minRho  :   The minimum correlation coefficient to be expected in the output random correlation matrix.
    2560             :     !> \param[in]   maxRho  :   The maximum correlation coefficient to be expected in the output random correlation matrix.
    2561             :     !>
    2562             :     !> \return
    2563             :     !> `RandCorMat` : A random correlation matrix. Only the upper half of
    2564             :     !> `RandCorMat` is the correlation matrix, lower half is NOT set on output.
    2565             :     !>
    2566             :     !> \warning
    2567             :     !> The conditions `nd >= 1` and `maxRho < minRho` must hold, otherwise, `RandCorMat(1,1) = -1._RK` will be returned.
    2568             :     !>
    2569             :     !> \remark
    2570             :     !> This subroutine is very slow for high matrix dimensions ( `nd >~ 10` ).
    2571             :     !>
    2572             :     !> \author
    2573             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2574         918 :     function getRandCorMatRejection(nd,minRho,maxRho) result(RandCorMat)
    2575             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2576             :         !DEC$ ATTRIBUTES DLLEXPORT :: getRandCorMatRejection
    2577             : #endif
    2578             : 
    2579         103 :         use Matrix_mod, only: isPosDef
    2580             :         implicit none
    2581             :         integer(IK), intent(in) :: nd
    2582             :         real(RK)   , intent(in) :: minRho,maxRho
    2583         306 :         real(RK)                :: RandCorMat(nd,nd), RhoVec(nd*(nd-1))
    2584             :         integer(IK)             :: i,j,irho
    2585         102 :         if (maxRho<minRho .or. nd<1_IK) then
    2586           2 :             RandCorMat(1,1) = -1._RK
    2587           2 :             return
    2588             :         end if
    2589         100 :         if (nd==1_IK) then
    2590           0 :           RandCorMat = 1._RK
    2591             :         else
    2592           0 :             rejection: do
    2593         100 :                 call random_number(RhoVec)
    2594         300 :                 RhoVec = minRho + RhoVec*(maxRho-minRho)
    2595         100 :                 irho = 0
    2596         300 :                 do j=1,nd
    2597         200 :                     RandCorMat(j,j) = 1._RK
    2598         400 :                     do i=1,j-1
    2599         100 :                         irho = irho + 1
    2600         300 :                         RandCorMat(i,j) = RhoVec(irho)
    2601             :                     end do
    2602             :                 end do
    2603         100 :                 if (isPosDef(nd,RandCorMat)) exit rejection
    2604           0 :                 cycle rejection
    2605             :             end do rejection
    2606             :         end if
    2607         200 :         do j=1,nd-1
    2608         300 :             RandCorMat(j+1:nd,j) = RandCorMat(j,j+1:nd)
    2609             :         end do
    2610         204 :   end function getRandCorMatRejection
    2611             : 
    2612             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2613             : 
    2614             :     !> \brief
    2615             :     !> Convert the upper-triangle covariance matrix to the upper-triangle correlation matrix.
    2616             :     !>
    2617             :     !> \param[in]   nd          :   The rank of the covariance matrix.
    2618             :     !> \param[in]   CovMatUpper :   The upper-triangle covariance matrix. The lower-triangle will not be used.
    2619             :     !>
    2620             :     !> \return
    2621             :     !> `CorMatUpper` : An upper-triangle correlation matrix. The lower-triangle will NOT be set.
    2622             :     !>
    2623             :     !> \author
    2624             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2625        3228 :     pure function getCorMatUpperFromCovMatUpper(nd,CovMatUpper) result(CorMatUpper)
    2626             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2627             :         !DEC$ ATTRIBUTES DLLEXPORT :: getCorMatUpperFromCovMatUpper
    2628             : #endif
    2629             :         implicit none
    2630             :         integer(IK)  , intent(in) :: nd
    2631             :         real(RK)     , intent(in) :: CovMatUpper(nd,nd)
    2632             :         real(RK)                  :: CorMatUpper(nd,nd)
    2633        1143 :         real(RK)                  :: InverseStdVec(nd)
    2634             :         integer(IK)               :: i,j
    2635        1143 :         do j = 1, nd
    2636         695 :             InverseStdVec(j) = 1._RK / sqrt(CovMatUpper(j,j))
    2637        2085 :             do i = 1, j
    2638        1637 :                 CorMatUpper(i,j) = CovMatUpper(i,j) * InverseStdVec(j) * InverseStdVec(i)
    2639             :             end do
    2640             :         end do
    2641         550 :     end function getCorMatUpperFromCovMatUpper
    2642             : 
    2643             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2644             : 
    2645             :     !> \brief
    2646             :     !> Convert the upper-triangle correlation matrix to the upper-triangle covariance matrix.
    2647             :     !>
    2648             :     !> \param[in]   nd          :   The rank of the correlation matrix.
    2649             :     !> \param[in]   StdVec      :   The input standard deviation vector of length `nd`.
    2650             :     !> \param[in]   CorMatUpper :   The upper-triangle correlation matrix. The lower-triangle will not be used.
    2651             :     !>
    2652             :     !> \return
    2653             :     !> `CovMatUpper` : An upper-triangle covariance matrix. The lower-triangle will NOT be set.
    2654             :     !>
    2655             :     !> \author
    2656             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2657           9 :     pure function getCovMatUpperFromCorMatUpper(nd,StdVec,CorMatUpper) result(CovMatUpper)
    2658             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2659             :         !DEC$ ATTRIBUTES DLLEXPORT :: getCovMatUpperFromCorMatUpper
    2660             : #endif
    2661             :         implicit none
    2662             :         integer(IK)  , intent(in) :: nd
    2663             :         real(RK)     , intent(in) :: StdVec(nd), CorMatUpper(nd,nd)
    2664             :         real(RK)                  :: CovMatUpper(nd,nd)
    2665             :         integer(IK)               :: i,j
    2666           3 :         do j=1,nd
    2667           6 :             do i=1,j
    2668           5 :                 CovMatUpper(i,j) = CorMatUpper(i,j) * StdVec(j) * StdVec(i)
    2669             :             end do
    2670             :         end do
    2671         449 :     end function getCovMatUpperFromCorMatUpper
    2672             : 
    2673             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2674             : 
    2675             :     !> \brief
    2676             :     !> Convert the lower-triangle correlation matrix to the upper-triangle covariance matrix.
    2677             :     !>
    2678             :     !> \param[in]   nd          :   The rank of the correlation matrix.
    2679             :     !> \param[in]   StdVec      :   The input standard deviation vector of length `nd`.
    2680             :     !> \param[in]   CorMatLower :   The lower-triangle correlation matrix. The upper-triangle will not be used.
    2681             :     !>
    2682             :     !> \return
    2683             :     !> `CovMatUpper` : An upper-triangle covariance matrix. The lower-triangle will NOT be set.
    2684             :     !>
    2685             :     !> \author
    2686             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2687           9 :     pure function getCovMatUpperFromCorMatLower(nd,StdVec,CorMatLower) result(CovMatUpper)
    2688             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2689             :         !DEC$ ATTRIBUTES DLLEXPORT :: getCovMatUpperFromCorMatLower
    2690             : #endif
    2691             :         implicit none
    2692             :         integer(IK)  , intent(in) :: nd
    2693             :         real(RK)     , intent(in) :: StdVec(nd), CorMatLower(nd,nd)
    2694             :         real(RK)                  :: CovMatUpper(nd,nd)
    2695             :         integer(IK)               :: i,j
    2696           3 :         do j=1,nd
    2697           2 :             CovMatUpper(j,j) = StdVec(j)**2
    2698           4 :             do i=1,j-1
    2699           3 :                 CovMatUpper(i,j) = CorMatLower(j,i) * StdVec(j) * StdVec(i)
    2700             :             end do
    2701             :         end do
    2702           2 :     end function getCovMatUpperFromCorMatLower
    2703             : 
    2704             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2705             : 
    2706             :     !> \brief
    2707             :     !> Convert the upper-triangle correlation matrix to the lower-triangle covariance matrix.
    2708             :     !>
    2709             :     !> \param[in]   nd          :   The rank of the correlation matrix.
    2710             :     !> \param[in]   StdVec      :   The input standard deviation vector of length `nd`.
    2711             :     !> \param[in]   CorMatUpper :   The upper-triangle correlation matrix. The lower-triangle will not be used.
    2712             :     !>
    2713             :     !> \return
    2714             :     !> `CovMatLower` : An lower-triangle covariance matrix. The upper-triangle will NOT be set.
    2715             :     !>
    2716             :     !> \author
    2717             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2718           9 :     pure function getCovMatLowerFromCorMatUpper(nd,StdVec,CorMatUpper) result(CovMatLower)
    2719             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2720             :         !DEC$ ATTRIBUTES DLLEXPORT :: getCovMatLowerFromCorMatUpper
    2721             : #endif
    2722             :         implicit none
    2723             :         integer(IK)  , intent(in) :: nd
    2724             :         real(RK)     , intent(in) :: StdVec(nd), CorMatUpper(nd,nd)
    2725             :         real(RK)                  :: CovMatLower(nd,nd)
    2726             :         integer(IK)               :: i,j
    2727           3 :         do j=1,nd
    2728           2 :             CovMatLower(j,j) = StdVec(j)**2
    2729           4 :             do i=1,j-1
    2730           3 :                 CovMatLower(j,i) = CorMatUpper(i,j) * StdVec(j) * StdVec(i)
    2731             :             end do
    2732             :         end do
    2733           2 :     end function getCovMatLowerFromCorMatUpper
    2734             : 
    2735             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2736             : 
    2737             :     !> \brief
    2738             :     !> Convert the lower-triangle correlation matrix to the lower-triangle covariance matrix.
    2739             :     !>
    2740             :     !> \param[in]   nd          :   The rank of the correlation matrix.
    2741             :     !> \param[in]   StdVec      :   The input standard deviation vector of length `nd`.
    2742             :     !> \param[in]   CorMatLower :   The lower-triangle correlation matrix. The upper-triangle will not be used.
    2743             :     !>
    2744             :     !> \return
    2745             :     !> `CovMatLower` : An lower-triangle covariance matrix. The upper-triangle will NOT be set.
    2746             :     !>
    2747             :     !> \author
    2748             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2749           9 :     pure function getCovMatLowerFromCorMatLower(nd,StdVec,CorMatLower) result(CovMatLower)
    2750             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2751             :         !DEC$ ATTRIBUTES DLLEXPORT :: getCovMatLowerFromCorMatLower
    2752             : #endif
    2753             :         implicit none
    2754             :         integer(IK)  , intent(in) :: nd
    2755             :         real(RK)     , intent(in) :: StdVec(nd), CorMatLower(nd,nd)
    2756             :         real(RK)                  :: CovMatLower(nd,nd)
    2757             :         integer(IK)               :: i,j
    2758           3 :         do j=1,nd
    2759           2 :             CovMatLower(j,j) = StdVec(j)**2
    2760           4 :             do i=1,j-1
    2761           3 :                 CovMatLower(j,i) = CorMatLower(j,i) * StdVec(j) * StdVec(i)
    2762             :             end do
    2763             :         end do
    2764           2 :     end function getCovMatLowerFromCorMatLower
    2765             : 
    2766             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2767             : 
    2768             :     !> \brief
    2769             :     !> Convert the input correlation matrix to the output covariance matrix.
    2770             :     !>
    2771             :     !> \param[in]   nd          :   The rank of the correlation matrix.
    2772             :     !> \param[in]   StdVec      :   The input standard deviation vector of length `nd`.
    2773             :     !> \param[in]   CorMatUpper :   The upper-triangle correlation matrix. The lower-triangle will not be used.
    2774             :     !>
    2775             :     !> \return
    2776             :     !> `CovMatFull` : The full covariance matrix.
    2777             :     !>
    2778             :     !> \author
    2779             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2780        2366 :     pure function getCovMatFromCorMatUpper(nd,StdVec,CorMatUpper) result(CovMatFull)
    2781             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2782             :         !DEC$ ATTRIBUTES DLLEXPORT :: getCovMatFromCorMatUpper
    2783             : #endif
    2784             :         implicit none
    2785             :         integer(IK)  , intent(in) :: nd
    2786             :         real(RK)     , intent(in) :: StdVec(nd), CorMatUpper(nd,nd)   ! only upper half needed
    2787             :         real(RK)                  :: CovMatFull(nd,nd)
    2788             :         integer(IK)               :: i,j
    2789         854 :         do j=1,nd
    2790         504 :             CovMatFull(j,j) = StdVec(j)**2
    2791        1008 :             do i=1,j-1
    2792         154 :                 CovMatFull(i,j) = CorMatUpper(i,j) * StdVec(j) * StdVec(i)
    2793         658 :                 CovMatFull(j,i) = CovMatFull(i,j)
    2794             :             end do
    2795             :         end do
    2796         351 :     end function getCovMatFromCorMatUpper
    2797             : 
    2798             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2799             : 
    2800             : !    !> \brief
    2801             : !    !> Return the Geometric distribution PDF values for a range of trials, starting at index `1`.
    2802             : !    !> If the probability of success on each trial is `successProb`, then the probability that
    2803             : !    !> the `k`th trial (out of `k` trials) is the first success is `GeoLogPDF(k)`.
    2804             : !    !>
    2805             : !    !> \param[in]   successProb     :   The probability of success.
    2806             : !    !> \param[in]   logPdfPrecision :   The precision value below which the PDF is practically considered to be zero (**optional**).
    2807             : !    !> \param[in]   minSeqLen       :   The minimum length of the range of `k` values for which the PDF will be computed (**optional**).
    2808             : !    !> \param[in]   seqLen          :   The length of the range of `k` values for which the PDF will be computed (**optional**).
    2809             : !    !>                                  If provided, it will overwrite the the output sequence length as inferred from
    2810             : !    !>                                  the combination of `minSeqLen` and `logPdfPrecision`.
    2811             : !    !>
    2812             : !    !> \return
    2813             : !    !> `GeoLogPDF`  :   An allocatable representing the geometric PDF over a range of `k` values, whose length is
    2814             : !    !>                  `seqLen`, or if not provided, is determined from the values of `logPdfPrecision` and `minSeqLen`.
    2815             : !    !>
    2816             : !    !> \author
    2817             : !    !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2818             : !    function getGeoLogPDF_old(successProb,logPdfPrecision,minSeqLen,seqLen) result(GeoLogPDF)
    2819             : !#if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2820             : !        !DEC$ ATTRIBUTES DLLEXPORT :: getGeoLogPDF_old
    2821             : !#endif
    2822             : !        use Constants_mod, only: IK, RK
    2823             : !        implicit none
    2824             : !        real(RK)    , intent(in)            :: successProb
    2825             : !        real(RK)    , intent(in), optional  :: logPdfPrecision
    2826             : !        integer(IK) , intent(in), optional  :: minSeqLen
    2827             : !        integer(IK) , intent(in), optional  :: seqLen
    2828             : !        real(RK)    , allocatable           :: GeoLogPDF(:)
    2829             : !        real(RK)    , parameter             :: LOG_PDF_PRECISION = log(0.001_RK)
    2830             : !        real(RK)                            :: logProbFailure
    2831             : !        integer(IK)                         :: lenGeoLogPDF, i
    2832             : !        logProbFailure = log(1._RK - successProb)
    2833             : !        if (present(seqLen)) then
    2834             : !            lenGeoLogPDF = seqLen
    2835             : !        else
    2836             : !            if (present(logPdfPrecision)) then
    2837             : !                lenGeoLogPDF = ceiling(  logPdfPrecision / logProbFailure)
    2838             : !            else
    2839             : !                lenGeoLogPDF = ceiling(LOG_PDF_PRECISION / logProbFailure)
    2840             : !            end if
    2841             : !            if (present(minSeqLen)) lenGeoLogPDF = max(minSeqLen,lenGeoLogPDF)
    2842             : !        end if
    2843             : !        allocate(GeoLogPDF(lenGeoLogPDF))
    2844             : !        GeoLogPDF(1) = log(successProb)
    2845             : !        do i = 2, lenGeoLogPDF
    2846             : !            GeoLogPDF(i) = GeoLogPDF(i-1) + logProbFailure
    2847             : !        end do
    2848             : !    end function getGeoLogPDF_old
    2849             : 
    2850             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2851             : 
    2852             :     !> \brief
    2853             :     !> Return the Geometric distribution PDF values for the input number of trials,
    2854             :     !> the trials at which first success happens, and the success probability.
    2855             :     !>
    2856             :     !> \param[in]   numTrial    :   The number of trials.
    2857             :     !> \param[in]   SuccessStep :   The vector of trials of length `numTrial` at which the first success happens.
    2858             :     !> \param[in]   successProb :   The probability of success.
    2859             :     !>
    2860             :     !> \return
    2861             :     !> `LogProbGeo` :   An output vector of length `numTrial` representing the geometric PDF values.
    2862             :     !>
    2863             :     !> \author
    2864             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2865          13 :     pure function getLogProbGeo(numTrial, SuccessStep, successProb) result(LogProbGeo)
    2866             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2867             :         !DEC$ ATTRIBUTES DLLEXPORT :: getLogProbGeo
    2868             : #endif
    2869         350 :         use Constants_mod, only: IK, RK
    2870             :         implicit none
    2871             :         integer(IK) , intent(in)    :: numTrial
    2872             :         integer(IK) , intent(in)    :: SuccessStep(numTrial)
    2873             :         real(RK)    , intent(in)    :: successProb
    2874             :         real(RK)                    :: LogProbGeo(numTrial)
    2875           1 :         real(RK)                    :: logProbSuccess, logProbFailure
    2876           1 :         logProbSuccess = log(successProb)
    2877           1 :         logProbFailure = log(1._RK - successProb)
    2878          11 :         LogProbGeo = logProbSuccess + (SuccessStep-1_IK) * logProbFailure
    2879           1 :     end function getLogProbGeo
    2880             : 
    2881             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2882             : 
    2883             :     !> \brief
    2884             :     !> Compute the natural logarithm of the Geometric distribution PDF of a limited range of Bernoulli trials,
    2885             :     !> starting at index `1` up to `maxNumTrial`. In other words, upon reaching the trial `maxNumTrial`,
    2886             :     !> the Bernoulli trials count restart from index `1`. This Cyclic Geometric distribution is
    2887             :     !> particularly useful in the parallelization studies of Monte Carlo simulation.
    2888             :     !>
    2889             :     !> \param[in]   successProb :   The probability of success.
    2890             :     !> \param[in]   maxNumTrial :   The maximum number of trails possible.
    2891             :     !>                              After `maxNumTrial` tries, the Geometric distribution restarts from index `1`.
    2892             :     !> \param[in]   numTrial    :   The length of the array `SuccessStep`. Note that `numTrial < maxNumTrial` must hold.
    2893             :     !> \param[in]   SuccessStep :   A vector of length `(1:numTrial)` of integers that represent
    2894             :     !>                              the steps at which the Bernoulli successes occur.
    2895             :     !>
    2896             :     !> \return
    2897             :     !> `LogProbGeoCyclic`       :   A real-valued vector of length `(1:numTrial)` whose values represent the probabilities
    2898             :     !>                              of having Bernoulli successes at the corresponding SuccessStep values.
    2899             :     !>
    2900             :     !> \warning
    2901             :     !> Any value of SuccessStep must be an integer numbers between `1` and `maxNumTrial`.
    2902             :     !> The onus is on the user to ensure this condition holds.
    2903             :     !>
    2904             :     !> \author
    2905             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2906       54814 :     pure function getLogProbGeoCyclic(successProb,maxNumTrial,numTrial,SuccessStep) result(LogProbGeoCyclic)
    2907             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2908             :         !DEC$ ATTRIBUTES DLLEXPORT :: getLogProbGeoCyclic
    2909             : #endif
    2910           1 :         use Constants_mod, only: IK, RK, NEGLOGINF_RK
    2911             :         implicit none
    2912             :         real(RK)    , intent(in)    :: successProb
    2913             :         integer(IK) , intent(in)    :: maxNumTrial
    2914             :         integer(IK) , intent(in)    :: numTrial
    2915             :         integer(IK) , intent(in)    :: SuccessStep(numTrial)
    2916             :         real(RK)                    :: LogProbGeoCyclic(numTrial)
    2917        1586 :         real(RK)                    :: failureProb, logProbSuccess, logProbFailure, logDenominator, exponentiation
    2918        1586 :         if (successProb>0._RK .and. successProb<1._RK) then ! tolerate log(0)
    2919        1586 :             failureProb = 1._RK - successProb
    2920        1586 :             logProbSuccess = log(successProb)
    2921        1586 :             logProbFailure = log(failureProb)
    2922        1586 :             exponentiation = maxNumTrial * logProbFailure
    2923        1586 :             if (exponentiation<NEGLOGINF_RK) then ! tolerate underflow
    2924           0 :                 logDenominator = 0._RK
    2925             :             else
    2926        1586 :                 exponentiation = exp(exponentiation)
    2927        1586 :                 if (exponentiation<1._RK) then ! tolerate log(0)
    2928        1586 :                     logDenominator = log(1._RK-exponentiation)
    2929             :                 else
    2930           0 :                     logDenominator = NEGLOGINF_RK
    2931             :                 end if
    2932             :             end if
    2933       51642 :             LogProbGeoCyclic = logProbSuccess + (SuccessStep-1) * logProbFailure - logDenominator
    2934           0 :         elseif (successProb==0._RK) then
    2935           0 :             LogProbGeoCyclic = -log(real(maxNumTrial,kind=RK))
    2936           0 :         elseif (successProb==1._RK) then
    2937           0 :             LogProbGeoCyclic(1) = 0._RK
    2938           0 :             LogProbGeoCyclic(2:numTrial) = NEGLOGINF_RK
    2939             :         else
    2940           0 :             LogProbGeoCyclic = NEGLOGINF_RK
    2941             :         end if
    2942        1586 :     end function getLogProbGeoCyclic
    2943             : 
    2944             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2945             : 
    2946             :     !> \brief
    2947             :     !> Return the standard normal distribution PDF value.
    2948             :     !>
    2949             :     !> \param[in]   z   :   The input value at which the PDF will be computed.
    2950             :     !>
    2951             :     !> \return
    2952             :     !> `snormPDF`   :   The standard normal distribution PDF value.
    2953             :     !>
    2954             :     !> \author
    2955             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2956           1 :     function getSNormPDF(z) result(snormPDF)
    2957             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2958             :         !DEC$ ATTRIBUTES DLLEXPORT :: getSNormPDF
    2959             : #endif
    2960        1586 :         use Constants_mod, only: INVSQRT2PI
    2961             :         implicit none
    2962             :         real(RK), intent(in) :: z
    2963             :         real(RK)             :: snormPDF
    2964           1 :         snormPDF = INVSQRT2PI * exp( -0.5_RK*z**2 )
    2965           2 :     end function getSNormPDF
    2966             : 
    2967             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2968             : 
    2969             :     !> \brief
    2970             :     !> Return the non-standard normal distribution PDF value.
    2971             :     !>
    2972             :     !> \param[in]   avg :   The mean of the Normal distribution.
    2973             :     !> \param[in]   std :   The standard deviation of the Normal distribution.
    2974             :     !> \param[in]   var :   The variance of the Normal distribution.
    2975             :     !> \param[in]   x   :   The point at which the PDF will be computed.
    2976             :     !>
    2977             :     !> \return
    2978             :     !> `normPDF`        :   The normal distribution PDF value at the given input point.
    2979             :     !>
    2980             :     !> \author
    2981             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    2982           1 :     function getNormPDF(avg,std,var,x) result(normPDF)
    2983             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    2984             :         !DEC$ ATTRIBUTES DLLEXPORT :: getNormPDF
    2985             : #endif
    2986           1 :         use Constants_mod, only: INVSQRT2PI
    2987             :         implicit none
    2988             :         real(RK), intent(in) :: avg,std,var,x
    2989             :         real(RK)             :: normPDF
    2990           1 :         normPDF = INVSQRT2PI * exp( -(x-avg)**2/(2._RK*var) ) / std
    2991           2 :     end function getNormPDF
    2992             : 
    2993             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2994             : 
    2995             :     !> \brief
    2996             :     !> Return the non-standard normal distribution Cumulative Probability Density function (CDF) value.
    2997             :     !>
    2998             :     !> \param[in]   avg :   The mean of the Normal distribution.
    2999             :     !> \param[in]   std :   The standard deviation of the Normal distribution.
    3000             :     !> \param[in]   x   :   The point at which the PDF will be computed.
    3001             :     !>
    3002             :     !> \return
    3003             :     !> `normCDF`        :   The normal distribution CDF value at the given input point.
    3004             :     !>
    3005             :     !> \author
    3006             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    3007           1 :     pure function getNormCDF(avg,std,x) result(normCDF)
    3008             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    3009             :         !DEC$ ATTRIBUTES DLLEXPORT :: getNormCDF
    3010             : #endif
    3011           1 :         use Constants_mod, only: RK, SQRT2
    3012             :         implicit none
    3013             :         real(RK), intent(in) :: avg,std,x
    3014             :         real(RK)             :: normCDF
    3015           1 :         normCDF = 0.5_RK * ( 1._RK + erf( real((x-avg)/(SQRT2*std),kind=RK) ) )
    3016           2 :     end function getNormCDF
    3017             : 
    3018             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    3019             : 
    3020             :     !> \brief
    3021             :     !> Return the standard normal distribution Cumulative Probability Density function (CDF) value.
    3022             :     !>
    3023             :     !> \param[in]   x       :   The point at which the PDF will be computed.
    3024             :     !>
    3025             :     !> \return
    3026             :     !> `normCDF`   :   The normal distribution CDF value at the given input point.
    3027             :     !>
    3028             :     !> \remark
    3029             :     !> This procedure performs all calculations in `real32` real kind. If 64-bit accuracy matters more than performance,
    3030             :     !> then use the [getSNormCDF_DPR](@ref getsnormcdf_dpr) for a more-accurate double-precision but slower results.
    3031             :     !>
    3032             :     !> \author
    3033             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    3034           1 :     pure function getSNormCDF_SPR(x) result(normCDF)
    3035             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    3036             :         !DEC$ ATTRIBUTES DLLEXPORT :: getSNormCDF_SPR
    3037             : #endif
    3038             :         use iso_fortran_env, only: RK => real32
    3039             :         implicit none
    3040             :         real(RK)    , intent(in)    :: x
    3041             :         real(RK)                    :: normCDF
    3042             :         real(RK), parameter         :: INVSQRT2 = 1._RK / sqrt(2._RK)
    3043           1 :         normCDF = 0.5_RK * ( 1._RK + erf( real(x*INVSQRT2,kind=RK) ) )
    3044           1 :     end function getSNormCDF_SPR
    3045             : 
    3046             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    3047             : 
    3048             :     !> \brief
    3049             :     !> Return the standard normal distribution Cumulative Probability Density function (CDF) value.
    3050             :     !>
    3051             :     !> \param[in]   x   :   The point at which the PDF will be computed.
    3052             :     !>
    3053             :     !> \return
    3054             :     !> `normCDF`   :   The normal distribution CDF value at the given input point.
    3055             :     !>
    3056             :     !> \remark
    3057             :     !> This procedure performs all calculations in `DPR` (`real64`) real kind. If performance matters more than 64-bit accuracy,
    3058             :     !> then use the [getSNormCDF_SPR](@ref getsnormcdf_spr) for a faster, but less-accurate single-precision results.
    3059             :     !>
    3060             :     !> \author
    3061             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    3062          51 :     pure function getSNormCDF_DPR(x) result(normCDF)
    3063             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    3064             :         !DEC$ ATTRIBUTES DLLEXPORT :: getSNormCDF_DPR
    3065             : #endif
    3066             :         use iso_fortran_env, only: RK => real64
    3067             :         implicit none
    3068             :         real(RK), intent(in)    :: x
    3069             :         real(RK)                :: normCDF
    3070             :         real(RK), parameter     :: INVSQRT2 = 1._RK / sqrt(2._RK)
    3071          51 :         normCDF = 0.5_RK * ( 1._RK + erf( real(x*INVSQRT2,kind=RK) ) )
    3072           1 :     end function getSNormCDF_DPR
    3073             : 
    3074             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    3075             : 
    3076             :     !> \brief
    3077             :     !> Return the Beta distribution Cumulative Probability Density function (CDF) value.
    3078             :     !>
    3079             :     !> \param[in]   alpha   :   The first shape parameter of the Beta distribution.
    3080             :     !> \param[in]   beta    :   The second shape parameter of the Beta distribution.
    3081             :     !> \param[in]   x       :   The point at which the CDF will be computed.
    3082             :     !>
    3083             :     !> \return
    3084             :     !> `betaCDF`   :   The Beta distribution CDF value at the given input point.
    3085             :     !>
    3086             :     !> \warning
    3087             :     !> If `x` is not in the range `[0,1]`, a negative value for `betaCDF` will be returned to indicate the occurrence of error.
    3088             :     !>
    3089             :     !> \warning
    3090             :     !> The onus is on the user to ensure that the input (`alpha`, `beta`) shape parameters are positive.
    3091             :     !>
    3092             :     !> \remark
    3093             :     !> This procedure performs all calculations in `real32` real kind. If 64-bit accuracy matters more than performance,
    3094             :     !> then use the [getBetaCDF_DPR](@ref getbetacdf_dpr) for a more-accurate double-precision but slower results.
    3095             :     !>
    3096             :     !> \todo
    3097             :     !> The efficiency of this code can be improved by making `x` a vector on input.
    3098             :     !>
    3099             :     !> \author
    3100             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    3101           3 :     function getBetaCDF_SPR(alpha,beta,x) result(betaCDF)
    3102             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    3103             :         !DEC$ ATTRIBUTES DLLEXPORT :: getBetaCDF_SPR
    3104             : #endif
    3105             :         use iso_fortran_env, only: RK => real32
    3106             :         implicit none
    3107             :         real(RK), intent(in)    :: alpha, beta, x
    3108           3 :         real(RK)                :: bt
    3109             :         real(RK)                :: betaCDF
    3110           3 :         if (x < 0._RK .or. x > 1._RK) then
    3111           2 :             betaCDF = -1._RK
    3112           2 :             return
    3113             :         end if
    3114           1 :         if (x == 0._RK .or. x == 1._RK) then
    3115           0 :             bt = 0._RK
    3116             :         else
    3117             :             bt = exp( log_gamma(real(alpha+beta,kind=RK)) &
    3118             :                     - log_gamma(real(alpha,kind=RK)) - log_gamma(real(beta,kind=RK)) &
    3119           1 :                     + alpha*log(x) + beta*log(1._RK-x) )
    3120             :         end if
    3121           1 :         if ( x < (alpha+1._RK) / (alpha+beta+2._RK) ) then
    3122           0 :             betaCDF = bt * getBetaContinuedFraction(alpha,beta,x) / alpha
    3123             :         else
    3124           1 :             betaCDF = 1._RK - bt * getBetaContinuedFraction(beta,alpha,1._RK-x) / beta
    3125             :         end if
    3126          54 :     end function getBetaCDF_SPR
    3127             : 
    3128             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    3129             : 
    3130             :     !> \brief
    3131             :     !> Return the Beta distribution Cumulative Probability Density function (CDF) value.
    3132             :     !>
    3133             :     !> \param[in]   alpha   :   The first shape parameter of the Beta distribution.
    3134             :     !> \param[in]   beta    :   The second shape parameter of the Beta distribution.
    3135             :     !> \param[in]   x       :   The point at which the CDF will be computed.
    3136             :     !>
    3137             :     !> \return
    3138             :     !> `betaCDF`   :   The Beta distribution CDF value at the given input point.
    3139             :     !>
    3140             :     !> \warning
    3141             :     !> If `x` is not in the range `[0,1]`, a negative value for `betaCDF` will be returned to indicate the occurrence of error.
    3142             :     !>
    3143             :     !> \warning
    3144             :     !> The onus is on the user to ensure that the input (`alpha`, `beta`) shape parameters are positive.
    3145             :     !>
    3146             :     !> \remark
    3147             :     !> This procedure performs all calculations in `DPR` (`real64`) real kind. If performance matters more than 64-bit accuracy,
    3148             :     !> then use the [getBetaCDF_SPR](@ref getbetacdf_spr) for a faster, but less-accurate single-precision results.
    3149             :     !>
    3150             :     !> \todo
    3151             :     !> The efficiency of this code can be improved by making `x` a vector on input.
    3152             :     !>
    3153             :     !> \author
    3154             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    3155           5 :     function getBetaCDF_DPR(alpha,beta,x) result(betaCDF)
    3156             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    3157             :         !DEC$ ATTRIBUTES DLLEXPORT :: getBetaCDF_DPR
    3158             : #endif
    3159             :         use iso_fortran_env, only: RK => real64
    3160             :         implicit none
    3161             :         real(RK), intent(in)    :: alpha, beta, x
    3162           5 :         real(RK)                :: bt
    3163             :         real(RK)                :: betaCDF
    3164           5 :         if (x < 0._RK .or. x > 1._RK) then
    3165           2 :             betaCDF = -1._RK
    3166           2 :             return
    3167             :         end if
    3168           3 :         if (x == 0._RK .or. x == 1._RK) then
    3169           0 :             bt = 0._RK
    3170             :         else
    3171             :             bt = exp( log_gamma(real(alpha+beta,kind=RK)) &
    3172             :                     - log_gamma(real(alpha,kind=RK)) - log_gamma(real(beta,kind=RK)) &
    3173           3 :                     + alpha*log(x) + beta*log(1._RK-x) )
    3174             :         end if
    3175           3 :         if ( x < (alpha+1._RK) / (alpha+beta+2._RK) ) then
    3176           2 :             betaCDF = bt * getBetaContinuedFraction(alpha,beta,x) / alpha
    3177             :         else
    3178           1 :             betaCDF = 1._RK - bt * getBetaContinuedFraction(beta,alpha,1._RK-x) / beta
    3179             :         end if
    3180           8 :     end function getBetaCDF_DPR
    3181             : 
    3182             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    3183             : 
    3184             :     !> \brief
    3185             :     !> Return the Beta Continued Fraction (BCF).
    3186             :     !>
    3187             :     !> \param[in]   alpha   :   The first shape parameter of the Beta distribution.
    3188             :     !> \param[in]   beta    :   The second shape parameter of the Beta distribution.
    3189             :     !> \param[in]   x       :   The point at which the BCF will be computed.
    3190             :     !>
    3191             :     !> \return
    3192             :     !> `betaCDF`   :   The BCF value at the given input point.
    3193             :     !>
    3194             :     !> \author
    3195             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    3196           1 :     function getBetaContinuedFraction_SPR(alpha,beta,x) result(betaContinuedFraction)
    3197             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    3198             :         !DEC$ ATTRIBUTES DLLEXPORT :: getBetaContinuedFraction_SPR
    3199             : #endif
    3200             :         use iso_fortran_env, only: RK => real32
    3201             :         implicit none
    3202             :         real(RK)   , intent(in) :: alpha,beta,x
    3203             :         real(RK)   , parameter  :: eps = epsilon(x), fpmin = tiny(x)/eps
    3204             :         integer(IK), parameter  :: maxit = 100_IK
    3205           1 :         real(RK)                :: aa,c,d,del,qab,qam,qap
    3206             :         real(RK)                :: betaContinuedFraction
    3207             :         integer(IK)             :: m,m2
    3208           1 :         qab = alpha+beta
    3209           1 :         qap = alpha+1._RK
    3210           1 :         qam = alpha-1._RK
    3211           1 :         c = 1._RK
    3212           1 :         d = 1._RK-qab*x/qap
    3213           0 :         if (abs(d) < fpmin) d = fpmin
    3214           1 :         d = 1._RK/d
    3215           1 :         betaContinuedFraction = d
    3216           2 :         do m = 1,maxit
    3217           2 :             m2 = 2*m
    3218           2 :             aa = m*(beta-m)*x/((qam+m2)*(alpha+m2))
    3219           2 :             d = 1._RK+aa*d
    3220           2 :             if (abs(d) < fpmin) d = fpmin
    3221           2 :             c = 1._RK+aa/c
    3222           2 :             if (abs(c) < fpmin) c = fpmin
    3223           2 :             d = 1._RK/d
    3224           2 :             betaContinuedFraction = betaContinuedFraction*d*c
    3225           2 :             aa = -(alpha+m)*(qab+m)*x/((alpha+m2)*(qap+m2))
    3226           2 :             d = 1._RK+aa*d
    3227           2 :             if (abs(d) < fpmin) d = fpmin
    3228           2 :             c = 1._RK+aa/c
    3229           2 :             if (abs(c) < fpmin) c = fpmin
    3230           2 :             d = 1._RK/d
    3231           2 :             del = d*c
    3232           2 :             betaContinuedFraction = betaContinuedFraction*del
    3233           2 :             if (abs(del-1._RK) <=  eps) exit
    3234             :         end do
    3235           1 :         if (m > maxit) then
    3236             :         ! LCOV_EXCL_START
    3237             :             error stop
    3238             :             !call abortProgram( output_unit , 1 , 1 , &
    3239             :             !'Statitistics@getBetaContinuedFraction_SPR() failed: alpha or beta too big, or maxit too small.' )
    3240             :         end if
    3241             :         ! LCOV_EXCL_STOP
    3242           6 :     end function getBetaContinuedFraction_SPR
    3243             : 
    3244             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    3245             : 
    3246             :     !> \brief
    3247             :     !> Return the Beta Continued Fraction (BCF).
    3248             :     !>
    3249             :     !> \param[in]   alpha   :   The first shape parameter of the Beta distribution.
    3250             :     !> \param[in]   beta    :   The second shape parameter of the Beta distribution.
    3251             :     !> \param[in]   x       :   The point at which the BCF will be computed.
    3252             :     !>
    3253             :     !> \return
    3254             :     !> `betaCDF`   :   The BCF value at the given input point.
    3255             :     !>
    3256             :     !> \author
    3257             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    3258           3 :     function getBetaContinuedFraction_DPR(alpha,beta,x) result(betaContinuedFraction)
    3259             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    3260             :         !DEC$ ATTRIBUTES DLLEXPORT :: getBetaContinuedFraction_DPR
    3261             : #endif
    3262             :         use iso_fortran_env, only: RK => real64
    3263             :         implicit none
    3264             :         real(RK)   , intent(in) :: alpha,beta,x
    3265             :         real(RK)   , parameter  :: eps = epsilon(x), fpmin = tiny(x)/eps
    3266             :         integer(IK), parameter  :: maxit = 100_IK
    3267           3 :         real(RK)                :: aa,c,d,del,qab,qam,qap
    3268             :         real(RK)                :: betaContinuedFraction
    3269             :         integer(IK)             :: m,m2
    3270           3 :         qab = alpha+beta
    3271           3 :         qap = alpha+1._RK
    3272           3 :         qam = alpha-1._RK
    3273           3 :         c = 1._RK
    3274           3 :         d = 1._RK-qab*x/qap
    3275           0 :         if (abs(d) < fpmin) d = fpmin
    3276           3 :         d = 1._RK/d
    3277           3 :         betaContinuedFraction = d
    3278          30 :         do m = 1,maxit
    3279          30 :             m2 = 2*m
    3280          30 :             aa = m*(beta-m)*x/((qam+m2)*(alpha+m2))
    3281          30 :             d = 1._RK+aa*d
    3282          30 :             if (abs(d) < fpmin) d = fpmin
    3283          30 :             c = 1._RK+aa/c
    3284          30 :             if (abs(c) < fpmin) c = fpmin
    3285          30 :             d = 1._RK/d
    3286          30 :             betaContinuedFraction = betaContinuedFraction*d*c
    3287          30 :             aa = -(alpha+m)*(qab+m)*x/((alpha+m2)*(qap+m2))
    3288          30 :             d = 1._RK+aa*d
    3289          30 :             if (abs(d) < fpmin) d = fpmin
    3290          30 :             c = 1._RK+aa/c
    3291          30 :             if (abs(c) < fpmin) c = fpmin
    3292          30 :             d = 1._RK/d
    3293          30 :             del = d*c
    3294          30 :             betaContinuedFraction = betaContinuedFraction*del
    3295          30 :             if (abs(del-1._RK) <=  eps) exit
    3296             :         end do
    3297           3 :         if (m > maxit) then
    3298             :         ! LCOV_EXCL_START
    3299             :             error stop
    3300             :             !call abortProgram( output_unit , 1 , 1 , &
    3301             :             !'Statitistics@getBetaContinuedFraction_DPR() failed: alpha or beta too big, or maxit too small.' )
    3302             :         end if
    3303             :         ! LCOV_EXCL_STOP
    3304           4 :     end function getBetaContinuedFraction_DPR
    3305             : 
    3306             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    3307             : 
    3308             :     !> \brief
    3309             :     !> Return the one-sample Kolmogorov–Smirnov (KS) test results for the null hypothesis that the data
    3310             :     !> in vector `Point` comes from a distribution whose CDF is specified by the input `getCDF()` function.
    3311             :     !>
    3312             :     !> \param[in]       np      :   The number of points in the input vector `Point`.
    3313             :     !> \param[inout]    Point   :   The sample. On return, this array will be sorted in Ascending order.
    3314             :     !> \param[in]       getCDF  :   The function returning the Cumulative Distribution Function (CDF) of the sample.
    3315             :     !> \param[out]      statKS  :   The KS test statistic.
    3316             :     !> \param[out]      probKS  :   The `p`-value of the test, returned as a scalar value in the range `[0,1]`.
    3317             :     !>                              The output `probKS` is the probability of observing a test statistic as extreme as,
    3318             :     !>                              or more extreme than, the observed value under the null hypothesis.
    3319             :     !>                              Small values of `probKS` cast doubt on the validity of the null hypothesis.
    3320             :     !> \param[out]      Err     :   An object of class [Err_type](@ref err_mod::err_type) containing information
    3321             :     !>                              about the occurrence of any error during the KS test computation.
    3322             :     !>
    3323             :     !> \author
    3324             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    3325           1 :     subroutine doKS1(np,Point,getCDF,statKS,probKS,Err)
    3326             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    3327             :         !DEC$ ATTRIBUTES DLLEXPORT :: doKS1
    3328             : #endif
    3329           3 :         use Sort_mod, only : sortAscending
    3330             :         use Err_mod, only: Err_type
    3331             : 
    3332             :         implicit none
    3333             : 
    3334             :         integer(IK)     , intent(in)    :: np
    3335             :         real(RK)        , intent(out)   :: statKS,probKS
    3336             :         real(RK)        , intent(inout) :: Point(np)
    3337             :         type(Err_type)  , intent(out)   :: Err
    3338             : 
    3339             :         character(*)    , parameter     :: PROCEDURE_NAME = MODULE_NAME//"@doKS1"
    3340           1 :         real(RK)                        :: npSqrt
    3341           1 :         real(RK)                        :: cdf,cdfObserved,dt,frac
    3342             :         integer(IK)                     :: j
    3343             : 
    3344             :         interface
    3345             :             function getCDF(x)
    3346             :                 use Constants_mod, only: RK
    3347             :                 real(RK), intent(in) :: x
    3348             :                 real(RK)             :: getCDF
    3349             :             end function getCDF
    3350             :         end interface
    3351             : 
    3352           1 :         call sortAscending(np,Point,Err)
    3353           1 :         if (Err%occurred) then
    3354             :         ! LCOV_EXCL_START
    3355             :             Err%msg = PROCEDURE_NAME//Err%msg
    3356             :             return
    3357             :         end if
    3358             :         ! LCOV_EXCL_STOP
    3359             : 
    3360           1 :         statKS = 0._RK
    3361           1 :         cdfObserved = 0._RK
    3362           1 :         npSqrt = np
    3363          51 :         do j = 1,np
    3364          50 :             frac = j/npSqrt
    3365          50 :             cdf = getCDF(Point(j))
    3366          50 :             dt = max( abs(cdfObserved-cdf) , abs(frac-cdf) )
    3367          50 :             if( dt > statKS ) statKS = dt
    3368          51 :             cdfObserved = frac
    3369             :         end do
    3370           1 :         npSqrt = sqrt(npSqrt)
    3371           1 :         probKS = getProbKS( (npSqrt+0.12_RK+0.11_RK/npSqrt)*statKS )
    3372             : 
    3373           1 :     end subroutine doKS1
    3374             : 
    3375             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    3376             : 
    3377             :     !> \brief
    3378             :     !> Return the one-sample Kolmogorov–Smirnov (KS) test results for the assumption that the
    3379             :     !> points originate from a uniform distribution in [0,1]. So, all Point must be in [0,1] on input.
    3380             :     !>
    3381             :     !> \param[in]       np      :   The number of points in the input vector `Point`.
    3382             :     !> \param[inout]    Point   :   The sample. On return, this array will be sorted in Ascending order.
    3383             :     !> \param[out]      statKS  :   The KS test statistic.
    3384             :     !> \param[out]      probKS  :   The `p`-value of the test, returned as a scalar value in the range `[0,1]`.
    3385             :     !>                              The output `probKS` is the probability of observing a test statistic as extreme as,
    3386             :     !>                              or more extreme than, the observed value under the null hypothesis.
    3387             :     !>                              Small values of `probKS` cast doubt on the validity of the null hypothesis.
    3388             :     !> \param[out]      Err     :   An object of class [Err_type](@ref err_mod::err_type) containing information
    3389             :     !>                              about the occurrence of any error during the KS test computation.
    3390             :     !>
    3391             :     !> \author
    3392             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    3393           1 :     pure subroutine doUniformKS1(np,Point,statKS,probKS,Err)
    3394             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    3395             :         !DEC$ ATTRIBUTES DLLEXPORT :: doUniformKS1
    3396             : #endif
    3397           1 :         use Sort_mod, only : sortAscending
    3398             :         use Err_mod, only: Err_type
    3399             : 
    3400             :         implicit none
    3401             : 
    3402             :         integer(IK)     , intent(in)    :: np
    3403             :         real(RK)        , intent(out)   :: statKS,probKS
    3404             :         real(RK)        , intent(inout) :: Point(np)
    3405             :         type(Err_type)  , intent(out)   :: Err
    3406             : 
    3407             :         character(*)    , parameter     :: PROCEDURE_NAME = MODULE_NAME//"@doUniformKS1"
    3408           1 :         real(RK)                        :: npSqrt
    3409           1 :         real(RK)                        :: cdf,cdfObserved,dt,frac
    3410             :         integer(IK)                     :: j
    3411             : 
    3412           1 :         call sortAscending(np,Point,Err)
    3413           1 :         if (Err%occurred) then
    3414             :             ! LCOV_EXCL_START
    3415             :             Err%msg = PROCEDURE_NAME//Err%msg
    3416             :             return
    3417             :             ! LCOV_EXCL_STOP
    3418             :         end if
    3419             : 
    3420           1 :         statKS = 0._RK
    3421           1 :         cdfObserved = 0._RK
    3422           1 :         npSqrt = np
    3423          51 :         do j = 1,np
    3424          50 :             frac = j/npSqrt
    3425          50 :             cdf = Point(j)
    3426          50 :             dt = max( abs(cdfObserved-cdf) , abs(frac-cdf) )
    3427          50 :             if( dt > statKS ) statKS = dt
    3428          51 :             cdfObserved = frac
    3429             :         end do
    3430           1 :         npSqrt = sqrt(npSqrt)
    3431           1 :         probKS = getProbKS( (npSqrt+0.12_RK+0.11_RK/npSqrt)*statKS )
    3432           1 :     end subroutine doUniformKS1
    3433             : 
    3434             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    3435             : 
    3436             :     !> \brief
    3437             :     !> Return the two-sample Kolmogorov–Smirnov (KS) test results under the assumption that the
    3438             :     !> points originate from the same distribution. It is assumed that the two input arrays are sorted ascending on input.
    3439             :     !>
    3440             :     !> \param[in]       np1             :   The number of points in the input vector `SortedPoint1`.
    3441             :     !> \param[in]       np2             :   The number of points in the input vector `SortedPoint2`.
    3442             :     !> \param[inout]    SortedPoint1    :   The first input sorted sample. On input, it must be sorted in ascending-order.
    3443             :     !> \param[inout]    SortedPoint2    :   The second input sorted sample. On input, it must be sorted in ascending-order.
    3444             :     !> \param[out]      statKS          :   The KS test statistic.
    3445             :     !> \param[out]      probKS          :   The `p`-value of the test, returned as a scalar value in the range `[0,1]`.
    3446             :     !>                                      The output `probKS` is the probability of observing a test statistic as extreme as,
    3447             :     !>                                      or more extreme than, the observed value under the null hypothesis.
    3448             :     !>                                      Small values of `probKS` cast doubt on the validity of the null hypothesis.
    3449             :     !>
    3450             :     !> \author
    3451             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    3452           1 :     subroutine doSortedKS2(np1,np2,SortedPoint1,SortedPoint2,statKS,probKS)
    3453             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    3454             :         !DEC$ ATTRIBUTES DLLEXPORT :: doSortedKS2
    3455             : #endif
    3456             :         integer(IK) , intent(in)    :: np1, np2
    3457             :         real(RK)    , intent(in)    :: SortedPoint1(np1), SortedPoint2(np2)
    3458             :         real(RK)    , intent(out)   :: statKS, probKS
    3459           1 :         real(RK)                    :: dummy1,dummy2,dt,np1_RK,np2_RK,npEffective,cdf1,cdf2
    3460             :         integer(IK)                 :: j1,j2
    3461           1 :         np1_RK = np1
    3462           1 :         np2_RK = np2
    3463           1 :         j1 = 1_IK
    3464           1 :         j2 = 1_IK
    3465           1 :         cdf1 = 0._RK
    3466           1 :         cdf2 = 0._RK
    3467           1 :         statKS = 0._RK
    3468          97 :         do
    3469          98 :             if ( j1<=np1 .and. j2<=np2 )then
    3470          97 :                 dummy1 = SortedPoint1(j1)
    3471          97 :                 dummy2 = SortedPoint2(j2)
    3472          97 :                 if( dummy1 <= dummy2 ) then
    3473          47 :                   cdf1 = j1 / np1_RK
    3474          47 :                   j1 = j1 + 1
    3475             :                 endif
    3476          97 :                 if( dummy2 <= dummy1 ) then
    3477          50 :                   cdf2 = j2 / np2_RK
    3478          50 :                   j2 = j2 + 1_IK
    3479             :                 endif
    3480          97 :                 dt = abs(cdf2-cdf1)
    3481          97 :                 if (dt>statKS) statKS = dt
    3482          97 :                 cycle
    3483             :             end if
    3484           1 :             exit
    3485             :         end do
    3486           1 :         npEffective = sqrt( np1_RK * np2_RK / ( np1_RK + np2_RK ) )
    3487           1 :         probKS = getProbKS( ( npEffective + 0.12_RK + 0.11_RK / npEffective ) * statKS )
    3488           1 :     end subroutine doSortedKS2
    3489             : 
    3490             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    3491             : 
    3492             :     !> \brief
    3493             :     !> Return the Kolmogorov–Smirnov (KS) probability.
    3494             :     !>
    3495             :     !> \author
    3496             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    3497           3 :     pure function getProbKS(lambda) result(probKS)
    3498             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    3499             :         !DEC$ ATTRIBUTES DLLEXPORT :: getProbKS
    3500             : #endif
    3501             :         implicit none
    3502             :         real(RK)   , intent(in) :: lambda
    3503             :         real(RK)   , parameter  :: EPS1 = 0.001_RK, EPS2 = 1.e-8_RK
    3504             :         integer(IK), parameter  :: NITER = 100
    3505             :         integer(IK)             :: j
    3506           3 :         real(RK)                :: a2,fac,term,termbf
    3507             :         real(RK)                :: probKS
    3508           3 :         a2 = -2._RK*lambda**2
    3509           3 :         fac = 2._RK
    3510           3 :         probKS = 0._RK
    3511           3 :         termbf = 0._RK
    3512           6 :         do j = 1, NITER
    3513           6 :             term = fac*exp(a2*j**2)
    3514           6 :             probKS = probKS+term
    3515           6 :             if (abs(term) <= EPS1*termbf .or. abs(term) <= EPS2*probKS) return
    3516           3 :             fac = -fac
    3517           3 :             termbf = abs(term)
    3518             :         end do
    3519           0 :         probKS = 1._RK
    3520           4 :     end function getProbKS
    3521             : 
    3522             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    3523             : 
    3524             :     !> \brief
    3525             :     !> Returns the uniform CDF on support [0,1). This is rather redundant, aint it? but sometimes, needed.
    3526             :     !>
    3527             :     !> \param[in] x : The point at which the CDF must be computed.
    3528             :     !>
    3529             :     !> \author
    3530             :     !> Amir Shahmoradi, Monday March 6, 2017, 3:22 pm, ICES, The University of Texas at Austin.
    3531           1 :     pure function getUniformCDF(x)
    3532             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    3533             :         !DEC$ ATTRIBUTES DLLEXPORT :: getUniformCDF
    3534             : #endif
    3535             :         implicit none
    3536             :         real(RK), intent(in) :: x
    3537             :         real(RK)             :: getUniformCDF
    3538           1 :         getUniformCDF = x
    3539           3 :     end function getUniformCDF
    3540             : 
    3541             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    3542             : 
    3543             :     !> \brief
    3544             :     !> Return the 1-D histogram (Density plot) of the input vector `X`.
    3545             :     !> The number of bins in the `X` range (`nxbin`) is determined by the user.
    3546             :     !> The range of `X`, `[xmin, xmax]`, should be also given by the user.
    3547             :     !> The program returns two arrays of `Xbin` and `Density(x)` as output.
    3548             :     !>
    3549             :     !> \param[in]       method          :   The method by which the hist count should be returned:
    3550             :     !>                                      + `"pdf"`   : Return the probability density function histogram.
    3551             :     !>                                      + `"count"` : Return the count histogram.
    3552             :     !> \param[in]       xmin            :   The minimum of the histogram binning.
    3553             :     !> \param[in]       xmax            :   The maximum of the histogram binning.
    3554             :     !> \param[in]       nxbin           :   The number of histogram bins.
    3555             :     !> \param[in]       np              :   The length of input vector `X`.
    3556             :     !> \param[in]       X               :   The vector of length `nxbin` of values to be binned.
    3557             :     !> \param[out]      Xbin            :   The vector of length `nxbin` of values representing the bin left corners.
    3558             :     !> \param[out]      Density         :   The vector of length `nxbin` of values representing the densities in each bin.
    3559             :     !> \param[out]      errorOccurred   :   The logical output flag indicating whether error has occurred.
    3560             :     !>
    3561             :     !> \author
    3562             :     !> Amir Shahmoradi, Sep 1, 2017, 12:30 AM, ICES, UT Austin
    3563           3 :     subroutine getHist1D(method, xmin, xmax, nxbin, np, X, Xbin, Density, errorOccurred)
    3564             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    3565             :         !DEC$ ATTRIBUTES DLLEXPORT :: getHist1D
    3566             : #endif
    3567             :         implicit none
    3568             :         character(*), intent(in)  :: method
    3569             :         integer(IK) , intent(in)  :: np,nxbin
    3570             :         real(RK)    , intent(in)  :: xmin,xmax
    3571             :         real(RK)    , intent(in)  :: X(np)
    3572             :         real(RK)    , intent(out) :: Xbin(nxbin), Density(nxbin)
    3573             :         logical     , intent(out) :: errorOccurred
    3574           3 :         real(RK)                  :: xbinsize
    3575             :         integer(IK)               :: i, ip, thisXbin, npEffective
    3576             : 
    3577           3 :         xbinsize = (xmax-xmin) / real(nxbin,kind=RK)
    3578          63 :         Xbin = [ (xmin + real(i-1,kind=RK)*xbinsize,i=1,nxbin) ]
    3579             : 
    3580          33 :         Density = 0._RK
    3581           3 :         npEffective = 0_IK
    3582         153 :         do ip = 1, np
    3583         153 :             if (X(ip)>=xmin .and. X(ip)<xmax) then
    3584         150 :                 npEffective = npEffective + 1_IK
    3585         150 :                 thisXbin = getBin(X(ip),xmin,nxbin,xbinsize)
    3586         150 :                 Density(thisXbin) = Density(thisXbin) + 1._RK
    3587             :             end if
    3588             :         end do
    3589             : 
    3590          33 :         Xbin = Xbin + 0.5_RK * xbinsize
    3591             : 
    3592           3 :         if(method=="count") then
    3593           1 :             errorOccurred = .false.
    3594           1 :             return
    3595           2 :         elseif(method=="pdf") then
    3596          11 :             Density = Density / real(npEffective,kind=RK)
    3597           1 :             errorOccurred = .false.
    3598             :         else
    3599           1 :             errorOccurred = .true.
    3600             :         end if
    3601             : 
    3602           4 :     end subroutine getHist1D
    3603             : 
    3604             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    3605             : 
    3606             :     !> \brief
    3607             :     !> Return the 2-D histogram (Density plot) of a set of data points with (X,Y) coordinates.
    3608             :     !> The number of bins in the `X` and `Y` directions (`[nxbin, nybin]`) are determined by the user.
    3609             :     !> The range of `X` and `Y` (`xmin`,`xmax`,`ymin`,`ymax`) should also be given by the user.
    3610             :     !> The program returns three arrays of `Xbin`, `Ybin`, and `Density(y,x)` as the output.
    3611             :     !>
    3612             :     !> \param[in]       histType        :   The method by which the normalization of the histogram counts should be done:
    3613             :     !>                                      + `"count"`     : Return the count histogram.
    3614             :     !>                                      + `"pdf"`       : Return the probability density function (PDF) histogram.
    3615             :     !>                                      + `"pdf(y|x)"`  : Return the conditional PDF of `y` given `x` histogram.
    3616             :     !>                                      + `"pdf(x|y)"`  : Return the conditional PDF of `x` given `y` histogram.
    3617             :     !> \param[in]       xmin            :   The minimum of the histogram binning along the x-axis.
    3618             :     !> \param[in]       xmax            :   The maximum of the histogram binning along the x-axis.
    3619             :     !> \param[in]       ymin            :   The minimum of the histogram binning along the y-axis.
    3620             :     !> \param[in]       ymax            :   The maximum of the histogram binning along the y-axis.
    3621             :     !> \param[in]       nxbin           :   The number of histogram bins along the x-axis.
    3622             :     !> \param[in]       nybin           :   The number of histogram bins along the y-axis.
    3623             :     !> \param[in]       np              :   The length of input vector `X`.
    3624             :     !> \param[in]       X               :   The vector of length `nxbin` of values to be binned.
    3625             :     !> \param[in]       Y               :   The vector of length `nybin` of values to be binned.
    3626             :     !> \param[out]      Xbin            :   The vector of length `nxbin` of values representing the bin centers.
    3627             :     !> \param[out]      Ybin            :   The vector of length `nybin` of values representing the bin centers.
    3628             :     !> \param[out]      Density         :   The array of shape `(nybin,nxbin)` of values representing the densities per bin.
    3629             :     !> \param[out]      errorOccurred   :   A logical output value indicating whether an error has occurred.
    3630             :     !>
    3631             :     !> \author
    3632             :     !> Amir Shahmoradi, Sep 1, 2017, 12:00 AM, ICES, UT Austin
    3633           5 :     subroutine getHist2D(histType,xmin,xmax,ymin,ymax,nxbin,nybin,np,X,Y,Xbin,Ybin,Density,errorOccurred)
    3634             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    3635             :         !DEC$ ATTRIBUTES DLLEXPORT :: getHist2D
    3636             : #endif
    3637             :         !use, intrinsic :: iso_fortran_env, only: output_unit
    3638           3 :         use String_mod, only: getLowerCase
    3639             :         implicit none
    3640             :         character(*), intent(in)  :: histType
    3641             :         integer(IK) , intent(in)  :: np,nxbin,nybin
    3642             :         real(RK)    , intent(in)  :: xmin,xmax,ymin,ymax
    3643             :         real(RK)    , intent(in)  :: X(np),Y(np)
    3644             :         real(RK)    , intent(out) :: Xbin(nxbin),Ybin(nybin),Density(nybin,nxbin)
    3645             :         logical     , intent(out) :: errorOccurred
    3646           5 :         character(:), allocatable :: method
    3647           5 :         real(RK)                  :: xbinsize,ybinsize
    3648             :         integer(IK)               :: i, ip, thisXbin, thisYbin, npEffective
    3649             : 
    3650           5 :         errorOccurred = .false.
    3651             : 
    3652           5 :         xbinsize = (xmax-xmin) / real(nxbin,kind=RK)
    3653           5 :         ybinsize = (ymax-ymin) / real(nybin,kind=RK)
    3654          85 :         Xbin = [ (xmin+real(i-1,kind=RK)*xbinsize,i=1,nxbin) ]
    3655          75 :         Ybin = [ (ymin+real(i-1,kind=RK)*ybinsize,i=1,nybin) ]
    3656             : 
    3657         325 :         Density = 0._RK
    3658           5 :         npEffective = 0_IK
    3659         255 :         do ip = 1,np
    3660         255 :             if (X(ip)>=xmin .and. X(ip)<xmax .and. Y(ip)>=ymin .and. Y(ip)<ymax) then
    3661         250 :                 npEffective = npEffective + 1_IK
    3662         250 :                 thisXbin = getBin(X(ip),xmin,nxbin,xbinsize)
    3663         250 :                 thisYbin = getBin(Y(ip),ymin,nybin,ybinsize)
    3664         250 :                 Density(thisYbin,thisXbin) = Density(thisYbin,thisXbin) + 1._RK
    3665             :             end if
    3666             :         end do
    3667             : 
    3668          45 :         Xbin = Xbin + 0.5_RK * xbinsize
    3669          40 :         Ybin = Ybin + 0.5_RK * ybinsize
    3670           5 :         method = getLowerCase(trim(adjustl(histType)))
    3671           5 :         if(method=="pdf") then
    3672          65 :             Density = Density / real(npEffective,kind=RK)
    3673           4 :         elseif(method=="pdf(y|x)") then
    3674           9 :             do i = 1,nxbin
    3675         121 :                 Density(1:nybin,i) = Density(1:nybin,i) / sum(Density(1:nybin,i))
    3676             :             end do
    3677           3 :         elseif(method=="pdf(x|y)") then
    3678           8 :             do i = 1,nybin
    3679         120 :                 Density(i,1:nxbin) = Density(i,1:nxbin) / sum(Density(i,1:nxbin))
    3680             :             end do
    3681           2 :         elseif(method=="count") then
    3682           1 :             return
    3683             :         else
    3684           1 :             errorOccurred = .true.
    3685             :         end if
    3686             : 
    3687           5 :     end subroutine getHist2D
    3688             : 
    3689             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    3690             : 
    3691             :     !> \brief
    3692             :     !> Given the range of the variable `x`, `xmin:xmin+binsize*nbin`, and the number of bins, `nbin`, with which
    3693             :     !> this range is divided, find which bin the input value `x` falls among `[1:nbin]` bins.
    3694             :     !> The output `ibin` is the number that identifies the bin.
    3695             :     !>
    3696             :     !> \param[in]       x               :   The input value whose bin ID is to be found.
    3697             :     !> \param[in]       lowerBound      :   The lower limit on the value of `x`.
    3698             :     !> \param[in]       nbin            :   The number of bins to be considered starting from `lowerBound`.
    3699             :     !> \param[in]       binsize         :   The size of the bins. It must be exactly `(xmax - xmin) / nbin`.
    3700             :     !>
    3701             :     !> \return
    3702             :     !> `ibin` : The ID of the bin to which the input value `x` belongs.
    3703             :     !>
    3704             :     !> \warning
    3705             :     !> If `x <= xmin` or `x xmin + nbin * binsize`, then `ibin = -1` will be returned to indicate error.
    3706             :     !>
    3707             :     !> \remark
    3708             :     !> If `bmin < x <= bmax` then `x` belongs to this bin.
    3709             :     !>
    3710             :     !> \todo
    3711             :     !> The performance and interface of this routine can be significantly improved.
    3712             :     !> It is more sensible to pass a contiguous array of bin edges as input instead of `lowerBound` and `binsize`.
    3713             :     !> If the input point is not within any bins, an index of zero should be returned.
    3714             :     !>
    3715             :     !> \author
    3716             :     !> Version 3.0, Sep 1, 2017, 11:12 AM, Amir Shahmoradi, ICES, The University of Texas at Austin.
    3717         650 :     pure function getBin(x,lowerBound,nbin,binsize) result(ibin)
    3718             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    3719             :         !DEC$ ATTRIBUTES DLLEXPORT :: getBin
    3720             : #endif
    3721             : 
    3722             :         implicit none
    3723             :         integer(IK), intent(in) :: nbin
    3724             :         real(RK)   , intent(in) :: x,lowerBound,binsize
    3725         650 :         real(RK)                :: xmin,xmid
    3726             :         integer(IK)             :: ibin,minbin,midbin,maxbin
    3727             : 
    3728         650 :         if (x<lowerBound .or. x>=lowerBound+nbin*binsize) then
    3729             :             ! LCOV_EXCL_START
    3730             :             ibin = -1_IK
    3731             :             return
    3732             :             ! LCOV_EXCL_STOP
    3733             :         end if
    3734             : 
    3735         650 :         minbin = 1
    3736         650 :         maxbin = nbin
    3737         650 :         xmin = lowerBound
    3738        1849 :         loopFindBin: do
    3739        2499 :             midbin = (minbin+maxbin) / 2
    3740        2499 :             xmid = xmin + midbin*binsize
    3741        2499 :             if (x<xmid) then
    3742        1007 :                 if (minbin==midbin) then
    3743          18 :                     ibin = minbin
    3744          18 :                     exit loopFindBin
    3745             :                 end if
    3746         989 :                 maxbin = midbin
    3747         989 :                 cycle loopFindBin
    3748             :             else
    3749        1492 :                 if (minbin==midbin) then
    3750         632 :                     ibin = maxbin
    3751         632 :                     exit loopFindBin
    3752             :                 end if
    3753         860 :                 minbin = midbin
    3754         860 :                 cycle loopFindBin
    3755             :             end if
    3756             :         end do loopFindBin
    3757             : 
    3758         655 :     end function getBin
    3759             : 
    3760             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    3761             : 
    3762             :     !> \brief
    3763             :     !> Return the quantiles of an input sample of points, given the input quantile probabilities.
    3764             :     !>
    3765             :     !> \param[in]       np                          :   The number of points in the input sample.
    3766             :     !> \param[in]       nq                          :   The number of output quantiles.
    3767             :     !> \param[in]       SortedQuantileProbability   :   A sorted ascending-order vector of probabilities at which the quantiles will be returned.
    3768             :     !> \param[in]       Point                       :   The vector of length `np` representing the input sample.
    3769             :     !> \param[in]       Weight                      :   The vector of length `np` representing the weights of the points in the input sample.
    3770             :     !> \param[in]       sumWeight                   :   The sum of the vector weights of the points: `sum(Weight)`.
    3771             :     !>
    3772             :     !> \return
    3773             :     !> `Quantile` : The output vector of length `nq`, representing the quantiles corresponding to the input `SortedQuantileProbability` probabilities.
    3774             :     !>
    3775             :     !> \author
    3776             :     !> Amir Shahmoradi, Sep 1, 2017, 12:00 AM, ICES, UT Austin
    3777        9151 :     pure function getQuantile(np,nq,SortedQuantileProbability,Point,Weight,sumWeight) result(Quantile)
    3778             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
    3779             :         !DEC$ ATTRIBUTES DLLEXPORT :: getQuantile
    3780             : #endif
    3781         650 :         use Constants_mod, only: IK, RK, NEGINF_RK
    3782             :         use Sort_mod, only: indexArray
    3783             :         use Err_mod, only: Err_type
    3784             :         implicit none
    3785             :         integer(IK) , intent(in)            :: np, nq
    3786             :         real(RK)    , intent(in)            :: SortedQuantileProbability(nq), Point(np)
    3787             :         integer(IK) , intent(in), optional  :: Weight(np), sumWeight
    3788             :         real(RK)                            :: Quantile(nq)
    3789        1408 :         integer(IK)                         :: ip, iq, iw, weightCounter, Indx(np), SortedQuantileDensity(nq)
    3790         704 :         type(Err_type)                      :: Err
    3791         704 :         call indexArray(np,Point,Indx,Err)
    3792         704 :         if (Err%occurred) then
    3793             :             ! LCOV_EXCL_START
    3794             :             Quantile = NEGINF_RK
    3795             :             return
    3796             :             ! LCOV_EXCL_STOP
    3797             :         end if
    3798         704 :         iq = 1_IK
    3799         704 :         if (present(sumWeight)) then
    3800         703 :             weightCounter = 0_IK
    3801        7030 :             SortedQuantileDensity = nint( SortedQuantileProbability * sumWeight )
    3802      176650 :             loopWeighted: do ip = 1, np
    3803      637896 :                 do iw = 1, Weight(Indx(ip))
    3804      461920 :                     weightCounter = weightCounter + 1_IK
    3805      637867 :                     if (weightCounter>=SortedQuantileDensity(iq)) then
    3806        6260 :                         Quantile(iq) = Point(Indx(ip))
    3807        6260 :                         iq = iq + 1_IK
    3808        6260 :                         if (iq>nq) exit loopWeighted
    3809             :                     end if
    3810             :                 end do
    3811             :             end do loopWeighted
    3812             :         else
    3813          10 :             SortedQuantileDensity = nint( SortedQuantileProbability * np )
    3814          50 :             loopNonWeighted: do ip = 1, np
    3815          50 :                 if (ip>=SortedQuantileDensity(iq)) then
    3816           9 :                     Quantile(iq) = Point(Indx(ip))
    3817           9 :                     iq = iq + 1_IK
    3818           9 :                     if (iq>nq) exit loopNonWeighted
    3819             :                 end if
    3820             :             end do loopNonWeighted
    3821             :         end if
    3822         771 :         if (iq<=nq) Quantile(iq:nq) = Point(Indx(np))
    3823        2112 :     end function getQuantile
    3824             : 
    3825             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    3826             : 
    3827             : end module Statistics_mod ! LCOV_EXCL_LINE

ParaMonte: Plain Powerful Parallel Monte Carlo Library 
The Computational Data Science Lab
© Copyright 2012 - 2021