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 contcounterArray1ns the procedure implementation of [merge](@ref merge).
      19             : !>
      20             : !>  \finmain
      21             : !>
      22             : !>  \author
      23             : !>  \AmirShahmoradi
      24             : 
      25             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      26             : 
      27             :         ! Object components.
      28             : #if     CK_ENABLED
      29             : #define COMPONENT %re
      30             : #elif   PSSK_ENABLED || BSSK_ENABLED
      31             : #define COMPONENT %val
      32             : #else
      33             : #define COMPONENT
      34             : #endif
      35             :         ! Array subsetting.
      36             : #if     SK_ENABLED && D0_ENABLED
      37             : #define GET_INDEX(i) i:i
      38             : #define GET_SIZE len
      39             : #elif   D1_ENABLED
      40             : #define GET_INDEX(i) i
      41             : #define GET_SIZE size
      42             : #else
      43             : #error  "Unrecognized interface."
      44             : #endif
      45             :         ! Logical comparison.
      46             : #if     LK_ENABLED
      47             :         use pm_logicalCompare, only: operator(<)
      48             : #endif
      49             :         integer(IK) :: counterArray1, counterArray2, counterMergedArray, i
      50             :         integer(IK) :: lenSortedArray1, lenSortedArray2
      51      100883 :         lenSortedArray1 = GET_SIZE(sortedArray1, kind = IK)
      52      100883 :         lenSortedArray2 = GET_SIZE(sortedArray2, kind = IK)
      53             : #if     setMerged_ENABLED
      54      403532 :         CHECK_ASSERTION(__LINE__, logical(GET_SIZE(mergedSortedArray, kind = IK) == lenSortedArray1 + lenSortedArray2, LK), \
      55             :         SK_"@setMerged(): The output array size must equal the sum of the input array sizes. size(sortedArray1), size(sortedArray2), size(mergedSortedArray) = "//\
      56             :         getStr([lenSortedArray1, lenSortedArray2, GET_SIZE(mergedSortedArray, kind = IK)])) ! fpp
      57             : #endif
      58             :         !   \todo
      59             :         !   This runtime check must be extended to container arrays.
      60             :         !   Currently these tests are only performed for non-container arrays because `getStr()` cannot handle container arrays.
      61             :         !   This must be fixed in the future.
      62             : #if     DefCom_ENABLED 
      63             : #if     !(PSSK_ENABLED || BSSK_ENABLED)
      64       54985 :         CHECK_ASSERTION(__LINE__, isAscending(sortedArray1), SK_": The input argument `sortedArray1` must be ascending sorted. sortedArray1 = "//getStr(sortedArray1)) ! fpp
      65       54985 :         CHECK_ASSERTION(__LINE__, isAscending(sortedArray2), SK_": The input argument `sortedArray2` must be ascending sorted. sortedArray2 = "//getStr(sortedArray2)) ! fpp
      66             : #endif
      67             : #define IS_SORTED(i, j) i < j
      68             : #elif   CusCom_ENABLED
      69             : #define IS_SORTED(i, j) isSorted(i, j)
      70             :         !   \todo
      71             :         !   This runtime check must be extended to container arrays.
      72             :         !   Custom check can become problematic when `isSorted` is passed from `pm_arraySort`. This may further look in the future.
      73             : #if     !(PSSK_ENABLED || BSSK_ENABLED)
      74       53959 :         CHECK_ASSERTION(__LINE__, isSortedCheck(sortedArray1, isSortedEqual), SK_": The input argument `sortedArray1` must be sorted. sortedArray1 = "//getStr(sortedArray1)) ! fpp
      75       53959 :         CHECK_ASSERTION(__LINE__, isSortedCheck(sortedArray2, isSortedEqual), SK_": The input argument `sortedArray2` must be sorted. sortedArray2 = "//getStr(sortedArray2)) ! fpp
      76             : #endif
      77             : #else
      78             : #error  "Unrecognized interface."
      79             : #endif
      80             :         counterArray1 = 1_IK
      81             :         counterArray2 = 1_IK
      82             :         counterMergedArray = 1_IK
      83     4512575 :         do
      84     4621519 :             if (counterArray1 > lenSortedArray1) then
      85      128945 :                 do i = counterArray2, lenSortedArray2
      86        5661 :                     mergedSortedArray(GET_INDEX(counterMergedArray)) = sortedArray2(GET_INDEX(i))
      87      128945 :                     counterMergedArray = counterMergedArray + 1_IK
      88             :                 end do
      89             :                 return
      90             :             end if
      91     4579436 :             if (counterArray2 > lenSortedArray2) then
      92      451489 :                 do i = counterArray1, lenSortedArray1
      93        5426 :                     mergedSortedArray(GET_INDEX(counterMergedArray)) = sortedArray1(GET_INDEX(i))
      94      451489 :                     counterMergedArray = counterMergedArray + 1_IK
      95             :                 end do
      96             :                 return
      97             :             end if
      98     4512575 :             if (IS_SORTED(sortedArray1(GET_INDEX(counterArray1))COMPONENT, sortedArray2(GET_INDEX(counterArray2))COMPONENT)) then
      99      120024 :                 mergedSortedArray(GET_INDEX(counterMergedArray)) = sortedArray1(GET_INDEX(counterArray1))
     100     2081893 :                 counterArray1 = counterArray1 + 1_IK
     101             :             else
     102      122367 :                 mergedSortedArray(GET_INDEX(counterMergedArray)) = sortedArray2(GET_INDEX(counterArray2))
     103     2430682 :                 counterArray2 = counterArray2 + 1_IK
     104             :             end if
     105     4512575 :             counterMergedArray = counterMergedArray + 1_IK
     106             :         end do
     107             : #if CHECK_ENABLED && CusCom_ENABLED && !(PSSK_ENABLED || BSSK_ENABLED)
     108             :     contains
     109     2362465 :         function isSortedEqual(lhs, rhs) result(sorted)
     110             : #if         SK_ENABLED && D0_ENABLED
     111             :             character(1,SKC)        , intent(in) :: lhs, rhs
     112             : #elif       SK_ENABLED && D1_ENABLED
     113             :             character(*,SKC)        , intent(in) :: lhs, rhs
     114             : #elif       IK_ENABLED && D1_ENABLED
     115             :             integer(IKC)            , intent(in) :: lhs, rhs
     116             : #elif       LK_ENABLED && D1_ENABLED
     117             :             logical(LKC)            , intent(in) :: lhs, rhs
     118             : #elif       CK_ENABLED && D1_ENABLED
     119             :             complex(CKC)            , intent(in) :: lhs, rhs
     120             : #elif       RK_ENABLED && D1_ENABLED
     121             :             real(RKC)               , intent(in) :: lhs, rhs
     122             : #elif       PSSK_ENABLED && D1_ENABLED
     123             :             use pm_container, only: css_pdt
     124             :             type(css_pdt(SKC)), intent(in) :: lhs, rhs
     125             : #elif       BSSK_ENABLED && D1_ENABLED
     126             :             use pm_container, only: css_type
     127             :             type(css_type), intent(in) :: lhs, rhs
     128             : #else
     129             : #error      "Unrecognized interface."
     130             : #endif
     131             :             logical(LK) :: sorted
     132     2362465 :             sorted = .not. isSorted(rhs, lhs)
     133     2362465 :         end function
     134             : #endif
     135             : 
     136             : #undef  COMPONENT
     137             : #undef  IS_SORTED
     138             : #undef  GET_INDEX
     139             : #undef  GET_SIZE