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