dbcsr_new_transposed Subroutine

   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