transpose_matrix_sp Subroutine

private subroutine transpose_matrix_sp(A, B, threaded, err)

transpose a matrix of datatype sp

Arguments

Type IntentOptional Attributes Name
real(kind=sp), intent(in) :: A(:,:)
real(kind=sp), intent(out) :: B(:,:)
logical, intent(in), optional :: threaded
type(error_t), intent(inout), optional :: err

set to ERROR_VALIDATION when B is not shaped (cols, rows); B is intent(out) and therefore undefined on that path. When err is absent a mismatch aborts with error stop

Calls

proc~~transpose_matrix_sp~~CallsGraph proc~transpose_matrix_sp transpose_matrix_sp interface~pic_optional pic_optional proc~transpose_matrix_sp->interface~pic_optional proc~error_raise error_raise proc~transpose_matrix_sp->proc~error_raise proc~optional_char optional_char interface~pic_optional->proc~optional_char proc~optional_dp optional_dp interface~pic_optional->proc~optional_dp proc~optional_int32 optional_int32 interface~pic_optional->proc~optional_int32 proc~optional_int64 optional_int64 interface~pic_optional->proc~optional_int64 proc~optional_logical optional_logical interface~pic_optional->proc~optional_logical proc~optional_sp optional_sp interface~pic_optional->proc~optional_sp proc~error_set error_t%error_set proc~error_raise->proc~error_set

Called by

proc~~transpose_matrix_sp~~CalledByGraph proc~transpose_matrix_sp transpose_matrix_sp interface~pic_transpose pic_transpose interface~pic_transpose->proc~transpose_matrix_sp

Variables

Type Visibility Attributes Name Initial
integer(kind=default_int), private :: cols
integer(kind=default_int), private :: i
integer(kind=default_int), private :: ii
integer(kind=default_int), private :: j
integer(kind=default_int), private :: jj
integer(kind=default_int), private :: rows
logical, private :: use_threads

Source Code

   subroutine transpose_matrix_sp(A, B, threaded, err)
         !! transpose a matrix of datatype sp
      real(sp), intent(in)  :: A(:, :)
      real(sp), intent(out) :: B(:, :)
      logical, intent(in), optional :: threaded
      type(error_t), intent(inout), optional :: err
         !! set to ERROR_VALIDATION when B is not shaped (cols, rows); B is
         !! intent(out) and therefore undefined on that path. When err is
         !! absent a mismatch aborts with error stop
      logical :: use_threads
      integer(default_int) :: i, j, ii, jj, rows, cols

      rows = size(A, 1)
      cols = size(A, 2)

      if (size(B, 1) /= cols .or. size(B, 2) /= rows) then
         if (present(err)) then
            call error_raise(err, ERROR_VALIDATION, "pic_transpose: size mismatch")
            return
         end if
         error stop "pic_transpose: size mismatch"
      end if

      use_threads = pic_optional(threaded, use_threaded_default)

      if (use_threads) then
         !$omp parallel do collapse(2) private(i,j,ii,jj)
         do jj = 1, cols, block_size
            do ii = 1, rows, block_size
               do j = jj, min(jj + block_size - 1, cols)
                  do i = ii, min(ii + block_size - 1, rows)
                     B(j, i) = A(i, j)
                  end do
               end do
            end do
         end do
         !$omp end parallel do
      else
         B = transpose(A)
      end if
   end subroutine transpose_matrix_sp