block_transpose_copy_2d1d_s Subroutine

private subroutine block_transpose_copy_2d1d_s(extent_out, extent_in, rows, columns)

Copy and transpose block.

Arguments

Type IntentOptional Attributes Name
real(kind=real_4), intent(out), DIMENSION(columns, rows), TARGET :: extent_out

output matrix in the form of a 2-d array
real(kind=real_4), intent(in), DIMENSION(:) :: extent_in

input 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

Contents

Source Code

block_transpose_copy_2d1d_s

Source Code

      PURE_BLOCKOPS SUBROUTINE block_transpose_copy_2d1d_s (extent_out, extent_in, &
                                                                        rows, columns)
     !! Copy and transpose block.

#if defined(__LIBXSMM_TRANS)
         USE libxsmm, ONLY: libxsmm_otrans, libxsmm_ptr1, libxsmm_ptr2
#endif
         INTEGER, INTENT(IN) :: rows, columns
        !! input matrix size
        !! input matrix size
         REAL(kind=real_4), DIMENSION(columns, rows), INTENT(OUT), TARGET :: extent_out
        !! output matrix in the form of a 2-d array
         REAL(kind=real_4), DIMENSION(:), INTENT(IN)                      :: extent_in
        !! input matrix in the form of a 1-d array

!    ---------------------------------------------------------------------------
#if defined(__LIBXSMM_TRANS)
         CALL libxsmm_otrans(libxsmm_ptr2(extent_out), libxsmm_ptr1(extent_in), &
                             4, rows, columns, rows, columns)
#elif defined(__MKL)
         CALL mkl_somatcopy('C', 'T', rows, columns, 1.0_real_4, extent_in, rows, extent_out, columns)
#else
         extent_out = TRANSPOSE(RESHAPE(extent_in, (/rows, columns/)))
#endif
      END SUBROUTINE block_transpose_copy_2d1d_s