Makes the index for a dense matrix
Note
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