copy_3d_tensor_dp Subroutine

private subroutine copy_3d_tensor_dp(dest, source, threaded)

copy a tensor of datatype dp

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(inout) :: dest(:,:,:)
real(kind=dp), intent(in) :: source(:,:,:)
logical, intent(in), optional :: threaded

Calls

proc~~copy_3d_tensor_dp~~CallsGraph proc~copy_3d_tensor_dp copy_3d_tensor_dp interface~pic_optional pic_optional proc~copy_3d_tensor_dp->interface~pic_optional 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

Called by

proc~~copy_3d_tensor_dp~~CalledByGraph proc~copy_3d_tensor_dp copy_3d_tensor_dp interface~pic_copy pic_copy interface~pic_copy->proc~copy_3d_tensor_dp

Variables

Type Visibility Attributes Name Initial
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 :: k
integer(kind=default_int), private :: kk
integer(kind=default_int), private :: nx
integer(kind=default_int), private :: ny
integer(kind=default_int), private :: nz
logical, private :: use_threads

Source Code

   subroutine copy_3d_tensor_dp(dest, source, threaded)
     !! copy a tensor of datatype dp
      real(dp), intent(inout) :: dest(:, :, :)
      real(dp), intent(in)    :: source(:, :, :)
      logical, intent(in), optional :: threaded
      logical :: use_threads
      integer(default_int) :: i, j, k
      integer(default_int) :: ii, jj, kk
      integer(default_int) :: nx, ny, nz

      ! --- Size checks ---
      if (size(dest, 1) /= size(source, 1) &
          .or. size(dest, 2) /= size(source, 2) &
          .or. size(dest, 3) /= size(source, 3)) then
         error stop "Tensor size mismatch"
      end if

      nx = size(source, 1)
      ny = size(source, 2)
      nz = size(source, 3)

      use_threads = pic_optional(threaded, use_threaded_default)

      if (use_threads) then
         !$omp parallel do collapse(3) private(i,j,k,ii,jj,kk)
         do kk = 1, nz, block_size
            do jj = 1, ny, block_size
               do ii = 1, nx, block_size
                  do k = kk, min(kk + block_size - 1, nz)
                     do j = jj, min(jj + block_size - 1, ny)
                        do i = ii, min(ii + block_size - 1, nx)
                           dest(i, j, k) = source(i, j, k)
                        end do
                     end do
                  end do
               end do
            end do
         end do
         !$omp end parallel do
      else
         dest = source
      end if

   end subroutine copy_3d_tensor_dp