Transposes a DBCSR matrix.
Distribution options By default the distribution is transposed. If transpose_distribution is false, then an undetermined distribution is created that is compatible with the same process grid.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(inout) | :: | transposed |
transposed DBCSR matrix |
||
type(dbcsr_type), | intent(in) | :: | normal |
input DBCSR matrix |
||
logical, | intent(in), | optional | :: | shallow_data_copy |
only shallow data_copy; default is no; if set, the transpose_data option is ignored transpose data blocks, default is True transpose the distribution from the input matrix, default is True transpose the index (default=yes) or turn it into BCSC |
|
logical, | intent(in), | optional | :: | transpose_data |
only shallow data_copy; default is no; if set, the transpose_data option is ignored transpose data blocks, default is True transpose the distribution from the input matrix, default is True transpose the index (default=yes) or turn it into BCSC |
|
logical, | intent(in), | optional | :: | transpose_distribution |
only shallow data_copy; default is no; if set, the transpose_data option is ignored transpose data blocks, default is True transpose the distribution from the input matrix, default is True transpose the index (default=yes) or turn it into BCSC |
|
logical, | intent(in), | optional | :: | transpose_index |
only shallow data_copy; default is no; if set, the transpose_data option is ignored transpose data blocks, default is True transpose the distribution from the input matrix, default is True transpose the index (default=yes) or turn it into BCSC |
|
type(dbcsr_distribution_obj), | intent(in), | optional | :: | use_distribution |
use this distribution |
|
logical, | intent(in), | optional | :: | redistribute |
redistributes the matrix; default is .TRUE. unless shallow or transpose_distribution are set. |
SUBROUTINE dbcsr_new_transposed(transposed, normal, shallow_data_copy, &
transpose_data, transpose_distribution, transpose_index, &
use_distribution, redistribute)
!! Transposes a DBCSR matrix.
!!
!! Distribution options
!! By default the distribution is transposed. If transpose_distribution
!! is false, then an undetermined distribution is created that is
!! compatible with the same process grid.
TYPE(dbcsr_type), INTENT(INOUT) :: transposed
!! transposed DBCSR matrix
TYPE(dbcsr_type), INTENT(IN) :: normal
!! input DBCSR matrix
LOGICAL, INTENT(IN), OPTIONAL :: shallow_data_copy, transpose_data, &
transpose_distribution, transpose_index
!! only shallow data_copy; default is no; if set, the transpose_data option is ignored
!! transpose data blocks, default is True
!! transpose the distribution from the input matrix, default is True
!! transpose the index (default=yes) or turn it into BCSC
TYPE(dbcsr_distribution_obj), INTENT(IN), OPTIONAL :: use_distribution
!! use this distribution
LOGICAL, INTENT(IN), OPTIONAL :: redistribute
!! redistributes the matrix; default is .TRUE. unless shallow or transpose_distribution are set.
CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_new_transposed'
LOGICAL, PARAMETER :: dbg = .FALSE.
INTEGER :: handle, stat
INTEGER, ALLOCATABLE, DIMENSION(:) :: blk_p
LOGICAL :: redist, shallow, tr_blocks, tr_dist, &
tr_index
TYPE(dbcsr_distribution_obj) :: new_dist
TYPE(dbcsr_type) :: t2
! ---------------------------------------------------------------------------
CALL timeset(routineN, handle)
IF (.NOT. dbcsr_valid_index(normal)) &
DBCSR_ABORT("Matrix does not exist.")
! Internalize options
shallow = .FALSE.
IF (PRESENT(shallow_data_copy)) shallow = shallow_data_copy
tr_blocks = .TRUE.
IF (PRESENT(transpose_data)) tr_blocks = transpose_data
tr_dist = .TRUE.
IF (PRESENT(transpose_distribution)) tr_dist = transpose_distribution
tr_index = .TRUE.
IF (PRESENT(transpose_index)) tr_index = transpose_index
! Prepare the distribution for the transposed matrix
IF (PRESENT(use_distribution)) THEN
IF (dbcsr_distribution_nrows(use_distribution) /= dbcsr_distribution_ncols(normal%dist)) &
DBCSR_ABORT("Given distribution must be compatible with the current distribution")
IF (dbcsr_distribution_ncols(use_distribution) /= dbcsr_distribution_nrows(normal%dist)) &
DBCSR_ABORT("Given distribution must be compatible with the current distribution")
new_dist = use_distribution
CALL dbcsr_distribution_hold(new_dist)
ELSE
IF (tr_dist) THEN
CALL dbcsr_transpose_distribution(new_dist, normal%dist)
ELSE
CALL dbcsr_transpose_dims(new_dist, normal%dist)
END IF
END IF
! Create the transposed matrix
CALL dbcsr_create(transposed, name="transposed "//TRIM(normal%name), &
template=normal, &
dist=new_dist, &
row_blk_size_obj=normal%col_blk_size, &
col_blk_size_obj=normal%row_blk_size, &
matrix_type=dbcsr_get_matrix_type(normal), &
max_rbs=normal%max_cbs, &
max_cbs=normal%max_rbs, &
row_blk_offset=normal%col_blk_offset, &
col_blk_offset=normal%row_blk_offset)
CALL dbcsr_distribution_release(new_dist)
! Reserve the space for the new indices.
IF (tr_index) THEN
CALL dbcsr_addto_index_array(transposed, dbcsr_slot_row_p, &
reservation=transposed%nblkrows_total + 1, extra=transposed%nblks*2)
ELSE
CALL dbcsr_addto_index_array(transposed, dbcsr_slot_row_p, &
reservation=normal%nblkrows_total + 1, extra=transposed%nblks*2)
END IF
CALL dbcsr_addto_index_array(transposed, dbcsr_slot_col_i, &
reservation=normal%nblks)
CALL dbcsr_addto_index_array(transposed, dbcsr_slot_blk_p, &
reservation=normal%nblks)
CALL dbcsr_repoint_index(transposed)
IF (.NOT. shallow) THEN
CALL dbcsr_data_ensure_size(transposed%data_area, &
dbcsr_data_get_size_referenced(normal%data_area), &
nocopy=.TRUE.)
END IF
!
transposed%nblks = normal%nblks
transposed%nze = normal%nze
transposed%index(dbcsr_slot_nblks) = normal%nblks
transposed%index(dbcsr_slot_nze) = normal%nze
! Transpose the local index.
ALLOCATE (blk_p(normal%nblks), stat=stat)
IF (stat /= 0) DBCSR_ABORT("blk_p")
IF (tr_index) THEN
CALL transpose_index_local(transposed%row_p, transposed%col_i, &
normal%row_p, normal%col_i, blk_p, normal%blk_p)
IF (dbg) THEN
WRITE (*, *) 'orig. row_p', normal%row_p
WRITE (*, *) 'orig. col_i', normal%col_i
WRITE (*, *) 'orig. blk_p', normal%blk_p
WRITE (*, *) 'new . row_p', transposed%row_p
WRITE (*, *) 'new . col_i', transposed%col_i
WRITE (*, *) 'new . blk_p', blk_p!transposed%blk_p
END IF
ELSE
transposed%row_p(:) = normal%row_p(:)
transposed%col_i(:) = normal%col_i(:)
blk_p(:) = normal%blk_p(:)
!transposed%transpose = .TRUE.
END IF
! Copy the data
IF (shallow) THEN
CALL dbcsr_switch_data_area(transposed, normal%data_area)
transposed%blk_p(1:transposed%nblks) = &
-blk_p(1:transposed%nblks)
ELSE
CALL dbcsr_copy_sort_data(transposed%blk_p, blk_p, transposed%row_p, &
transposed%col_i, array_data(transposed%row_blk_size), &
array_data(transposed%col_blk_size), &
transposed%data_area, normal%data_area, &
mark_transposed=.not. tr_blocks, &
transpose_blocks=tr_blocks)
END IF
transposed%valid = .TRUE.
!CALL dbcsr_copy_sort_data (transposed%blk_p, blk_p, transposed%row_p,&
! transposed%col_i, array_data (transposed%row_blk_size),&
! array_data (transposed%col_blk_size),&
! transposed%data_area, normal%data_area,&
! transpose_blocks=.TRUE.)
!
1315 FORMAT(I5, 1X, I5, 1X, I5, 1X, I5, 1X, I5, 1X, I5, 1X, I5, 1X, I5, 1X, I5, 1X, I5)
IF (dbg) THEN
WRITE (*, *) 'new FINAL index'
WRITE (*, 1315) transposed%row_p
WRITE (*, 1315) transposed%col_i
WRITE (*, 1315) transposed%blk_p
END IF
!
IF (tr_index) DEALLOCATE (blk_p)
!
IF (PRESENT(redistribute)) THEN
redist = redistribute
ELSE
redist = .NOT. tr_dist .AND. .NOT. shallow
END IF
IF (redist) THEN
!write (*,*)routineN//" redistributing"
CALL dbcsr_create(t2, template=transposed)
CALL dbcsr_redistribute(transposed, t2)
CALL dbcsr_release(transposed)
transposed = t2
END IF
CALL timestop(handle)
END SUBROUTINE dbcsr_new_transposed