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 of [pm_arrayRemap](@ref pm_arrayRemap).
      19             : !>
      20             : !>  \author
      21             : !>  \AmirShahmoradi, September 1, 2017, 12:00 AM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
      22             : 
      23             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      24             : 
      25             : #if     SK_ENABLED && D0_ENABLED
      26             : !#define ALLOCATE_ARRAYNEW allocate(character(lenArray)::arrayNew)
      27             : #define GET_LBOUND(array) 1
      28             : #define GET_INDEX(i) i:i
      29             : #define GET_SIZE(X)len(X, IK)
      30             : #else
      31             : !#define ALLOCATE_ARRAYNEW allocate(arrayNew, mold = array)
      32             : #define GET_INDEX(i) i
      33             : #define GET_SIZE(X)size(X, 1, IK)
      34             : #endif
      35             :         ! Declare the temporary array.
      36             : #if     Old_ENABLED
      37             : #if     SK_ENABLED && D0_ENABLED
      38             :         character(:,SKC), allocatable :: arrayNew
      39             : #elif   SK_ENABLED && D1_ENABLED
      40         120 :         character(len(array, IK),SKC), allocatable :: arrayNew(:)
      41             : #elif   IK_ENABLED && D1_ENABLED
      42             :         integer(IKC), allocatable :: arrayNew(:)
      43             : #elif   LK_ENABLED && D1_ENABLED
      44             :         logical(LKC), allocatable :: arrayNew(:)
      45             : #elif   CK_ENABLED && D1_ENABLED
      46             :         complex(CKC), allocatable :: arrayNew(:)
      47             : #elif   RK_ENABLED && D1_ENABLED
      48             :         real(RKC), allocatable :: arrayNew(:)
      49             : #else
      50             : #error  "Unrecognized interface."
      51             : #endif
      52             : #elif   !New_ENABLED
      53             : #error  "Unrecognized interface."
      54             : #endif
      55             :         integer(IK) :: i, lenArray
      56             : #if     New_ENABLED || (SK_ENABLED && D0_ENABLED)
      57             :         integer(IK), parameter :: offset = 0_IK
      58             : #elif   Old_ENABLED
      59             :         integer(IK) :: offset
      60        4119 :         offset = lbound(array, 1, IK) - 1_IK
      61             : #else
      62             : #error  "Unrecognized interface."
      63             : #endif
      64        4231 :         lenArray = GET_SIZE(array)
      65             : #if     setRemapped_ENABLED && New_ENABLED
      66         618 :         CHECK_ASSERTION(__LINE__, lenArray == GET_SIZE(arrayNew), SK_"@setRemapped(): The lengths of the arguments `array` and `arrayNew` must equal. lenArray, lenArrayNew = "//getStr([lenArray, GET_SIZE(arrayNew)]))
      67             : #endif
      68     8136262 :         CHECK_ASSERTION(__LINE__, all(1_IK + offset <= index) .and. all(index <= lenArray + offset), SK_"@setRemapped(): All `index` values must be within the lower and upper bounds of the input `array`. index, lb, ub = "//getStr([index, 1_IK + offset, lenArray + offset]))
      69       38679 :         CHECK_ASSERTION(__LINE__, lenArray == size(index, 1, IK), SK_"@setRemapped(): The size of the arguments `array` and `index` must equal. lenArray, lenIndex = "//getStr([lenArray, size(index, 1, IK)]))
      70             : #if     Old_ENABLED
      71        8110 :         allocate(arrayNew, mold = array)
      72             : #endif
      73     2031872 :         do i = 1_IK, lenArray
      74             : #if             Rev_ENABLED
      75         142 :                 arrayNew(GET_INDEX(i + offset)) = array(GET_INDEX(index(lenArray)))
      76        4448 :                 lenArray = lenArray - 1_IK
      77             : #elif           For_ENABLED
      78     2027424 :                 arrayNew(GET_INDEX(i + offset)) = array(GET_INDEX(index(i)))
      79             : #else
      80             : #error          "Unrecognized interface."
      81             : #endif
      82             :         end do
      83             : #if     Old_ENABLED
      84        4231 :         call move_alloc(from = arrayNew, to = array)
      85             : #if     __GFORTRAN__
      86             :         !>  \todo
      87             :         !>  The following bug bypass must be resolved once the Gfortran bug is fixed.
      88             :         !>  \bug gfortran 10.3 does not deallocate `arrayNew` upon return.
      89             :         if (allocated(arrayNew)) deallocate(arrayNew)
      90             : #endif
      91             : #endif
      92             : #undef  GET_INDEX
      93             : #undef  GET_SIZE