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

          Line data    Source code
       1             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       2             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       3             : !!!!                                                                                                                            !!!!
       4             : !!!!    ParaMonte: Parallel Monte Carlo and Machine Learning Library.                                                           !!!!
       5             : !!!!                                                                                                                            !!!!
       6             : !!!!    Copyright (C) 2012-present, The Computational Data Science Lab                                                          !!!!
       7             : !!!!                                                                                                                            !!!!
       8             : !!!!    This file is part of the ParaMonte library.                                                                             !!!!
       9             : !!!!                                                                                                                            !!!!
      10             : !!!!    LICENSE                                                                                                                 !!!!
      11             : !!!!                                                                                                                            !!!!
      12             : !!!!       https://github.com/cdslaborg/paramonte/blob/main/LICENSE.md                                                          !!!!
      13             : !!!!                                                                                                                            !!!!
      14             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      15             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      16             : 
      17             : !>  \brief
      18             : !>  This include file contains implementations of the procedures in module [pm_mathFactoring](@ref pm_mathFactoring).
      19             : !>
      20             : !>  \finmain
      21             : !>
      22             : !>  \author
      23             : !>  \FatemehBagheri, Sunday 11:23 PM, September 19, 2021, Dallas, TX
      24             : 
      25             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      26             : 
      27             : #if     getFactoring_IK_ENABLED
      28             :         use pm_arrayResize, only: setResized
      29             :         integer(IK)     :: count, csize
      30             :         integer(IKC)    :: halfn, divisor
      31        1495 :         CHECK_ASSERTION(__LINE__, 1_IKC < posint, \
      32             :         SK_"@getFactoring(): The condition `1 < posint` must hold for corresponding input arguments. posint = "//getStr(posint))
      33        1495 :         csize = 15_IK
      34        1495 :         allocate(Factoring(csize))
      35             :         count = 0_IK
      36         912 :         do ! first remove all factors of 2.
      37        2407 :             halfn = posint / 2_IKC
      38        2407 :             if (halfn * 2_IKC /= posint) exit
      39         912 :             count = count + 1_IK
      40         912 :             if (csize < count) then
      41           0 :                 csize = csize * 2_IK
      42           0 :                 call setResized(Factoring, csize)
      43             :             end if
      44         912 :             Factoring(count) = 2_IKC
      45        2104 :             posint = halfn
      46             :         end do
      47             :         ! Find the odd factors.
      48         303 :         divisor = 3_IK
      49      239370 :         do  !   3, 5, 7, .... will be tried. 
      50             :             !   \todo This algorithm can be improved.
      51      240865 :             if (divisor > posint) exit ! If a factor is too large, we are done.
      52        1099 :             do  ! Try the current factor repeatedly, until all is taken out.
      53      240469 :                 if (mod(posint, divisor) /= 0_IKC .or. posint == 1_IKC)  exit
      54        1099 :                 count = count + 1_IK
      55        1099 :                 if (csize < count) then
      56           0 :                     csize = csize * 2_IK
      57           0 :                     call setResized(Factoring, csize)
      58             :                 end if
      59        1099 :                 Factoring(count) = divisor
      60        1099 :                 posint = posint / divisor ! Remove the current factor from `posint`.
      61             :             end do
      62      239370 :             divisor = divisor + 2_IKC ! Move to next odd number.
      63             :         end do
      64        7012 :         Factoring = Factoring(1:count)
      65             : #else
      66             : #error  "Unrecognized interface."
      67             : #endif

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