Makes the index for a dense matrix
Used for making matrices dense/undense
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(out), | DIMENSION(1:nblkrows_total + 1) | :: | row_p |
Storage for new index |
|
integer, | intent(out), | DIMENSION(:) | :: | col_i |
Storage for new index Storage for new index |
|
integer, | intent(out), | DIMENSION(:) | :: | blk_p |
Storage for new index Storage for new index |
|
integer, | intent(in) | :: | nblkrows_total |
Total blocked rows |
||
integer, | intent(in) | :: | nblkcols_total |
Total blocked columns |
||
integer, | intent(in), | DIMENSION(:) | :: | myblkrows |
List of blocked rows in my process row List of blocked columns in my process column |
|
integer, | intent(in), | DIMENSION(:) | :: | myblkcols |
List of blocked rows in my process row List of blocked columns in my process column |
|
integer, | intent(in), | DIMENSION(:) | :: | row_blk_offsets |
List of blocked rows in my process row List of blocked columns in my process column |
|
integer, | intent(in), | DIMENSION(:) | :: | col_blk_offsets |
List of blocked rows in my process row List of blocked columns in my process column |
|
integer, | intent(inout), | DIMENSION(dbcsr_meta_size) | :: | meta |
Metadata updates for new index |
|
logical, | intent(in), | optional | :: | make_tr |
Dense blocks are transposed |
SUBROUTINE make_dense_index(row_p, col_i, blk_p, &
nblkrows_total, nblkcols_total, myblkrows, myblkcols, &
row_blk_offsets, col_blk_offsets, meta, make_tr)
!! Makes the index for a dense matrix
!! @note Used for making matrices dense/undense
!INTEGER, DIMENSION(:), INTENT(OUT) :: row_p, col_i, blk_p
INTEGER, INTENT(IN) :: nblkrows_total
!! Total blocked rows
INTEGER, DIMENSION(:), INTENT(OUT) :: blk_p, col_i
!! Storage for new index
!! Storage for new index
INTEGER, DIMENSION(1:nblkrows_total + 1), &
INTENT(OUT) :: row_p
!! Storage for new index
INTEGER, INTENT(IN) :: nblkcols_total
!! Total blocked columns
INTEGER, DIMENSION(:), INTENT(IN) :: myblkrows, myblkcols, row_blk_offsets, &
col_blk_offsets
!! List of blocked rows in my process row
!! List of blocked columns in my process column
INTEGER, DIMENSION(dbcsr_meta_size), INTENT(INOUT) :: meta
!! Metadata updates for new index
LOGICAL, INTENT(IN), OPTIONAL :: make_tr
!! Dense blocks are transposed
CHARACTER(len=*), PARAMETER :: routineN = 'make_dense_index'
INTEGER :: blk, c, col_l, mynblkcols, mynblkrows, &
nblks, nze, prev_row, row, row_l, &
sign_carrier, sz
! ---------------------------------------------------------------------------
sign_carrier = 1
IF (PRESENT(make_tr)) THEN
IF (make_tr) sign_carrier = -1
END IF
mynblkrows = SIZE(myblkrows)
mynblkcols = SIZE(myblkcols)
meta(dbcsr_slot_nblkrows_local) = mynblkrows
meta(dbcsr_slot_nblkcols_local) = mynblkcols
nblks = mynblkrows*mynblkcols
nze = 1
IF (nblks .EQ. 0) THEN
row_p(1:) = 0
ELSE
row_p(1) = 0
!row_p(nrows+1) = nblks
prev_row = 1
blk = 0
DO row_l = 1, mynblkrows
row = myblkrows(row_l)
row_p(prev_row + 1:row) = blk
DO col_l = 1, mynblkcols
c = myblkcols(col_l)
col_i(blk + col_l) = c
sz = (row_blk_offsets(row + 1) - row_blk_offsets(row))* &
(col_blk_offsets(c + 1) - col_blk_offsets(c))
IF (sz .GT. 0) THEN
blk_p(blk + col_l) = SIGN(nze, sign_carrier)
nze = nze + sz
ELSE
blk_p(blk + col_l) = 0
END IF
END DO
prev_row = row
blk = blk + mynblkcols
END DO
IF (blk /= nblks) DBCSR_ABORT("Block mismatch")
row_p(prev_row + 1:nblkrows_total + 1) = nblks
END IF
IF (debug_mod) THEN
WRITE (*, *) routineN//" new index"
WRITE (*, *) "row_p=", row_p
WRITE (*, *) "col_i=", col_i
WRITE (*, *) "blk_p=", blk_p
END IF
meta(dbcsr_slot_nblkrows_total) = nblkrows_total
meta(dbcsr_slot_nblkcols_total) = nblkcols_total
END SUBROUTINE make_dense_index