Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 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(__LIBXSMM)
18 : #include "libxsmm_version.h"
19 : #endif
20 :
21 : #if CPVERSION_CHECK(1, 11, <=, LIBXSMM_CONFIG_VERSION_MAJOR, LIBXSMM_CONFIG_VERSION_MINOR)
22 : USE libxsmm, ONLY: libxsmm_diff
23 : # define PURE_ARRAY_EQ
24 : #else
25 : # define PURE_ARRAY_EQ PURE
26 : #endif
27 :
28 : IMPLICIT NONE
29 : PRIVATE
30 :
31 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'dbt_tas_util'
32 :
33 : PUBLIC :: array_eq, swap
34 :
35 : INTERFACE swap
36 : MODULE PROCEDURE swap_i8
37 : MODULE PROCEDURE swap_i
38 : END INTERFACE
39 :
40 : INTERFACE array_eq
41 : MODULE PROCEDURE array_eq_i8
42 : MODULE PROCEDURE array_eq_i
43 : END INTERFACE
44 :
45 : CONTAINS
46 :
47 : ! **************************************************************************************************
48 : !> \brief ...
49 : !> \param arr ...
50 : !> \author Patrick Seewald
51 : ! **************************************************************************************************
52 1054135 : SUBROUTINE swap_i8(arr)
53 : INTEGER(KIND=int_8), DIMENSION(2), INTENT(INOUT) :: arr
54 :
55 : INTEGER(KIND=int_8) :: tmp
56 :
57 1054135 : tmp = arr(1)
58 1054135 : arr(1) = arr(2)
59 1054135 : arr(2) = tmp
60 1054135 : END SUBROUTINE
61 :
62 : ! **************************************************************************************************
63 : !> \brief ...
64 : !> \param arr ...
65 : !> \author Patrick Seewald
66 : ! **************************************************************************************************
67 0 : SUBROUTINE swap_i(arr)
68 : INTEGER, DIMENSION(2), INTENT(INOUT) :: arr
69 :
70 : INTEGER :: tmp
71 :
72 0 : tmp = arr(1)
73 0 : arr(1) = arr(2)
74 0 : arr(2) = tmp
75 0 : END SUBROUTINE
76 :
77 : ! **************************************************************************************************
78 : !> \brief ...
79 : !> \param arr1 ...
80 : !> \param arr2 ...
81 : !> \return ...
82 : !> \author Patrick Seewald
83 : ! **************************************************************************************************
84 193778 : PURE_ARRAY_EQ FUNCTION array_eq_i(arr1, arr2)
85 : INTEGER, DIMENSION(:), INTENT(IN) :: arr1, arr2
86 : LOGICAL :: array_eq_i
87 :
88 : #if CPVERSION_CHECK(1, 11, <=, LIBXSMM_CONFIG_VERSION_MAJOR, LIBXSMM_CONFIG_VERSION_MINOR)
89 968890 : array_eq_i = .NOT. libxsmm_diff(arr1, arr2)
90 : #else
91 : array_eq_i = .FALSE.
92 : IF (SIZE(arr1) .EQ. SIZE(arr2)) array_eq_i = ALL(arr1 == arr2)
93 : #endif
94 193778 : END FUNCTION
95 :
96 : ! **************************************************************************************************
97 : !> \brief ...
98 : !> \param arr1 ...
99 : !> \param arr2 ...
100 : !> \return ...
101 : !> \author Patrick Seewald
102 : ! **************************************************************************************************
103 193722 : PURE_ARRAY_EQ FUNCTION array_eq_i8(arr1, arr2)
104 : INTEGER(KIND=int_8), DIMENSION(:), INTENT(IN) :: arr1, arr2
105 : LOGICAL :: array_eq_i8
106 :
107 : #if CPVERSION_CHECK(1, 11, <=, LIBXSMM_CONFIG_VERSION_MAJOR, LIBXSMM_CONFIG_VERSION_MINOR)
108 32763890 : array_eq_i8 = .NOT. libxsmm_diff(arr1, arr2)
109 : #else
110 : array_eq_i8 = .FALSE.
111 : IF (SIZE(arr1) .EQ. SIZE(arr2)) array_eq_i8 = ALL(arr1 == arr2)
112 : #endif
113 193722 : END FUNCTION
114 :
115 : END MODULE
|