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