make_dense_index Subroutine

public 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

Arguments

TypeIntentOptionalAttributesName
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


Contents

Source Code


Source Code

   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