Line data    Source code

       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 = -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) .LT. 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) .GE. matrix_data%obj%nblks .AND. &
     315           0 :                      SIZE(blk_sizes, 2) .GE. 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