The ParaMonte Documentation Website
Current view: top level - kernel - Misc_mod.f90 (source / functions) Hit Total Coverage
Test: ParaMonte 1.5.1 :: MPI Parallel Kernel - Code Coverage Report Lines: 166 166 100.0 %
Date: 2021-01-08 13:07:16 Functions: 19 19 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 miscellaneous procedures.
      44             : !>  \author Amir Shahmoradi
      45             : 
      46             : module Misc_mod
      47             : 
      48             :     use, intrinsic :: iso_fortran_env, only: int32
      49             :     implicit none
      50             : 
      51             :     character(*), parameter :: MODULE_NAME = "@Misc_mod"
      52             : 
      53             :     integer(int32), PARAMETER :: NPAR_ARTH = 16_int32, NPAR2_ARTH = 8_int32
      54             : 
      55             :     interface copyArray
      56             :         module procedure :: copyArray_IK, copyArray_RK
      57             :     end interface copyArray
      58             : 
      59             :     interface arth
      60             :         module procedure :: arth_RK, arth_IK
      61             :     end interface arth
      62             : 
      63             :     interface swap
      64             :         !module procedure :: swap_CK, swap_RK, swap_IK    !, swap_vec_RK
      65             :         module procedure :: swap_SPI, swap_DPI, swap_SPR, swap_DPR, swap_SPC, swap_DPC  ! , swap_cm, swap_z, swap_rv, swap_cv
      66             :         module procedure :: masked_swap_SPR, masked_swap_SPRV, masked_swap_SPRM         ! swap_zv, swap_zm
      67             :     end interface swap
      68             : 
      69             :     interface findUnique
      70             :         module procedure :: findUnique_IK
      71             :     end interface findUnique
      72             : 
      73             :     interface resize
      74             :         module procedure :: resizeVector_RK
      75             :     end interface resize
      76             : 
      77             :     interface resizeVector
      78             :         module procedure :: resizeVector_RK
      79             :     end interface resizeVector
      80             : 
      81             :     !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      82             : 
      83             : contains
      84             : 
      85             :     !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      86             : 
      87           9 :     pure elemental subroutine swap_CK(a,b)
      88             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
      89             :         !DEC$ ATTRIBUTES DLLEXPORT :: swap_CK
      90             : #endif
      91             :         use Constants_mod, only: CK
      92             :         implicit none
      93             :         complex(CK), intent(inout)  :: a,b
      94             :         complex(CK)                 :: dummy
      95           9 :         dummy = a
      96           9 :         a = b
      97           9 :         b = dummy
      98           9 :     end subroutine swap_CK
      99             : 
     100           9 :     pure elemental subroutine swap_RK(a,b)
     101             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     102             :         !DEC$ ATTRIBUTES DLLEXPORT :: swap_RK
     103             : #endif
     104           9 :         use Constants_mod, only: RK
     105             :         implicit none
     106             :         real(RK), intent(inout) :: a,b
     107           9 :         real(RK)                :: dummy
     108           9 :         dummy = a
     109           9 :         a = b
     110           9 :         b = dummy
     111           9 :     end subroutine swap_RK
     112             : 
     113           9 :     pure elemental subroutine swap_IK(a,b)
     114             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     115             :         !DEC$ ATTRIBUTES DLLEXPORT :: swap_IK
     116             : #endif
     117           9 :         use Constants_mod, only: IK
     118             :         implicit none
     119             :         integer(IK), intent(inout) :: a,b
     120             :         integer(IK)                :: dummy
     121           9 :         dummy = a
     122           9 :         a = b
     123           9 :         b = dummy
     124           9 :     end subroutine swap_IK
     125             : 
     126             :     !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     127             : 
     128      287692 :     pure elemental subroutine swap_SPI(a,b)
     129             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     130             :         !DEC$ ATTRIBUTES DLLEXPORT :: swap_SPI
     131             : #endif
     132           9 :         use Constants_mod, only: SPI
     133             :         implicit none
     134             :         integer(SPI), intent(inout) :: a,b
     135             :         integer(SPI) :: dum
     136      287692 :         dum=a
     137      287692 :         a=b
     138      287692 :         b=dum
     139      287692 :     end subroutine swap_SPI
     140             : 
     141           9 :     pure elemental subroutine swap_DPI(a,b)
     142             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     143             :         !DEC$ ATTRIBUTES DLLEXPORT :: swap_DPI
     144             : #endif
     145      287692 :         use Constants_mod, only: DPI
     146             :         implicit none
     147             :         integer(DPI), intent(inout) :: a,b
     148             :         integer(DPI) :: dum
     149           9 :         dum=a
     150           9 :         a=b
     151           9 :         b=dum
     152           9 :     end subroutine swap_DPI
     153             : 
     154           9 :     pure elemental subroutine swap_SPR(a,b)
     155             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     156             :         !DEC$ ATTRIBUTES DLLEXPORT :: swap_SPR
     157             : #endif
     158           9 :         use Constants_mod, only: SPR
     159             :         implicit none
     160             :         real(SPR), intent(inout) :: a,b
     161           9 :         real(SPR) :: dum
     162           9 :         dum=a
     163           9 :         a=b
     164           9 :         b=dum
     165           9 :     end subroutine swap_SPR
     166             : 
     167     1566990 :     pure elemental subroutine swap_DPR(a,b)
     168             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     169             :         !DEC$ ATTRIBUTES DLLEXPORT :: swap_DPR
     170             : #endif
     171           9 :         use Constants_mod, only: DPR
     172             :         implicit none
     173             :         real(DPR), intent(inout) :: a,b
     174     1566990 :         real(DPR) :: dum
     175     1566990 :         dum=a
     176     1566990 :         a=b
     177     1566990 :         b=dum
     178     1566990 :     end subroutine swap_DPR
     179             : 
     180             :     !pure subroutine swap_rv(a,b)
     181             :     !    use Constants_mod, only: SPR
     182             :     !    implicit none
     183             :     !    real(SPR), dimension(:), intent(inout) :: a,b
     184             :     !    real(SPR), dimension(size(a)) :: dum
     185             :     !    dum=a
     186             :     !    a=b
     187             :     !    b=dum
     188             :     !end subroutine swap_rv
     189             : 
     190           9 :     pure elemental subroutine swap_SPC(a,b)
     191             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     192             :         !DEC$ ATTRIBUTES DLLEXPORT :: swap_SPC
     193             : #endif
     194     1566990 :         use Constants_mod, only: SPC
     195             :         implicit none
     196             :         complex(SPC), intent(inout) :: a,b
     197           9 :         complex(SPC) :: dum
     198           9 :         dum=a
     199           9 :         a=b
     200           9 :         b=dum
     201           9 :     end subroutine swap_SPC
     202             : 
     203     4385820 :     pure elemental subroutine swap_DPC(a,b)
     204             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     205             :         !DEC$ ATTRIBUTES DLLEXPORT :: swap_DPC
     206             : #endif
     207           9 :         use Constants_mod, only: DPC
     208             :         implicit none
     209             :         complex(DPC), intent(inout) :: a,b
     210             :         complex(DPC) :: dum
     211     4385820 :         dum=a
     212     4385820 :         a=b
     213     4385820 :         b=dum
     214     4385820 :     end subroutine swap_DPC
     215             : 
     216             :     !pure subroutine swap_cv(a,b)
     217             :     !    use Constants_mod, only: SPC
     218             :     !    implicit none
     219             :     !    complex(SPC), dimension(:), intent(inout) :: a,b
     220             :     !    complex(SPC), dimension(size(a)) :: dum
     221             :     !    dum=a
     222             :     !    a=b
     223             :     !    b=dum
     224             :     !end subroutine swap_cv
     225             : 
     226             :     !pure subroutine swap_cm(a,b)
     227             :     !    use Constants_mod, only: SPC
     228             :     !    implicit none
     229             :     !    complex(SPC), dimension(:,:), intent(inout) :: a,b
     230             :     !    complex(SPC), dimension(size(a,1),size(a,2)) :: dum
     231             :     !    dum=a
     232             :     !    a=b
     233             :     !    b=dum
     234             :     !end subroutine swap_cm
     235             : 
     236             :     !pure subroutine swap_z(a,b)
     237             :     !    use Constants_mod, only: DPC
     238             :     !    implicit none
     239             :     !    complex(DPC), intent(inout) :: a,b
     240             :     !    complex(DPC) :: dum
     241             :     !    dum=a
     242             :     !    a=b
     243             :     !    b=dum
     244             :     !end subroutine swap_z
     245             : 
     246             :     !pure subroutine swap_zv(a,b)
     247             :     !    use Constants_mod, only: DPC
     248             :     !    implicit none
     249             :     !    complex(DPC), dimension(:), intent(inout) :: a,b
     250             :     !    complex(DPC), dimension(size(a)) :: dum
     251             :     !    dum=a
     252             :     !    a=b
     253             :     !    b=dum
     254             :     !end subroutine swap_zv
     255             : 
     256             :     !pure subroutine swap_zm(a,b)
     257             :     !    use Constants_mod, only: DPC
     258             :     !    implicit none
     259             :     !    complex(DPC), dimension(:,:), intent(inout) :: a,b
     260             :     !    complex(DPC), dimension(size(a,1),size(a,2)) :: dum
     261             :     !    dum=a
     262             :     !    a=b
     263             :     !    b=dum
     264             :     !end subroutine swap_zm
     265             : 
     266           6 :     pure subroutine masked_swap_SPR(a,b,mask)
     267             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     268             :         !DEC$ ATTRIBUTES DLLEXPORT :: masked_swap_SPR
     269             : #endif
     270     4385820 :         use Constants_mod, only: SPR
     271             :         implicit none
     272             :         real(SPR), intent(inout) :: a,b
     273             :         logical, intent(in) :: mask
     274           6 :         real(SPR) :: swp
     275           6 :         if (mask) then
     276           3 :             swp=a
     277           3 :             a=b
     278           3 :             b=swp
     279             :         end if
     280           6 :     end subroutine masked_swap_SPR
     281             : 
     282           6 :     pure subroutine masked_swap_SPRV(a,b,mask)
     283             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     284             :         !DEC$ ATTRIBUTES DLLEXPORT :: masked_swap_SPRV
     285             : #endif
     286           6 :         use Constants_mod, only: SPR
     287             :         implicit none
     288             :         real(SPR), dimension(:), intent(inout) :: a,b
     289             :         logical, dimension(:), intent(in) :: mask
     290          12 :         real(SPR), dimension(size(a)) :: swp
     291          48 :         where (mask)
     292           3 :             swp=a
     293           3 :             a=b
     294           3 :             b=swp
     295             :         end where
     296           3 :     end subroutine masked_swap_SPRV
     297             : 
     298           6 :     pure subroutine masked_swap_SPRM(a,b,mask)
     299             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     300             :         !DEC$ ATTRIBUTES DLLEXPORT :: masked_swap_SPRM
     301             : #endif
     302           3 :         use Constants_mod, only: SPR
     303             :         implicit none
     304             :         real(SPR), dimension(:,:), intent(inout) :: a,b
     305             :         logical, dimension(:,:), intent(in) :: mask
     306          27 :         real(SPR), dimension(size(a,1),size(a,2)) :: swp
     307         108 :         where (mask)
     308           3 :             swp=a
     309           3 :             a=b
     310           3 :             b=swp
     311             :         end where
     312           3 :     end subroutine masked_swap_SPRM
     313             : 
     314             :     !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     315             : 
     316             :     !> \brief
     317             :     !> Return an arithmetic progression as an array
     318         108 :     pure function arth_RK(first,increment,n) result(arth)
     319             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     320             :         !DEC$ ATTRIBUTES DLLEXPORT :: arth_RK
     321             : #endif
     322           3 :         use Constants_mod, only: IK, RK
     323             :         implicit none
     324             :         real(RK)    , intent(in)    :: first,increment
     325             :         integer(IK) , intent(in)    :: n
     326             :         real(RK)                    :: arth(n)
     327             :         integer(IK)                 :: k,k2
     328           6 :         real(RK)                    :: temp
     329           6 :         if (n > 0) arth(1)=first
     330           6 :         if (n <= NPAR_ARTH) then
     331          30 :             do k = 2,n
     332          30 :                 arth(k) = arth(k-1) + increment
     333             :             end do
     334             :         else
     335          24 :             do k = 2, NPAR2_ARTH
     336          24 :                 arth(k) = arth(k-1) + increment
     337             :             end do
     338           3 :             temp = increment * NPAR2_ARTH
     339           3 :             k = NPAR2_ARTH
     340           6 :             do
     341           9 :                 if (k >= n) exit
     342           6 :                 k2 = k+k
     343          78 :                 arth(k+1:min(k2,n)) = temp + arth(1:min(k,n-k))
     344           6 :                 temp = temp + temp
     345           6 :                 k = k2
     346             :             end do
     347             :         end if
     348           6 :     end function arth_RK
     349             : 
     350             :     !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     351             : 
     352             :     !> \brief
     353             :     !> Return an arithmetic progression as an array.
     354        3468 :     pure function arth_IK(first,increment,n) result(arth)
     355             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     356             :         !DEC$ ATTRIBUTES DLLEXPORT :: arth_IK
     357             : #endif
     358           6 :         use Constants_mod, only: IK, RK
     359             :         implicit none
     360             :         integer(IK) , intent(in)    :: first,increment,n
     361             :         integer(IK)                 :: arth(n)
     362             :         integer(IK)                 :: k,k2,temp
     363        1734 :         if (n > 0) arth(1) = first
     364        1734 :         if (n <= NPAR_ARTH) then
     365        2550 :             do k=2,n
     366        2550 :                 arth(k) = arth(k-1) + increment
     367             :             end do
     368             :         else
     369       11760 :             do k = 2, NPAR2_ARTH
     370       11760 :                 arth(k) = arth(k-1) + increment
     371             :             end do
     372        1470 :             temp = increment * NPAR2_ARTH
     373        1470 :             k = NPAR2_ARTH
     374        4464 :             do
     375        5934 :                 if (k >= n) exit
     376        4464 :                 k2 = k + k
     377      225216 :                 arth(k+1:min(k2,n)) = temp+arth(1:min(k,n-k))
     378        4464 :                 temp = temp + temp
     379        4464 :                 k = k2
     380             :             end do
     381             :         end if
     382        1734 :     end function arth_IK
     383             : 
     384             :     !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     385             : 
     386             :     !> \brief
     387             :     !> Return `nn` consecutive powers of the `n`th root of unity.
     388        3444 :     pure function zroots_unity(n,nn)
     389             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     390             :         !DEC$ ATTRIBUTES DLLEXPORT :: zroots_unity
     391             : #endif
     392        1734 :         use Constants_mod, only: IK, RK, CK, TWOPI
     393             :         implicit none
     394             :         integer(IK), intent(in)  :: n, nn
     395             :         complex(CK)              :: zroots_unity(nn)
     396             :         integer(IK)              :: k
     397        1722 :         real(RK)                 :: theta
     398        1722 :         zroots_unity(1) = 1._RK
     399        1722 :         theta = TWOPI / n
     400        1722 :         k = 1
     401       14421 :         do
     402       16143 :             if (k >= nn) exit
     403       14421 :             zroots_unity(k+1) = cmplx(cos(k*theta),sin(k*theta),kind=RK)
     404     5064820 :             zroots_unity(k+2:min(2*k,nn)) = zroots_unity(k+1) * zroots_unity(2:min(k,nn-k))
     405       14421 :             k = 2 * k
     406             :         end do
     407        1722 :     end function zroots_unity
     408             : 
     409             :     !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     410             : 
     411          12 :     pure subroutine copyArray_IK(Source,Destination,numCopied,numNotCopied)
     412             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     413             :         !DEC$ ATTRIBUTES DLLEXPORT :: copyArray_IK
     414             : #endif
     415        1722 :         use Constants_mod, only: IK
     416             :         implicit none
     417             :         integer(IK), intent(in)     :: Source(:)
     418             :         integer(IK), intent(out)    :: Destination(:)
     419             :         integer(IK), intent(out)    :: numCopied, numNotCopied
     420           6 :         numCopied = min(size(Source),size(Destination))
     421           6 :         numNotCopied = size(Source) - numCopied
     422          36 :         Destination(1:numCopied) = Source(1:numCopied)
     423           6 :     end subroutine copyArray_IK
     424             : 
     425             :     !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     426             : 
     427          12 :     pure subroutine copyArray_RK(Source,Destination,numCopied,numNotCopied)
     428             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     429             :         !DEC$ ATTRIBUTES DLLEXPORT :: copyArray_RK
     430             : #endif
     431           6 :         use Constants_mod, only: IK, RK
     432             :         implicit none
     433             :         real(RK), intent(in)        :: Source(:)
     434             :         real(RK), intent(out)       :: Destination(:)
     435             :         integer(IK), intent(out)    :: numCopied, numNotCopied
     436           6 :         numCopied = min(size(Source),size(Destination))
     437           6 :         numNotCopied = size(Source) - numCopied
     438          36 :         Destination(1:numCopied) = Source(1:numCopied)
     439           6 :     end subroutine copyArray_RK
     440             : 
     441             :     !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     442             : 
     443             :     !> \brief
     444             :     !> Find the unique values in the input integer vector.
     445             :     !>
     446             :     !> @param[in]       lenVector   :   The size of the input square matrix - `nd` by `nd`.
     447             :     !> @param[in]       Vector      :   The input integer vector.
     448             :     !> @param[out]      UniqueValue :   The vector of unique values identified in the input vector.
     449             :     !> @param[out]      UniqueCount :   The counts of each unique value in the input vector.
     450             :     !> @param[out]      lenUnique   :   The length of `UniqueValue`, that is, the total number of unique values.
     451         221 :     pure subroutine findUnique_IK(lenVector, Vector, UniqueValue, UniqueCount, lenUnique)
     452             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     453             :         !DEC$ ATTRIBUTES DLLEXPORT :: findUnique_IK
     454             : #endif
     455           6 :         use Constants_mod, only: IK
     456             :         implicit none
     457             :         integer(IK)     , intent(in)                :: lenVector
     458             :         integer(IK)     , intent(in)                :: Vector(lenVector)
     459             :         integer(IK)     , intent(out), allocatable  :: UniqueValue(:)
     460             :         integer(IK)     , intent(out), allocatable  :: UniqueCount(:)
     461             :         integer(IK)     , intent(out), optional     :: lenUnique
     462             :         integer(IK)                                 :: lenUniq, i, j
     463             :         logical                                     :: isUnique
     464         221 :         allocate(UniqueValue(lenVector))
     465       68562 :         allocate(UniqueCount(lenVector), source = 0_IK)
     466         221 :         lenUniq = 0
     467       68562 :         do i = 1, lenVector
     468       68341 :             isUnique = .true.
     469      108706 :             loopSearchUnique: do j = 1, lenUniq
     470      108706 :                 if (UniqueValue(j)==Vector(i)) then
     471       67658 :                     UniqueCount(j) = UniqueCount(j) + 1
     472       67658 :                     isUnique = .false.
     473       67658 :                     exit loopSearchUnique
     474             :                 end if
     475             :             end do loopSearchUnique
     476       68562 :             if (isUnique) then
     477         683 :                 lenUniq = lenUniq + 1
     478         683 :                 UniqueValue(lenUniq) = Vector(i)
     479         683 :                 UniqueCount(lenUniq) = UniqueCount(lenUniq) + 1
     480             :             end if
     481             :         end do
     482        1590 :         UniqueValue = UniqueValue(1:lenUniq)
     483        1590 :         UniqueCount = UniqueCount(1:lenUniq)
     484         221 :         if (present(lenUnique)) lenUnique = lenUniq
     485         221 :     end subroutine findUnique_IK
     486             : 
     487             :     !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     488             : 
     489             :     !> \brief
     490             :     !> Resize the input 1-dimensional real vector to a new size.
     491             :     !>
     492             :     !> @param[inout]    Vector  :   The input real vector that will be resized on return.
     493             :     !> @param[out]      from    :   The number of elements of `Vector`.
     494             :     !> @param[out]      to      :   The new size of `Vector`.
     495          21 :     pure subroutine resizeVector_RK(Vector, from, to)
     496             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     497             :         !DEC$ ATTRIBUTES DLLEXPORT :: resizeVector_RK
     498             : #endif
     499         221 :         use Constants_mod, only: IK, RK
     500             :         implicit none
     501             :         integer(IK)                 , intent(in)    :: from, to
     502             :         real(RK)    , allocatable   , intent(inout) :: Vector(:)
     503             :         real(RK)    , allocatable                   :: Temp(:)
     504          21 :         allocate(Temp(to))
     505         708 :         Temp(1:from) = Vector
     506          21 :         call move_alloc(Temp, Vector)
     507          21 :     end subroutine resizeVector_RK
     508             : 
     509             :     !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     510             : 
     511             : end module Misc_mod

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