make_dense_data Subroutine

private subroutine make_dense_data(matrix, dense_data, nfullrows, nfullcols, und_row_blk_offsets, und_col_blk_offsets, dense_row_blk_offsets, dense_col_blk_offsets, row_map, col_map, row_internal_offsets, col_internal_offsets, join_rows, join_cols, make_tr)

Shuffles the data from blocked to standard dense form

Arguments

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

Existing blocked matrix

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

Dense data

integer, intent(in) :: nfullrows

size of new data size of new data

integer, intent(in) :: nfullcols

size of new data size of new data

integer, intent(in), DIMENSION(:) :: und_row_blk_offsets
integer, intent(in), DIMENSION(:) :: und_col_blk_offsets
integer, intent(in), DIMENSION(:) :: dense_row_blk_offsets
integer, intent(in), DIMENSION(:) :: dense_col_blk_offsets
integer, intent(in), DIMENSION(:) :: row_map
integer, intent(in), DIMENSION(:) :: col_map
integer, intent(in), DIMENSION(:) :: row_internal_offsets
integer, intent(in), DIMENSION(:) :: col_internal_offsets
logical, intent(in) :: join_rows

make rows dense, default is yes make columns dense, default is yes make the dense blocks transposed

logical, intent(in) :: join_cols

make rows dense, default is yes make columns dense, default is yes make the dense blocks transposed

logical, intent(in) :: make_tr

make rows dense, default is yes make columns dense, default is yes make the dense blocks transposed


Contents

Source Code


Source Code

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

      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
         !! Existing blocked matrix
      TYPE(dbcsr_data_obj), INTENT(INOUT)                :: dense_data
         !! Dense data
      INTEGER, INTENT(IN)                                :: nfullrows, nfullcols
         !! size of new data
         !! size of new data
      INTEGER, DIMENSION(:), INTENT(IN) :: und_row_blk_offsets, und_col_blk_offsets, &
                                           dense_row_blk_offsets, dense_col_blk_offsets, row_map, col_map, row_internal_offsets, &
                                           col_internal_offsets
      LOGICAL, INTENT(IN)                                :: join_rows, join_cols, make_tr
         !! make rows dense, default is yes
         !! make columns dense, default is yes
         !! make the dense blocks transposed

      CHARACTER(len=*), PARAMETER :: routineN = 'make_dense_data'

      INTEGER :: blk_col, blk_col_size, blk_row, blk_row_size, dense_col, dense_row, error_handle, &
                 target_col_offset, target_cs, target_offset, target_row_offset, target_rs, tco, tro
      LOGICAL                                            :: tr
      TYPE(dbcsr_data_obj)                               :: block
      TYPE(dbcsr_iterator)                               :: iter

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

      CALL timeset(routineN, error_handle)
      IF (dbcsr_data_get_size(dense_data) < nfullrows*nfullcols) &
         DBCSR_ABORT("Dense data too small")
      IF (.NOT. join_cols .AND. .NOT. join_rows) &
         DBCSR_WARN("Joining neither rows nor columns is untested")
      !
      CALL dbcsr_data_clear(dense_data)
      IF (dbcsr_data_get_size(matrix%data_area) .GT. 0 &
          .AND. nfullrows .GT. 0 .AND. nfullcols .GT. 0) THEN
!$OMP PARALLEL DEFAULT(NONE) &
!$OMP PRIVATE (block, iter, &
!$OMP         target_rs, target_cs, blk_row, blk_col, tr, blk_row_size, blk_col_size,&
!$OMP         tro, tco, target_offset,&
!$OMP         target_row_offset, target_col_offset,&
!$OMP         dense_row, dense_col) &
!$OMP SHARED (&
!$OMP         dense_data, matrix, &
!$OMP         make_tr, join_rows, join_cols, &
!$OMP         und_row_blk_offsets, und_col_blk_offsets,&
!$OMP         dense_row_blk_offsets, dense_col_blk_offsets,&
!$OMP         row_internal_offsets, col_internal_offsets,&
!$OMP         row_map, col_map,&
!$OMP         nfullrows, nfullcols)
         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., read_only=.TRUE.)
         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)
            !
            ! Calculate the target block row/column size and the offset
            ! within the target block where the undense block is placed.
            IF (join_rows) THEN
               target_row_offset = dense_row_blk_offsets(dense_row)
               target_rs = dense_row_blk_offsets(dense_row + 1) - &
                           dense_row_blk_offsets(dense_row)
               tro = 1 + row_internal_offsets(blk_row)
            ELSE
               target_row_offset = und_row_blk_offsets(blk_row)
               target_rs = blk_row_size
               tro = 1
            END IF
            IF (join_cols) THEN
               target_col_offset = dense_col_blk_offsets(dense_col)
               target_cs = dense_col_blk_offsets(dense_col + 1) - &
                           dense_col_blk_offsets(dense_col)
               tco = 1 + col_internal_offsets(blk_col)
            ELSE
               target_col_offset = und_col_blk_offsets(blk_col)
               target_cs = blk_col_size
               tco = 1
            END IF
            target_offset = (target_row_offset - 1)*nfullcols &
                            + (target_col_offset - 1)*( &
                            dense_row_blk_offsets(dense_row + 1) - &
                            dense_row_blk_offsets(dense_row))
            CALL dbcsr_block_partial_copy(dst=dense_data, &
                                          dst_offset=target_offset, &
                                          dst_rs=target_rs, dst_cs=target_cs, dst_tr=make_tr, &
                                          dst_r_lb=tro, dst_c_lb=tco, &
                                          src=block, src_rs=blk_row_size, src_cs=blk_col_size, src_tr=tr, &
                                          src_r_lb=1, src_c_lb=1, 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
      CALL timestop(error_handle)
   END SUBROUTINE make_dense_data