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

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


Contents

Source Code


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