block_transpose_inplace_c Subroutine

private subroutine block_transpose_inplace_c(extent, rows, columns)

In-place block transpose.

Arguments

Type IntentOptional Attributes Name
complex(kind=real_4), intent(inout), DIMENSION(rows*columns) :: extent

Matrix in the form of a 1-d array

integer, intent(in) :: rows

input matrix size input matrix size

integer, intent(in) :: columns

input matrix size input matrix size


Source Code

      PURE_BLOCKOPS SUBROUTINE block_transpose_inplace_c (extent, rows, columns)
     !! In-place block transpose.

#if defined(__LIBXSMM_TRANS) && 0
         USE libxsmm, ONLY: libxsmm_itrans, libxsmm_ptr1
#endif
         INTEGER, INTENT(IN) :: rows, columns
        !! input matrix size
        !! input matrix size
         COMPLEX(kind=real_4), DIMENSION(rows*columns), INTENT(INOUT) :: extent
        !! Matrix in the form of a 1-d array

!    ---------------------------------------------------------------------------
#if defined(__LIBXSMM_TRANS) && 0
         CALL libxsmm_itrans(libxsmm_ptr1(extent), 8, rows, columns, rows)
#elif defined(__MKL)
         CALL mkl_cimatcopy('C', 'T', rows, columns, CMPLX(1.0, 0.0, real_4), extent, rows, columns)
#else
         COMPLEX(kind=real_4), DIMENSION(rows*columns) :: extent_tr
         INTEGER :: r, c
         DO r = 1, columns
            DO c = 1, rows
               extent_tr(r + (c - 1)*columns) = extent(c + (r - 1)*rows)
            END DO
         END DO
         DO r = 1, columns
            DO c = 1, rows
               extent(r + (c - 1)*columns) = extent_tr(r + (c - 1)*columns)
            END DO
         END DO
#endif
      END SUBROUTINE block_transpose_inplace_c