transpose_index_local Subroutine

public subroutine transpose_index_local(new_col_p, new_row_i, old_row_p, old_col_i, new_blk_p, old_blk_p)

Re-indexes row_p and blk_i according to columns.

The re-indexing is equivalent to a local-only transpose.

Arguments

Type IntentOptional Attributes Name
integer, intent(out), DIMENSION(:) :: new_col_p

new column pointer new row index

integer, intent(out), DIMENSION(:) :: new_row_i

new column pointer new row index

integer, intent(in), DIMENSION(:) :: old_row_p

old row pointer old column index

integer, intent(in), DIMENSION(:) :: old_col_i

old row pointer old column index

integer, intent(out), optional, DIMENSION(:) :: new_blk_p

new block pointer

integer, intent(in), optional, DIMENSION(:) :: old_blk_p

old block pointer


Source Code

   SUBROUTINE transpose_index_local(new_col_p, new_row_i, old_row_p, &
                                    old_col_i, new_blk_p, old_blk_p)
      !! Re-indexes row_p and blk_i according to columns.
      !!
      !! The re-indexing is equivalent to a local-only transpose.

      INTEGER, DIMENSION(:), INTENT(OUT)                 :: new_col_p, new_row_i
         !! new column pointer
         !! new row index
      INTEGER, DIMENSION(:), INTENT(IN)                  :: old_row_p, old_col_i
         !! old row pointer
         !! old column index
      INTEGER, DIMENSION(:), INTENT(OUT), OPTIONAL       :: new_blk_p
         !! new block pointer
      INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL        :: old_blk_p
         !! old block pointer

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

      INTEGER                                            :: error_handle, nblks, ncols_new, nrows_old
      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: new_col_i
      LOGICAL                                            :: blks

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

      CALL timeset(routineN, error_handle)
      blks = PRESENT(new_blk_p) .AND. PRESENT(old_blk_p)
      nblks = SIZE(old_col_i)
      nrows_old = SIZE(old_row_p) - 1
      ncols_new = SIZE(new_col_p) - 1
      IF (blks) new_blk_p(:) = old_blk_p(:)
      ALLOCATE (new_col_i(nblks))
      CALL dbcsr_expand_row_index(old_row_p, new_row_i, nrows_old, nblks)
      new_col_i(:) = old_col_i(:)
      CALL dbcsr_sort_indices(nblks, new_col_i, new_row_i, new_blk_p)
      CALL dbcsr_make_dbcsr_index(new_col_p, new_col_i, ncols_new, nblks)
      DEALLOCATE (new_col_i)
      CALL timestop(error_handle)
   END SUBROUTINE transpose_index_local