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 file contains the implementation details of the routines under the generic interfaces in [pm_arrayStrip](@ref pm_arrayStrip).
      19             : !>
      20             : !>  \finmain
      21             : !>
      22             : !>  \author
      23             : !>  \AmirShahmoradi, September 1, 2017, 12:00 AM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
      24             : 
      25             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      26             : 
      27             :         !%%%%%%%%%%%%%%%%%%
      28             : #if     getStripped_ENABLED
      29             :         !%%%%%%%%%%%%%%%%%%
      30             : 
      31             : #if     SB_ENABLED && CusCom_ENABLED
      32      582367 :         arrayStripped = array(getSIL(array, pattern, iseq) : getSIR(array, pattern, iseq))
      33             : #elif   SB_ENABLED && DefCom_ENABLED
      34     1946922 :         arrayStripped = array(getSIL(array, pattern) : getSIR(array, pattern))
      35             : #elif   SL_ENABLED && CusCom_ENABLED
      36      588084 :         arrayStripped = array(getSIL(array, pattern, iseq) : )
      37             : #elif   SL_ENABLED && DefCom_ENABLED
      38      590732 :         arrayStripped = array(getSIL(array, pattern) : )
      39             : #elif   SR_ENABLED && CusCom_ENABLED
      40      587721 :         arrayStripped = array(1 : getSIR(array, pattern, iseq))
      41             : #elif   SR_ENABLED && DefCom_ENABLED
      42      588849 :         arrayStripped = array(1 : getSIR(array, pattern))
      43             : #else
      44             : #error  "Unrecognized interface."
      45             : #endif
      46             : 
      47             :         !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      48             : #elif   getSIL_ENABLED || getSIR_ENABLED
      49             :         !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      50             : 
      51             :         integer(IK) :: lenArray
      52             : #if     SK_ENABLED && D0_D0_ENABLED
      53             : #define GET_SIZE len
      54             : #else
      55             : #define GET_SIZE size
      56             : #endif
      57             :         ! Define the incrementing rules.
      58             : #if     getSIL_ENABLED
      59             : #define INCREMENT(a,b) a + b
      60             : #define START_INDEX 1_IK
      61             : #define STOP_INDEX lenArray - lenPatternMinusOne
      62             : #define OUT_OF_RANGE(a,b) a > b
      63             :         !integer(IK) , parameter :: SIGN = +1_IK
      64             : #elif   getSIR_ENABLED
      65             : #define OUT_OF_RANGE(a,b) a < b
      66             : #define INCREMENT(a,b) a - b
      67             : #define START_INDEX lenArray
      68             : #define STOP_INDEX lenPattern
      69             :         !integer(IK) , parameter :: SIGN = -1_IK
      70             : #else
      71             : #error  "Unrecognized interface."
      72             : #endif
      73             :         ! Define the indexing rules.
      74             : #if     D1_D0_ENABLED
      75             : #define GET_INDEX(i) i
      76             :         integer(IK) , parameter :: lenPattern = 1_IK, lenPatternMinusOne = 0_IK
      77             : #elif   D0_D0_ENABLED || D1_D1_ENABLED
      78             : #if     getSIL_ENABLED
      79             : #define GET_INDEX(i) i : i + lenPatternMinusOne
      80             : #elif   getSIR_ENABLED
      81             : #define GET_INDEX(i) i - lenPatternMinusOne : i
      82             : #else
      83             : #error  "Unrecognized interface."
      84             : #endif
      85             :         integer(IK) :: lenPattern, lenPatternMinusOne
      86     1298354 :         lenPattern = GET_SIZE(pattern, kind = IK) ! fpp
      87     1298354 :         lenPatternMinusOne = lenPattern - 1_IK
      88             : #else
      89             : #error  "Unrecognized interface."
      90             : #endif
      91             :         ! The order of conditions should not be changed here.
      92             : #if     CusCom_ENABLED && (D0_D0_ENABLED || D1_D0_ENABLED)
      93             : #define IS_EQ(a,b,lenb) iseq(a,b)
      94             : #elif   CusCom_ENABLED && D1_D1_ENABLED
      95             : #define IS_EQ(a,b,lenb) iseq(a,b,lenb)
      96             : #elif   DefCom_ENABLED && D1_D0_ENABLED && LK_ENABLED
      97             : #define IS_EQ(a,b,lenb) a .eqv. b
      98             : #elif   DefCom_ENABLED && D1_D1_ENABLED && LK_ENABLED
      99             : #define IS_EQ(a,b,lenb) all(a .eqv. b)
     100             : #elif   DefCom_ENABLED && (D1_D0_ENABLED || D0_D0_ENABLED)
     101             : #define IS_EQ(a,b,lenb) a == b
     102             : #elif   DefCom_ENABLED && D1_D1_ENABLED
     103             : #define IS_EQ(a,b,lenb) all(a == b)
     104             : #else
     105             : #error  "Unrecognized interface."
     106             : #endif
     107     1427672 :         lenArray = GET_SIZE(array, kind = IK) ! fpp
     108     1427672 :         if (lenArray < lenPattern .or. lenArray == 0_IK .or. lenPattern == 0_IK) then
     109             : #if         getSIL_ENABLED
     110             :             index = 1_IK
     111             : #elif       getSIR_ENABLED
     112             :             index = lenArray
     113             : #endif
     114             :             return
     115             :         end if
     116             :         index = START_INDEX
     117             :         do
     118     2103737 :             if (.not. IS_EQ(array(GET_INDEX(index)), pattern, lenPattern)) return
     119      687200 :             index = INCREMENT(index, lenPattern) ! fpp
     120      687200 :             if (OUT_OF_RANGE(index, STOP_INDEX)) return
     121             :         end do
     122             : #undef  OUT_OF_RANGE
     123             : #undef  START_INDEX
     124             : #undef  STOP_INDEX
     125             : #undef  INCREMENT
     126             : #undef  GET_INDEX
     127             : #undef  GET_SIZE
     128             : #undef  IS_EQ
     129             : 
     130             : #else
     131             :         !%%%%%%%%%%%%%%%%%%%%%%%%
     132             : #error  "Unrecognized interface."
     133             :         !%%%%%%%%%%%%%%%%%%%%%%%%
     134             : #endif