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 : 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 = -1
64 : INTEGER :: nblks = -1
65 : INTEGER :: nencode = -1
66 : TYPE(fb_hash_table_obj) :: ind = fb_hash_table_obj()
67 : TYPE(fb_buffer_d_obj) :: blks = fb_buffer_d_obj()
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 1664 : 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 1664 : INTEGER, DIMENSION(:), POINTER :: new_lds
99 : LOGICAL :: check_ok, found
100 :
101 1664 : check_ok = fb_matrix_data_has_data(matrix_data)
102 0 : CPASSERT(check_ok)
103 1664 : NULLIFY (new_lds)
104 1664 : nrows = SIZE(blk, 1)
105 1664 : ncols = SIZE(blk, 2)
106 : ! first check if the block already exists in matrix_data
107 1664 : pair_ind = fb_matrix_data_encode_pair(row, col, matrix_data%obj%nencode)
108 1664 : CALL fb_hash_table_get(matrix_data%obj%ind, pair_ind, existing_ii, found)
109 1664 : IF (found) THEN
110 0 : CALL fb_buffer_replace(matrix_data%obj%blks, existing_ii, RESHAPE(blk, [nrows*ncols]))
111 : ELSE
112 1664 : old_nblks = matrix_data%obj%nblks
113 1664 : matrix_data%obj%nblks = old_nblks + 1
114 1664 : ii = matrix_data%obj%nblks
115 : ! resize lds if necessary
116 1664 : IF (SIZE(matrix_data%obj%lds) < ii) THEN
117 720 : ALLOCATE (new_lds(ii*EXPAND_FACTOR))
118 5712 : new_lds = 0
119 2736 : new_lds(1:old_nblks) = matrix_data%obj%lds(1:old_nblks)
120 240 : DEALLOCATE (matrix_data%obj%lds)
121 240 : matrix_data%obj%lds => new_lds
122 : END IF
123 : ! add data block
124 1664 : matrix_data%obj%lds(ii) = nrows
125 3328 : CALL fb_buffer_add(matrix_data%obj%blks, RESHAPE(blk, [nrows*ncols]))
126 : ! record blk index in the index table
127 1664 : CALL fb_hash_table_add(matrix_data%obj%ind, pair_ind, ii)
128 : END IF
129 1664 : 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 0 : 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 0 : a%obj => b%obj
142 0 : 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 48 : 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 48 : ALLOCATE (matrix_data%obj)
158 48 : CALL fb_hash_table_nullify(matrix_data%obj%ind)
159 48 : CALL fb_buffer_nullify(matrix_data%obj%blks)
160 48 : NULLIFY (matrix_data%obj%lds)
161 48 : matrix_data%obj%nmax = 0
162 48 : matrix_data%obj%nblks = 0
163 48 : matrix_data%obj%nencode = nencode
164 : CALL fb_matrix_data_init(matrix_data=matrix_data, &
165 : nmax=nmax, &
166 48 : nencode=nencode)
167 : ! book keeping stuff
168 48 : 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 10240 : 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 5120 : check_ok = fb_matrix_data_has_data(matrix_data)
191 5120 : CPASSERT(check_ok)
192 5120 : pair_ind = fb_matrix_data_encode_pair(row, col, matrix_data%obj%nencode)
193 5120 : CALL fb_hash_table_get(matrix_data%obj%ind, pair_ind, ind_in_blks, found)
194 5120 : 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 5120 : data_2d_ld=matrix_data%obj%lds(ind_in_blks))
199 : ELSE
200 0 : NULLIFY (blk_p)
201 : END IF
202 5120 : 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 7136 : 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 7136 : res = ASSOCIATED(matrix_data%obj)
215 7136 : 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 48 : 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 48 : check_ok = fb_matrix_data_has_data(matrix_data)
235 48 : CPASSERT(check_ok)
236 48 : my_nmax = matrix_data%obj%nmax
237 48 : IF (PRESENT(nmax)) my_nmax = nmax
238 48 : my_nmax = MAX(my_nmax, 1)
239 48 : IF (fb_hash_table_has_data(matrix_data%obj%ind)) THEN
240 0 : CALL fb_hash_table_release(matrix_data%obj%ind)
241 : END IF
242 48 : CALL fb_hash_table_create(matrix_data%obj%ind, my_nmax)
243 48 : IF (fb_buffer_has_data(matrix_data%obj%blks)) THEN
244 0 : CALL fb_buffer_release(matrix_data%obj%blks)
245 : END IF
246 48 : CALL fb_buffer_create(buffer=matrix_data%obj%blks)
247 48 : IF (ASSOCIATED(matrix_data%obj%lds)) THEN
248 0 : DEALLOCATE (matrix_data%obj%lds)
249 : END IF
250 48 : ALLOCATE (matrix_data%obj%lds(0))
251 48 : matrix_data%obj%nblks = 0
252 48 : IF (PRESENT(nencode)) matrix_data%obj%nencode = nencode
253 48 : 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 48 : PURE SUBROUTINE fb_matrix_data_nullify(matrix_data)
261 : TYPE(fb_matrix_data_obj), INTENT(INOUT) :: matrix_data
262 :
263 48 : NULLIFY (matrix_data%obj)
264 48 : 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 48 : SUBROUTINE fb_matrix_data_release(matrix_data)
272 : TYPE(fb_matrix_data_obj), INTENT(INOUT) :: matrix_data
273 :
274 48 : IF (ASSOCIATED(matrix_data%obj)) THEN
275 48 : IF (fb_hash_table_has_data(matrix_data%obj%ind)) THEN
276 48 : CALL fb_hash_table_release(matrix_data%obj%ind)
277 : END IF
278 48 : IF (fb_buffer_has_data(matrix_data%obj%blks)) THEN
279 48 : CALL fb_buffer_release(matrix_data%obj%blks)
280 : END IF
281 48 : IF (ASSOCIATED(matrix_data%obj%lds)) THEN
282 48 : DEALLOCATE (matrix_data%obj%lds)
283 : END IF
284 48 : DEALLOCATE (matrix_data%obj)
285 : END IF
286 48 : NULLIFY (matrix_data%obj)
287 48 : 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 0 : 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 0 : INTEGER, ALLOCATABLE, DIMENSION(:) :: buffer_sizes
306 : LOGICAL :: check_ok
307 :
308 0 : check_ok = fb_matrix_data_has_data(matrix_data)
309 0 : CPASSERT(check_ok)
310 0 : IF (PRESENT(nmax)) nmax = matrix_data%obj%nmax
311 0 : IF (PRESENT(nblks)) nblks = matrix_data%obj%nblks
312 0 : IF (PRESENT(nencode)) nencode = matrix_data%obj%nencode
313 0 : IF (PRESENT(blk_sizes)) THEN
314 : check_ok = (SIZE(blk_sizes, 1) >= matrix_data%obj%nblks .AND. &
315 0 : SIZE(blk_sizes, 2) >= 2)
316 0 : CPASSERT(check_ok)
317 0 : blk_sizes(:, :) = 0
318 0 : ALLOCATE (buffer_sizes(matrix_data%obj%nblks))
319 : CALL fb_buffer_get(buffer=matrix_data%obj%blks, &
320 0 : sizes=buffer_sizes)
321 0 : DO ii = 1, matrix_data%obj%nblks
322 0 : blk_sizes(ii, 1) = matrix_data%obj%lds(ii)
323 0 : blk_sizes(ii, 2) = buffer_sizes(ii)/matrix_data%obj%lds(ii)
324 : END DO
325 0 : DEALLOCATE (buffer_sizes)
326 : END IF
327 0 : 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 6784 : 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 6784 : row_8 = INT(row, int_8)
345 6784 : col_8 = INT(col, int_8)
346 6784 : nencode_8 = INT(nencode, int_8)
347 6784 : pair_ind = (row_8 - 1_int_8)*nencode_8 + (col_8 - 1_int_8) + 1
348 6784 : END FUNCTION fb_matrix_data_encode_pair
349 :
350 0 : END MODULE qs_fb_matrix_data_types
|
