Line data    Source code

       1              : !--------------------------------------------------------------------------------------------------!
       2              : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3              : !   Copyright 2000-2026 CP2K developers group <https://cp2k.org>                                   !
       4              : !                                                                                                  !
       5              : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6              : !--------------------------------------------------------------------------------------------------!
       7              : 
       8              : ! **************************************************************************************************
       9              : !> \brief often used utilities for tall-and-skinny matrices
      10              : !> \author Patrick Seewald
      11              : ! **************************************************************************************************
      12              : MODULE dbt_tas_util
      13              :    USE kinds, ONLY: int_4, int_8
      14              :    USE util, ONLY: sort
      15              : 
      16              : #include "../../base/base_uses.f90"
      17              : #if defined(__LIBXS)
      18              :    USE libxs, ONLY: libxs_diff
      19              : #  define PURE_ARRAY_EQ
      20              : #else
      21              : #  define PURE_ARRAY_EQ PURE
      22              : #endif
      23              : 
      24              :    IMPLICIT NONE
      25              :    PRIVATE
      26              : 
      27              :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'dbt_tas_util'
      28              : 
      29              :    PUBLIC :: array_eq, swap
      30              : 
      31              :    INTERFACE swap
      32              :       MODULE PROCEDURE swap_i8
      33              :       MODULE PROCEDURE swap_i
      34              :    END INTERFACE
      35              : 
      36              :    INTERFACE array_eq
      37              :       MODULE PROCEDURE array_eq_i8
      38              :       MODULE PROCEDURE array_eq_i
      39              :    END INTERFACE
      40              : 
      41              : CONTAINS
      42              : 
      43              : ! **************************************************************************************************
      44              : !> \brief ...
      45              : !> \param arr ...
      46              : !> \author Patrick Seewald
      47              : ! **************************************************************************************************
      48      1209919 :    SUBROUTINE swap_i8(arr)
      49              :       INTEGER(KIND=int_8), DIMENSION(2), INTENT(INOUT)   :: arr
      50              : 
      51              :       INTEGER(KIND=int_8)                                :: tmp
      52              : 
      53      1209919 :       tmp = arr(1)
      54      1209919 :       arr(1) = arr(2)
      55      1209919 :       arr(2) = tmp
      56      1209919 :    END SUBROUTINE
      57              : 
      58              : ! **************************************************************************************************
      59              : !> \brief ...
      60              : !> \param arr ...
      61              : !> \author Patrick Seewald
      62              : ! **************************************************************************************************
      63            0 :    SUBROUTINE swap_i(arr)
      64              :       INTEGER, DIMENSION(2), INTENT(INOUT)               :: arr
      65              : 
      66              :       INTEGER                                            :: tmp
      67              : 
      68            0 :       tmp = arr(1)
      69            0 :       arr(1) = arr(2)
      70            0 :       arr(2) = tmp
      71            0 :    END SUBROUTINE
      72              : 
      73              : ! **************************************************************************************************
      74              : !> \brief ...
      75              : !> \param arr1 ...
      76              : !> \param arr2 ...
      77              : !> \return ...
      78              : !> \author Patrick Seewald
      79              : ! **************************************************************************************************
      80       223546 :    PURE_ARRAY_EQ FUNCTION array_eq_i(arr1, arr2)
      81              :       INTEGER, DIMENSION(:), INTENT(IN)                  :: arr1, arr2
      82              :       LOGICAL                                            :: array_eq_i
      83              : 
      84              : #if defined(__LIBXS)
      85       223546 :       array_eq_i = .NOT. libxs_diff(arr1, arr2)
      86              : #else
      87              :       array_eq_i = .FALSE.
      88              :       IF (SIZE(arr1) == SIZE(arr2)) array_eq_i = ALL(arr1 == arr2)
      89              : #endif
      90       223546 :    END FUNCTION
      91              : 
      92              : ! **************************************************************************************************
      93              : !> \brief ...
      94              : !> \param arr1 ...
      95              : !> \param arr2 ...
      96              : !> \return ...
      97              : !> \author Patrick Seewald
      98              : ! **************************************************************************************************
      99       223490 :    PURE_ARRAY_EQ FUNCTION array_eq_i8(arr1, arr2)
     100              :       INTEGER(KIND=int_8), DIMENSION(:), INTENT(IN)      :: arr1, arr2
     101              :       LOGICAL                                            :: array_eq_i8
     102              : 
     103              : #if defined(__LIBXS)
     104       223490 :       array_eq_i8 = .NOT. libxs_diff(arr1, arr2)
     105              : #else
     106              :       array_eq_i8 = .FALSE.
     107              :       IF (SIZE(arr1) == SIZE(arr2)) array_eq_i8 = ALL(arr1 == arr2)
     108              : #endif
     109       223490 :    END FUNCTION
     110              : 
     111              : END MODULE