make_undense_data Subroutine

private subroutine make_undense_data(matrix, dense_data, nfullrows, nfullcols, dense_row_blk_offsets, dense_col_blk_offsets, row_map, col_map, row_internal_offsets, col_internal_offsets)

Shuffles the data from standard dense to blocked form

Note

Used for making matrices dense/undense

Arguments

Type IntentOptional Attributes Name
type(dbcsr_type), intent(inout) :: matrix

Matrix with data to fill

type(dbcsr_data_obj), intent(in) :: dense_data

Dense data

integer, intent(in) :: nfullrows

number of full rows in local submatrix number of full columns in local submatrix

integer, intent(in) :: nfullcols

number of full rows in local submatrix number of full columns in local submatrix

integer, intent(in), DIMENSION(:) :: dense_row_blk_offsets

row block offsets for dense data column block offsets for dense data mapping from undense to dense rows mapping from undense to dense rows

integer, intent(in), DIMENSION(:) :: dense_col_blk_offsets

row block offsets for dense data column block offsets for dense data mapping from undense to dense rows mapping from undense to dense rows

integer, intent(in), DIMENSION(:) :: row_map

row block offsets for dense data column block offsets for dense data mapping from undense to dense rows mapping from undense to dense rows

integer, intent(in), DIMENSION(:) :: col_map

row block offsets for dense data column block offsets for dense data mapping from undense to dense rows mapping from undense to dense rows

integer, intent(in), DIMENSION(:) :: row_internal_offsets

row block offsets for dense data column block offsets for dense data mapping from undense to dense rows mapping from undense to dense rows

integer, intent(in), DIMENSION(:) :: col_internal_offsets

row block offsets for dense data column block offsets for dense data mapping from undense to dense rows mapping from undense to dense rows


Source Code

   SUBROUTINE make_undense_data(matrix, dense_data, nfullrows, nfullcols, &
                                dense_row_blk_offsets, dense_col_blk_offsets, &
                                row_map, col_map, row_internal_offsets, col_internal_offsets)
      !! Shuffles the data from standard dense to blocked form
      !! @note Used for making matrices dense/undense

      TYPE(dbcsr_type), INTENT(INOUT)                    :: matrix
         !! Matrix with data to fill
      TYPE(dbcsr_data_obj), INTENT(IN)                   :: dense_data
         !! Dense data
      INTEGER, INTENT(IN)                                :: nfullrows, nfullcols
         !! number of full rows in local submatrix
         !! number of full columns in local submatrix
      INTEGER, DIMENSION(:), INTENT(IN)                  :: dense_row_blk_offsets, &
                                                            dense_col_blk_offsets, row_map, &
                                                            col_map, row_internal_offsets, &
                                                            col_internal_offsets
         !! row block offsets for dense data
         !! column block offsets for dense data
         !! mapping from undense to dense rows
         !! mapping from undense to dense rows

      INTEGER :: blk_col, blk_col_size, blk_row, blk_row_size, dense_col, dense_col_offset, &
                 dense_cs, dense_offset, dense_row, dense_row_offset, dense_rs, sco, sro
      LOGICAL                                            :: tr
      TYPE(dbcsr_data_obj)                               :: block
      TYPE(dbcsr_iterator)                               :: iter

!   ---------------------------------------------------------------------------

      IF (dbcsr_data_get_size(dense_data) < nfullrows*nfullcols) &
         DBCSR_ABORT("Dense data too small")
      IF (dbcsr_data_get_size(matrix%data_area) .GT. 0) THEN
         CALL dbcsr_data_clear(matrix%data_area)
!$OMP PARALLEL DEFAULT(NONE) &
!$OMP PRIVATE (block, iter,&
!$OMP          blk_row, blk_col, tr,&
!$OMP          blk_row_size, blk_col_size, sro, sco,&
!$OMP          dense_row_offset, dense_col_offset, dense_row, dense_col,&
!$OMP          dense_cs, dense_rs,&
!$OMP          dense_offset) &
!$OMP SHARED (&
!$OMP         matrix, dense_data, &
!$OMP         nfullrows, nfullcols, &
!$OMP         dense_row_blk_offsets, dense_col_blk_offsets,&
!$OMP         row_map, col_map,&
!$OMP         row_internal_offsets, col_internal_offsets)
         CALL dbcsr_data_init(block)
         CALL dbcsr_data_new(block, &
                             dbcsr_type_1d_to_2d(dbcsr_data_get_type(dense_data)))
         CALL dbcsr_iterator_start(iter, matrix, dynamic=.TRUE., shared=.TRUE., &
                                   contiguous_pointers=.FALSE.)
         DO WHILE (dbcsr_iterator_blocks_left(iter))
            CALL dbcsr_iterator_next_block(iter, blk_row, blk_col, block, tr, &
                                           row_size=blk_row_size, col_size=blk_col_size)
            dense_row = row_map(blk_row)
            dense_col = col_map(blk_col)
            dense_row_offset = dense_row_blk_offsets(dense_row)
            dense_col_offset = dense_col_blk_offsets(dense_col)
            dense_rs = dense_row_blk_offsets(dense_row + 1) - &
                       dense_row_blk_offsets(dense_row)
            dense_cs = dense_col_blk_offsets(dense_col + 1) - &
                       dense_col_blk_offsets(dense_col)
            sro = 1 + row_internal_offsets(blk_row)
            sco = 1 + col_internal_offsets(blk_col)
            dense_offset = (dense_row_offset - 1)*nfullcols &
                           + (dense_col_offset - 1)*dense_rs
            CALL dbcsr_block_partial_copy( &
               dst=block, dst_rs=blk_row_size, dst_cs=blk_col_size, dst_tr=tr, &
               dst_r_lb=1, dst_c_lb=1, &
               src=dense_data, src_offset=dense_offset, &
               src_rs=dense_rs, src_cs=dense_cs, src_tr=.FALSE., &
               src_r_lb=sro, src_c_lb=sco, &
               nrow=blk_row_size, ncol=blk_col_size)
         END DO
         CALL dbcsr_iterator_stop(iter)
         CALL dbcsr_data_clear_pointer(block)
         CALL dbcsr_data_release(block)
!$OMP END PARALLEL
      END IF
   END SUBROUTINE make_undense_data