(git:b279b6b)
qs_fb_matrix_data_types.F
Go to the documentation of this file.
1 !--------------------------------------------------------------------------------------------------!
2 ! CP2K: A general program to perform molecular dynamics simulations !
3 ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 ! !
5 ! SPDX-License-Identifier: GPL-2.0-or-later !
6 !--------------------------------------------------------------------------------------------------!
7 
8 MODULE qs_fb_matrix_data_types
9 
10  USE kinds, ONLY: dp,&
11  int_8
12  USE qs_fb_buffer_types, ONLY: fb_buffer_add,&
13  fb_buffer_create,&
14  fb_buffer_d_obj,&
15  fb_buffer_get,&
16  fb_buffer_has_data,&
17  fb_buffer_nullify,&
18  fb_buffer_release,&
19  fb_buffer_replace
20  USE qs_fb_hash_table_types, ONLY: fb_hash_table_add,&
21  fb_hash_table_create,&
22  fb_hash_table_get,&
23  fb_hash_table_has_data,&
24  fb_hash_table_nullify,&
25  fb_hash_table_obj,&
26  fb_hash_table_release
27 #include "./base/base_uses.f90"
28 
29  IMPLICIT NONE
30 
31  PRIVATE
32 
33  ! public types
34  PUBLIC :: fb_matrix_data_obj
35 
36  ! public methods
37  !API
38  PUBLIC :: fb_matrix_data_add, &
39  fb_matrix_data_create, &
40  fb_matrix_data_get, &
41  fb_matrix_data_has_data, &
42  fb_matrix_data_nullify, &
43  fb_matrix_data_release
44 
45  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_fb_matrix_data_types'
46 
47  ! Parameters related to automatic resizing of matrix_data:
48  INTEGER, PARAMETER, PRIVATE :: EXPAND_FACTOR = 2
49 
50 ! **************************************************************************************************
51 !> \brief data type for storing a list of matrix blocks
52 !> \param nmax : maximum number of blocks can be stored
53 !> \param nblks : number of blocks currently stored
54 !> \param nencode : integer used to encode global block coordinate (row, col)
55 !> into a single combined integer
56 !> \param ind : hash table maping the global combined index of the blocks
57 !> to the location in the data area
58 !> \param blks : data area, well the matrix elements are actuaally stored
59 !> \param lds : leading dimensions of each block
60 !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
61 ! **************************************************************************************************
62  TYPE fb_matrix_data_data
63  INTEGER :: nmax
64  INTEGER :: nblks
65  INTEGER :: nencode
66  TYPE(fb_hash_table_obj) :: ind
67  TYPE(fb_buffer_d_obj) :: blks
68  INTEGER, DIMENSION(:), POINTER :: lds => null()
69  END TYPE fb_matrix_data_data
70 
71 ! **************************************************************************************************
72 !> \brief the object container which allows for the creation of an array
73 !> of pointers to fb_matrix_data objects
74 !> \param obj : pointer to the fb_matrix_data object
75 !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
76 ! **************************************************************************************************
77  TYPE fb_matrix_data_obj
78  TYPE(fb_matrix_data_data), POINTER, PRIVATE :: obj => null()
79  END TYPE fb_matrix_data_obj
80 
81 CONTAINS
82 
83 ! **************************************************************************************************
84 !> \brief Add a matrix block to a fb_matrix_data object
85 !> \param matrix_data : the fb_matrix_data object
86 !> \param row : block row index of the matrix block
87 !> \param col : block col index of the matrix block
88 !> \param blk : the matrix block to add
89 !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
90 ! **************************************************************************************************
91  SUBROUTINE fb_matrix_data_add(matrix_data, row, col, blk)
92  TYPE(fb_matrix_data_obj), INTENT(INOUT) :: matrix_data
93  INTEGER, INTENT(IN) :: row, col
94  REAL(kind=dp), DIMENSION(:, :), INTENT(IN) :: blk
95 
96  INTEGER :: existing_ii, ii, ncols, nrows, old_nblks
97  INTEGER(KIND=int_8) :: pair_ind
98  INTEGER, DIMENSION(:), POINTER :: new_lds
99  LOGICAL :: check_ok, found
100 
101  check_ok = fb_matrix_data_has_data(matrix_data)
102  cpassert(check_ok)
103  NULLIFY (new_lds)
104  nrows = SIZE(blk, 1)
105  ncols = SIZE(blk, 2)
106  ! first check if the block already exists in matrix_data
107  pair_ind = fb_matrix_data_encode_pair(row, col, matrix_data%obj%nencode)
108  CALL fb_hash_table_get(matrix_data%obj%ind, pair_ind, existing_ii, found)
109  IF (found) THEN
110  CALL fb_buffer_replace(matrix_data%obj%blks, existing_ii, reshape(blk, (/nrows*ncols/)))
111  ELSE
112  old_nblks = matrix_data%obj%nblks
113  matrix_data%obj%nblks = old_nblks + 1
114  ii = matrix_data%obj%nblks
115  ! resize lds if necessary
116  IF (SIZE(matrix_data%obj%lds) .LT. ii) THEN
117  ALLOCATE (new_lds(ii*expand_factor))
118  new_lds = 0
119  new_lds(1:old_nblks) = matrix_data%obj%lds(1:old_nblks)
120  DEALLOCATE (matrix_data%obj%lds)
121  matrix_data%obj%lds => new_lds
122  END IF
123  ! add data block
124  matrix_data%obj%lds(ii) = nrows
125  CALL fb_buffer_add(matrix_data%obj%blks, reshape(blk, (/nrows*ncols/)))
126  ! record blk index in the index table
127  CALL fb_hash_table_add(matrix_data%obj%ind, pair_ind, ii)
128  END IF
129  END SUBROUTINE fb_matrix_data_add
130 
131 ! **************************************************************************************************
132 !> \brief Associates one fb_matrix_data object to another
133 !> \param a : the fb_matrix_data object to be associated
134 !> \param b : the fb_matrix_data object that a is to be associated to
135 !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
136 ! **************************************************************************************************
137  SUBROUTINE fb_matrix_data_associate(a, b)
138  TYPE(fb_matrix_data_obj), INTENT(OUT) :: a
139  TYPE(fb_matrix_data_obj), INTENT(IN) :: b
140 
141  a%obj => b%obj
142  END SUBROUTINE fb_matrix_data_associate
143 
144 ! **************************************************************************************************
145 !> \brief Creates and initialises an empty fb_matrix_data object of a given size
146 !> \param matrix_data : the fb_matrix_data object, its content must be NULL
147 !> and cannot be UNDEFINED
148 !> \param nmax : max number of matrix blks can be stored
149 !> \param nencode ...
150 !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
151 ! **************************************************************************************************
152  SUBROUTINE fb_matrix_data_create(matrix_data, nmax, nencode)
153  TYPE(fb_matrix_data_obj), INTENT(OUT) :: matrix_data
154  INTEGER, INTENT(IN) :: nmax, nencode
155 
156  NULLIFY (matrix_data%obj)
157  ALLOCATE (matrix_data%obj)
158  CALL fb_hash_table_nullify(matrix_data%obj%ind)
159  CALL fb_buffer_nullify(matrix_data%obj%blks)
160  NULLIFY (matrix_data%obj%lds)
161  matrix_data%obj%nmax = 0
162  matrix_data%obj%nblks = 0
163  matrix_data%obj%nencode = nencode
164  CALL fb_matrix_data_init(matrix_data=matrix_data, &
165  nmax=nmax, &
166  nencode=nencode)
167  ! book keeping stuff
168  END SUBROUTINE fb_matrix_data_create
169 
170 ! **************************************************************************************************
171 !> \brief retrieve a matrix block from a matrix_data object
172 !> \param matrix_data : the fb_matrix_data object
173 !> \param row : row index
174 !> \param col : col index
175 !> \param blk_p : pointer to the block in the fb_matrix_data object
176 !> \param found : if the requested block exists in the fb_matrix_data
177 !> object
178 !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
179 ! **************************************************************************************************
180  SUBROUTINE fb_matrix_data_get(matrix_data, row, col, blk_p, found)
181  TYPE(fb_matrix_data_obj), INTENT(IN) :: matrix_data
182  INTEGER, INTENT(IN) :: row, col
183  REAL(kind=dp), DIMENSION(:, :), POINTER :: blk_p
184  LOGICAL, INTENT(OUT) :: found
185 
186  INTEGER :: ind_in_blks
187  INTEGER(KIND=int_8) :: pair_ind
188  LOGICAL :: check_ok
189 
190  check_ok = fb_matrix_data_has_data(matrix_data)
191  cpassert(check_ok)
192  pair_ind = fb_matrix_data_encode_pair(row, col, matrix_data%obj%nencode)
193  CALL fb_hash_table_get(matrix_data%obj%ind, pair_ind, ind_in_blks, found)
194  IF (found) THEN
195  CALL fb_buffer_get(buffer=matrix_data%obj%blks, &
196  i_slice=ind_in_blks, &
197  data_2d=blk_p, &
198  data_2d_ld=matrix_data%obj%lds(ind_in_blks))
199  ELSE
200  NULLIFY (blk_p)
201  END IF
202  END SUBROUTINE fb_matrix_data_get
203 
204 ! **************************************************************************************************
205 !> \brief check if the object has data associated to it
206 !> \param matrix_data : the fb_matrix_data object in question
207 !> \return : true if matrix_data%obj is associated, false otherwise
208 !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
209 ! **************************************************************************************************
210  PURE FUNCTION fb_matrix_data_has_data(matrix_data) RESULT(res)
211  TYPE(fb_matrix_data_obj), INTENT(IN) :: matrix_data
212  LOGICAL :: res
213 
214  res = ASSOCIATED(matrix_data%obj)
215  END FUNCTION fb_matrix_data_has_data
216 
217 ! **************************************************************************************************
218 !> \brief Initialises a fb_matrix_data object of a given size
219 !> \param matrix_data : the fb_matrix_data object, its content must be NULL
220 !> and cannot be UNDEFINED
221 !> \param nmax : max number of matrix blocks can be stored, default is
222 !> to use the existing number of blocks in matrix_data
223 !> \param nencode : integer used to incode (row, col) to a single combined
224 !> index
225 !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
226 ! **************************************************************************************************
227  SUBROUTINE fb_matrix_data_init(matrix_data, nmax, nencode)
228  TYPE(fb_matrix_data_obj), INTENT(INOUT) :: matrix_data
229  INTEGER, INTENT(IN), OPTIONAL :: nmax, nencode
230 
231  INTEGER :: my_nmax
232  LOGICAL :: check_ok
233 
234  check_ok = fb_matrix_data_has_data(matrix_data)
235  cpassert(check_ok)
236  my_nmax = matrix_data%obj%nmax
237  IF (PRESENT(nmax)) my_nmax = nmax
238  my_nmax = max(my_nmax, 1)
239  IF (fb_hash_table_has_data(matrix_data%obj%ind)) THEN
240  CALL fb_hash_table_release(matrix_data%obj%ind)
241  END IF
242  CALL fb_hash_table_create(matrix_data%obj%ind, my_nmax)
243  IF (fb_buffer_has_data(matrix_data%obj%blks)) THEN
244  CALL fb_buffer_release(matrix_data%obj%blks)
245  END IF
246  CALL fb_buffer_create(buffer=matrix_data%obj%blks)
247  IF (ASSOCIATED(matrix_data%obj%lds)) THEN
248  DEALLOCATE (matrix_data%obj%lds)
249  END IF
250  ALLOCATE (matrix_data%obj%lds(0))
251  matrix_data%obj%nblks = 0
252  IF (PRESENT(nencode)) matrix_data%obj%nencode = nencode
253  END SUBROUTINE fb_matrix_data_init
254 
255 ! **************************************************************************************************
256 !> \brief Nullifies a fb_matrix_data object
257 !> \param matrix_data : the fb_matrix_data object
258 !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
259 ! **************************************************************************************************
260  PURE SUBROUTINE fb_matrix_data_nullify(matrix_data)
261  TYPE(fb_matrix_data_obj), INTENT(INOUT) :: matrix_data
262 
263  NULLIFY (matrix_data%obj)
264  END SUBROUTINE fb_matrix_data_nullify
265 
266 ! **************************************************************************************************
267 !> \brief releases given object
268 !> \param matrix_data : the fb_matrix_data object in question
269 !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
270 ! **************************************************************************************************
271  SUBROUTINE fb_matrix_data_release(matrix_data)
272  TYPE(fb_matrix_data_obj), INTENT(INOUT) :: matrix_data
273 
274  IF (ASSOCIATED(matrix_data%obj)) THEN
275  IF (fb_hash_table_has_data(matrix_data%obj%ind)) THEN
276  CALL fb_hash_table_release(matrix_data%obj%ind)
277  END IF
278  IF (fb_buffer_has_data(matrix_data%obj%blks)) THEN
279  CALL fb_buffer_release(matrix_data%obj%blks)
280  END IF
281  IF (ASSOCIATED(matrix_data%obj%lds)) THEN
282  DEALLOCATE (matrix_data%obj%lds)
283  END IF
284  DEALLOCATE (matrix_data%obj)
285  END IF
286  NULLIFY (matrix_data%obj)
287  END SUBROUTINE fb_matrix_data_release
288 
289 ! **************************************************************************************************
290 !> \brief outputs the current information about fb_matrix_data object
291 !> \param matrix_data : the fb_matrix_data object
292 !> \param nmax : outputs fb_matrix_data%obj%nmax
293 !> \param nblks : outputs fb_matrix_data%obj%nblks
294 !> \param nencode : outputs fb_matrix_data%obj%nencode
295 !> \param blk_sizes : blk_sizes(ii,jj) gives size of jj-th dim of the
296 !> ii-th block stored
297 !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
298 ! **************************************************************************************************
299  SUBROUTINE fb_matrix_data_status(matrix_data, nmax, nblks, nencode, blk_sizes)
300  TYPE(fb_matrix_data_obj), INTENT(INOUT) :: matrix_data
301  INTEGER, INTENT(OUT), OPTIONAL :: nmax, nblks, nencode
302  INTEGER, DIMENSION(:, :), INTENT(OUT), OPTIONAL :: blk_sizes
303 
304  INTEGER :: ii
305  INTEGER, ALLOCATABLE, DIMENSION(:) :: buffer_sizes
306  LOGICAL :: check_ok
307 
308  check_ok = fb_matrix_data_has_data(matrix_data)
309  cpassert(check_ok)
310  IF (PRESENT(nmax)) nmax = matrix_data%obj%nmax
311  IF (PRESENT(nblks)) nblks = matrix_data%obj%nblks
312  IF (PRESENT(nencode)) nencode = matrix_data%obj%nencode
313  IF (PRESENT(blk_sizes)) THEN
314  check_ok = (SIZE(blk_sizes, 1) .GE. matrix_data%obj%nblks .AND. &
315  SIZE(blk_sizes, 2) .GE. 2)
316  cpassert(check_ok)
317  blk_sizes(:, :) = 0
318  ALLOCATE (buffer_sizes(matrix_data%obj%nblks))
319  CALL fb_buffer_get(buffer=matrix_data%obj%blks, &
320  sizes=buffer_sizes)
321  DO ii = 1, matrix_data%obj%nblks
322  blk_sizes(ii, 1) = matrix_data%obj%lds(ii)
323  blk_sizes(ii, 2) = buffer_sizes(ii)/matrix_data%obj%lds(ii)
324  END DO
325  DEALLOCATE (buffer_sizes)
326  END IF
327  END SUBROUTINE fb_matrix_data_status
328 
329 ! **************************************************************************************************
330 !> \brief Encodes (row, col) index pair into a single combined index
331 !> \param row : row index (assume to start counting from 1)
332 !> \param col : col index (assume to start counting from 1)
333 !> \param nencode : integer used for encoding
334 !> \return : the returned value
335 !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
336 ! **************************************************************************************************
337  PURE FUNCTION fb_matrix_data_encode_pair(row, col, nencode) &
338  result(pair_ind)
339  INTEGER, INTENT(IN) :: row, col, nencode
340  INTEGER(KIND=int_8) :: pair_ind
341 
342  INTEGER(KIND=int_8) :: col_8, nencode_8, row_8
343 
344  row_8 = int(row, int_8)
345  col_8 = int(col, int_8)
346  nencode_8 = int(nencode, int_8)
347  pair_ind = (row_8 - 1_int_8)*nencode_8 + (col_8 - 1_int_8) + 1
348  END FUNCTION fb_matrix_data_encode_pair
349 
350 END MODULE qs_fb_matrix_data_types
kinds
Defines the basic variable types.
Definition: kinds.F:23
kinds::int_8
integer, parameter, public int_8
Definition: kinds.F:54
kinds::dp
integer, parameter, public dp
Definition: kinds.F:34
qs_fb_buffer_types
Definition: qs_fb_buffer_types.F:8
qs_fb_hash_table_types
A simple hash table of integer keys, using hash function: H(k) = (k*p) mod n + 1 where: k = key p = a...
Definition: qs_fb_hash_table_types.F:25
qs_fb_hash_table_types::fb_hash_table_has_data
pure logical function, public fb_hash_table_has_data(hash_table)
check if the object has data associated to it
Definition: qs_fb_hash_table_types.F:199
qs_fb_hash_table_types::fb_hash_table_add
recursive subroutine, public fb_hash_table_add(hash_table, key, val)
Add element to a hash table, auto resize if necessary.
Definition: qs_fb_hash_table_types.F:106
qs_fb_hash_table_types::fb_hash_table_release
subroutine, public fb_hash_table_release(hash_table)
releases given object
Definition: qs_fb_hash_table_types.F:305
qs_fb_hash_table_types::fb_hash_table_get
subroutine, public fb_hash_table_get(hash_table, key, val, found)
Retrieve value from a key from a hash table.
Definition: qs_fb_hash_table_types.F:171
qs_fb_hash_table_types::fb_hash_table_create
subroutine, public fb_hash_table_create(hash_table, nmax)
Creates and initialises an empty fb_hash_table object.
Definition: qs_fb_hash_table_types.F:142
qs_fb_hash_table_types::fb_hash_table_nullify
pure subroutine, public fb_hash_table_nullify(hash_table)
Nullifies a fb_hash_table object.
Definition: qs_fb_hash_table_types.F:255
qs_fb_matrix_data_types
Definition: qs_fb_matrix_data_types.F:8
qs_fb_matrix_data_types::fb_matrix_data_has_data
pure logical function, public fb_matrix_data_has_data(matrix_data)
check if the object has data associated to it
Definition: qs_fb_matrix_data_types.F:211
qs_fb_matrix_data_types::fb_matrix_data_add
subroutine, public fb_matrix_data_add(matrix_data, row, col, blk)
Add a matrix block to a fb_matrix_data object.
Definition: qs_fb_matrix_data_types.F:92
qs_fb_matrix_data_types::fb_matrix_data_get
subroutine, public fb_matrix_data_get(matrix_data, row, col, blk_p, found)
retrieve a matrix block from a matrix_data object
Definition: qs_fb_matrix_data_types.F:181
qs_fb_matrix_data_types::fb_matrix_data_create
subroutine, public fb_matrix_data_create(matrix_data, nmax, nencode)
Creates and initialises an empty fb_matrix_data object of a given size.
Definition: qs_fb_matrix_data_types.F:153
qs_fb_matrix_data_types::fb_matrix_data_nullify
pure subroutine, public fb_matrix_data_nullify(matrix_data)
Nullifies a fb_matrix_data object.
Definition: qs_fb_matrix_data_types.F:261
qs_fb_matrix_data_types::fb_matrix_data_release
subroutine, public fb_matrix_data_release(matrix_data)
releases given object
Definition: qs_fb_matrix_data_types.F:272