diff --git a/examples/6_Autograd/CMakeLists.txt b/examples/6_Autograd/CMakeLists.txt index baeb239..0dd7e17 100644 --- a/examples/6_Autograd/CMakeLists.txt +++ b/examples/6_Autograd/CMakeLists.txt @@ -33,5 +33,5 @@ if(CMAKE_BUILD_TESTS) COMMAND autograd WORKING_DIRECTORY ${PROJECT_BINARY_DIR}) set_tests_properties(fautograd PROPERTIES PASS_REGULAR_EXPRESSION - "2.00000000 3.00000000") + "test completed successfully") endif() diff --git a/examples/6_Autograd/autograd.f90 b/examples/6_Autograd/autograd.f90 index 8e15974..f11c4dc 100644 --- a/examples/6_Autograd/autograd.f90 +++ b/examples/6_Autograd/autograd.f90 @@ -12,23 +12,48 @@ program example integer, parameter :: wp = sp ! Set up Fortran data structures - real(wp), dimension(2), target :: in_data - real(wp), dimension(:), pointer :: out_data - integer :: tensor_layout(1) = [1] + integer, parameter :: n=2, m=5 + real(wp), dimension(n,m), target :: in_data + real(wp), dimension(:,:), pointer :: out_data + integer :: tensor_layout(2) = [1, 2] + integer :: i, j ! Set up Torch data structures - type(torch_tensor) :: a + type(torch_tensor) :: tensor + + ! initialize in_data with some fake data + do j = 1, m + do i = 1, n + in_data(i,j) = ((i-1)*m + j) * 1.0_wp + end do + end do ! Construct a Torch Tensor from a Fortran array - in_data(:) = [2.0, 3.0] - call torch_tensor_from_array(a, in_data, tensor_layout, torch_kCPU) + call torch_tensor_from_array(tensor, in_data, tensor_layout, torch_kCPU) + + ! check tensor rank and shape match those of in_data + if (tensor%get_rank() /= 2) then + print *, "Error :: rank should be 2" + stop 1 + end if + if (any(tensor%get_shape() /= [2, 5])) then + print *, "Error :: shape should be (2, 5)" + stop 1 + end if ! Extract a Fortran array from a Torch tensor - call torch_tensor_to_array(a, out_data, shape(in_data)) - write (*,*) "a = ", out_data(:) + call torch_tensor_to_array(tensor, out_data, shape(in_data)) + + ! check that the data match + if (any(in_data /= out_data)) then + print *, "Error :: in_data does not match out_data" + stop 1 + end if ! Cleanup nullify(out_data) - call torch_tensor_delete(a) + call torch_tensor_delete(tensor) + + write (*,*) "test completed successfully" end program example diff --git a/src/ctorch.cpp b/src/ctorch.cpp index 5794ca0..59757c0 100644 --- a/src/ctorch.cpp +++ b/src/ctorch.cpp @@ -228,6 +228,18 @@ int torch_tensor_get_device_index(const torch_tensor_t tensor) return t->device().index(); } +int torch_tensor_get_rank(const torch_tensor_t tensor) +{ + auto t = reinterpret_cast(tensor); + return t->sizes().size(); +} + +const long int* torch_tensor_get_sizes(const torch_tensor_t tensor) +{ + auto t = reinterpret_cast(tensor); + return t->sizes().data(); +} + void torch_tensor_delete(torch_tensor_t tensor) { auto t = reinterpret_cast(tensor); diff --git a/src/ctorch.h b/src/ctorch.h index 32e8418..0b25bcf 100644 --- a/src/ctorch.h +++ b/src/ctorch.h @@ -113,6 +113,20 @@ EXPORT_C void torch_tensor_print(const torch_tensor_t tensor); */ EXPORT_C int torch_tensor_get_device_index(const torch_tensor_t tensor); +/** + * Function to determine the rank of a Torch Tensor + * @param Torch Tensor to determine the rank of + * @return rank of the Torch Tensor + */ +EXPORT_C int torch_tensor_get_rank(const torch_tensor_t tensor); + +/** + * Function to determine the sizes (shape) of a Torch Tensor + * @param Torch Tensor to determine the rank of + * @return pointer to the sizes array of the Torch Tensor + */ +EXPORT_C const long int* torch_tensor_get_sizes(const torch_tensor_t tensor); + /** * Function to delete a Torch Tensor to clean up * @param Torch Tensor to delete diff --git a/src/ftorch.f90 b/src/ftorch.f90 index 02e5f6b..7c31681 100644 --- a/src/ftorch.f90 +++ b/src/ftorch.f90 @@ -22,6 +22,9 @@ module ftorch !> Type for holding a Torch tensor. type torch_tensor type(c_ptr) :: p = c_null_ptr !! pointer to the tensor in memory + contains + procedure :: get_rank + procedure :: get_shape end type torch_tensor !| Enumerator for Torch data types @@ -315,6 +318,45 @@ end function torch_tensor_get_device_index_c device_index = torch_tensor_get_device_index_c(tensor%p) end function torch_tensor_get_device_index + !> Determines the rank of a tensor. + function get_rank(self) result(rank) + class(torch_tensor), intent(in) :: self + integer(kind=int32) :: rank !! rank of tensor + + interface + function torch_tensor_get_rank_c(tensor) result(rank) & + bind(c, name = 'torch_tensor_get_rank') + use, intrinsic :: iso_c_binding, only : c_int, c_ptr + type(c_ptr), value, intent(in) :: tensor + integer(c_int) :: rank + end function torch_tensor_get_rank_c + end interface + + rank = torch_tensor_get_rank_c(self%p) + end function get_rank + + !> Determines the shape of a tensor. + function get_shape(self) result(sizes) + use, intrinsic :: iso_c_binding, only : c_int, c_long, c_ptr + class(torch_tensor), intent(in) :: self + integer(kind=c_long), pointer :: sizes(:) !! Pointer to tensor data + integer(kind=int32) :: ndims(1) + type(c_ptr) :: cptr + + interface + function torch_tensor_get_sizes_c(tensor) result(sizes) & + bind(c, name = 'torch_tensor_get_sizes') + use, intrinsic :: iso_c_binding, only : c_int, c_long, c_ptr + type(c_ptr), value, intent(in) :: tensor + type(c_ptr) :: sizes + end function torch_tensor_get_sizes_c + end interface + + ndims(1) = self%get_rank() + cptr = torch_tensor_get_sizes_c(self%p) + call c_f_pointer(cptr, sizes, ndims) + end function get_shape + !> Deallocates an array of tensors. subroutine torch_tensor_array_delete(tensor_array) type(torch_tensor), dimension(:), intent(inout) :: tensor_array @@ -1770,960 +1812,720 @@ end subroutine torch_tensor_from_array_real64_4d !> Return the array data associated with a Torch tensor of rank 1 and data type `int8` subroutine torch_tensor_to_array_int8_1d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : int8 + use, intrinsic :: iso_fortran_env, only : int8, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor integer(kind=int8), pointer, intent(out) :: data_out(:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(1) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kInt8 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 1(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 1(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_int8_1d !> Return the array data associated with a Torch tensor of rank 2 and data type `int8` subroutine torch_tensor_to_array_int8_2d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : int8 + use, intrinsic :: iso_fortran_env, only : int8, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor integer(kind=int8), pointer, intent(out) :: data_out(:,:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(2) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kInt8 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1),sizes(2))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 2(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 2(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_int8_2d !> Return the array data associated with a Torch tensor of rank 3 and data type `int8` subroutine torch_tensor_to_array_int8_3d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : int8 + use, intrinsic :: iso_fortran_env, only : int8, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor integer(kind=int8), pointer, intent(out) :: data_out(:,:,:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(3) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kInt8 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1),sizes(2),sizes(3))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 3(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 3(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_int8_3d !> Return the array data associated with a Torch tensor of rank 4 and data type `int8` subroutine torch_tensor_to_array_int8_4d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : int8 + use, intrinsic :: iso_fortran_env, only : int8, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor integer(kind=int8), pointer, intent(out) :: data_out(:,:,:,:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(4) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kInt8 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1),sizes(2),sizes(3),sizes(4))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 4(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 4(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_int8_4d !> Return the array data associated with a Torch tensor of rank 1 and data type `int16` subroutine torch_tensor_to_array_int16_1d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : int16 + use, intrinsic :: iso_fortran_env, only : int16, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor integer(kind=int16), pointer, intent(out) :: data_out(:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(1) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kInt16 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 1(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 1(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_int16_1d !> Return the array data associated with a Torch tensor of rank 2 and data type `int16` subroutine torch_tensor_to_array_int16_2d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : int16 + use, intrinsic :: iso_fortran_env, only : int16, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor integer(kind=int16), pointer, intent(out) :: data_out(:,:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(2) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kInt16 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1),sizes(2))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 2(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 2(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_int16_2d !> Return the array data associated with a Torch tensor of rank 3 and data type `int16` subroutine torch_tensor_to_array_int16_3d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : int16 + use, intrinsic :: iso_fortran_env, only : int16, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor integer(kind=int16), pointer, intent(out) :: data_out(:,:,:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(3) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kInt16 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1),sizes(2),sizes(3))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 3(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 3(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_int16_3d !> Return the array data associated with a Torch tensor of rank 4 and data type `int16` subroutine torch_tensor_to_array_int16_4d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : int16 + use, intrinsic :: iso_fortran_env, only : int16, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor integer(kind=int16), pointer, intent(out) :: data_out(:,:,:,:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(4) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kInt16 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1),sizes(2),sizes(3),sizes(4))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 4(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 4(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_int16_4d !> Return the array data associated with a Torch tensor of rank 1 and data type `int32` subroutine torch_tensor_to_array_int32_1d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : int32 + use, intrinsic :: iso_fortran_env, only : int32, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor integer(kind=int32), pointer, intent(out) :: data_out(:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(1) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kInt32 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 1(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 1(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_int32_1d !> Return the array data associated with a Torch tensor of rank 2 and data type `int32` subroutine torch_tensor_to_array_int32_2d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : int32 + use, intrinsic :: iso_fortran_env, only : int32, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor integer(kind=int32), pointer, intent(out) :: data_out(:,:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(2) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kInt32 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1),sizes(2))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 2(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 2(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_int32_2d !> Return the array data associated with a Torch tensor of rank 3 and data type `int32` subroutine torch_tensor_to_array_int32_3d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : int32 + use, intrinsic :: iso_fortran_env, only : int32, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor integer(kind=int32), pointer, intent(out) :: data_out(:,:,:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(3) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kInt32 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1),sizes(2),sizes(3))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 3(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 3(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_int32_3d !> Return the array data associated with a Torch tensor of rank 4 and data type `int32` subroutine torch_tensor_to_array_int32_4d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : int32 + use, intrinsic :: iso_fortran_env, only : int32, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor integer(kind=int32), pointer, intent(out) :: data_out(:,:,:,:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(4) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kInt32 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1),sizes(2),sizes(3),sizes(4))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 4(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 4(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_int32_4d !> Return the array data associated with a Torch tensor of rank 1 and data type `int64` subroutine torch_tensor_to_array_int64_1d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : int64 + use, intrinsic :: iso_fortran_env, only : int64, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor integer(kind=int64), pointer, intent(out) :: data_out(:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(1) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kInt64 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 1(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 1(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_int64_1d !> Return the array data associated with a Torch tensor of rank 2 and data type `int64` subroutine torch_tensor_to_array_int64_2d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : int64 + use, intrinsic :: iso_fortran_env, only : int64, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor integer(kind=int64), pointer, intent(out) :: data_out(:,:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(2) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kInt64 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1),sizes(2))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 2(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 2(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_int64_2d !> Return the array data associated with a Torch tensor of rank 3 and data type `int64` subroutine torch_tensor_to_array_int64_3d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : int64 + use, intrinsic :: iso_fortran_env, only : int64, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor integer(kind=int64), pointer, intent(out) :: data_out(:,:,:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(3) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kInt64 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1),sizes(2),sizes(3))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 3(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 3(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_int64_3d !> Return the array data associated with a Torch tensor of rank 4 and data type `int64` subroutine torch_tensor_to_array_int64_4d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : int64 + use, intrinsic :: iso_fortran_env, only : int64, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor integer(kind=int64), pointer, intent(out) :: data_out(:,:,:,:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(4) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kInt64 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1),sizes(2),sizes(3),sizes(4))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 4(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 4(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_int64_4d !> Return the array data associated with a Torch tensor of rank 1 and data type `real32` subroutine torch_tensor_to_array_real32_1d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : real32 + use, intrinsic :: iso_fortran_env, only : real32, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor real(kind=real32), pointer, intent(out) :: data_out(:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(1) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kFloat32 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 1(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 1(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_real32_1d !> Return the array data associated with a Torch tensor of rank 2 and data type `real32` subroutine torch_tensor_to_array_real32_2d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : real32 + use, intrinsic :: iso_fortran_env, only : real32, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor real(kind=real32), pointer, intent(out) :: data_out(:,:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(2) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kFloat32 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1),sizes(2))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 2(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 2(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_real32_2d !> Return the array data associated with a Torch tensor of rank 3 and data type `real32` subroutine torch_tensor_to_array_real32_3d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : real32 + use, intrinsic :: iso_fortran_env, only : real32, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor real(kind=real32), pointer, intent(out) :: data_out(:,:,:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(3) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kFloat32 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1),sizes(2),sizes(3))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 3(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 3(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_real32_3d !> Return the array data associated with a Torch tensor of rank 4 and data type `real32` subroutine torch_tensor_to_array_real32_4d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : real32 + use, intrinsic :: iso_fortran_env, only : real32, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor real(kind=real32), pointer, intent(out) :: data_out(:,:,:,:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(4) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kFloat32 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1),sizes(2),sizes(3),sizes(4))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 4(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 4(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_real32_4d !> Return the array data associated with a Torch tensor of rank 1 and data type `real64` subroutine torch_tensor_to_array_real64_1d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : real64 + use, intrinsic :: iso_fortran_env, only : real64, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor real(kind=real64), pointer, intent(out) :: data_out(:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(1) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kFloat64 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 1(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 1(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_real64_1d !> Return the array data associated with a Torch tensor of rank 2 and data type `real64` subroutine torch_tensor_to_array_real64_2d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : real64 + use, intrinsic :: iso_fortran_env, only : real64, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor real(kind=real64), pointer, intent(out) :: data_out(:,:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(2) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kFloat64 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1),sizes(2))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 2(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 2(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_real64_2d !> Return the array data associated with a Torch tensor of rank 3 and data type `real64` subroutine torch_tensor_to_array_real64_3d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : real64 + use, intrinsic :: iso_fortran_env, only : real64, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor real(kind=real64), pointer, intent(out) :: data_out(:,:,:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(3) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kFloat64 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1),sizes(2),sizes(3))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 3(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 3(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_real64_3d !> Return the array data associated with a Torch tensor of rank 4 and data type `real64` subroutine torch_tensor_to_array_real64_4d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : real64 + use, intrinsic :: iso_fortran_env, only : real64, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor real(kind=real64), pointer, intent(out) :: data_out(:,:,:,:) !! Pointer to tensor data integer, optional, intent(in) :: sizes(4) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = torch_kFloat64 !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1),sizes(2),sizes(3),sizes(4))) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, 4(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, 4(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_real64_4d diff --git a/src/ftorch.fypp b/src/ftorch.fypp index 199796e..bc922b3 100644 --- a/src/ftorch.fypp +++ b/src/ftorch.fypp @@ -39,6 +39,9 @@ module ftorch !> Type for holding a Torch tensor. type torch_tensor type(c_ptr) :: p = c_null_ptr !! pointer to the tensor in memory + contains + procedure :: get_rank + procedure :: get_shape end type torch_tensor !| Enumerator for Torch data types @@ -294,6 +297,45 @@ contains device_index = torch_tensor_get_device_index_c(tensor%p) end function torch_tensor_get_device_index + !> Determines the rank of a tensor. + function get_rank(self) result(rank) + class(torch_tensor), intent(in) :: self + integer(kind=int32) :: rank !! rank of tensor + + interface + function torch_tensor_get_rank_c(tensor) result(rank) & + bind(c, name = 'torch_tensor_get_rank') + use, intrinsic :: iso_c_binding, only : c_int, c_ptr + type(c_ptr), value, intent(in) :: tensor + integer(c_int) :: rank + end function torch_tensor_get_rank_c + end interface + + rank = torch_tensor_get_rank_c(self%p) + end function get_rank + + !> Determines the shape of a tensor. + function get_shape(self) result(sizes) + use, intrinsic :: iso_c_binding, only : c_int, c_long, c_ptr + class(torch_tensor), intent(in) :: self + integer(kind=c_long), pointer :: sizes(:) !! Pointer to tensor data + integer(kind=int32) :: ndims(1) + type(c_ptr) :: cptr + + interface + function torch_tensor_get_sizes_c(tensor) result(sizes) & + bind(c, name = 'torch_tensor_get_sizes') + use, intrinsic :: iso_c_binding, only : c_int, c_long, c_ptr + type(c_ptr), value, intent(in) :: tensor + type(c_ptr) :: sizes + end function torch_tensor_get_sizes_c + end interface + + ndims(1) = self%get_rank() + cptr = torch_tensor_get_sizes_c(self%p) + call c_f_pointer(cptr, sizes, ndims) + end function get_shape + !> Deallocates an array of tensors. subroutine torch_tensor_array_delete(tensor_array) type(torch_tensor), dimension(:), intent(inout) :: tensor_array @@ -513,40 +555,30 @@ contains !> Return the array data associated with a Torch tensor of rank ${RANK}$ and data type `${PREC}$` subroutine torch_tensor_to_array_${PREC}$_${RANK}$d(tensor, data_out, sizes) use, intrinsic :: iso_c_binding, only : c_int, c_int64_t, c_loc - use, intrinsic :: iso_fortran_env, only : ${PREC}$ + use, intrinsic :: iso_fortran_env, only : ${PREC}$, int64 type(torch_tensor), intent(in) :: tensor !! Returned tensor ${f_type(PREC)}$(kind=${PREC}$), pointer, intent(out) :: data_out${ranksuffix(RANK)}$ !! Pointer to tensor data integer, optional, intent(in) :: sizes(${RANK}$) !! Number of entries for each rank + integer(kind=int64), allocatable :: my_shape(:) !! Number of entries for each rank ! Local data integer(c_int), parameter :: c_dtype = ${enum_from_prec(PREC)}$ !! Data type type(c_ptr) :: cptr - ! Handle allocation of the pointer array + my_shape = tensor%get_shape() + if (present(sizes)) then - ! The user may provide an array of sizes, i.e., the number of entries for - ! each rank - if (all(shape(data_out) == 0)) then - ! If the sizes array has been provided and the output array has not - ! been allocated (i.e., its shape is all zeros) then allocate it - allocate(data_out(sizes(1)#{for i in range(1,RANK)}#,sizes(${i+1}$)#{endfor}#)) - else if (any(shape(data_out) /= sizes)) then - ! Raise an error if the sizes array has been provided and the output - ! array has already been allocated but its shape differs from the sizes - ! argument - write (*,*) "[ERROR]: Array allocated with wrong shape" - stop + if (.not. all(my_shape == sizes)) then + write(*,*) 'Error :: sizes argument does not match shape of tensor' + write(*,'(A, ${RANK}$(I0, " "), A)') 'sizes :: [ ', sizes(:), ']' + write(*,'(A, ${RANK}$(I0, " "), A)') 'tensor shape :: [ ', my_shape(:), ']' + stop 1 end if - else if ((.not. associated(data_out)) .or. (all(shape(data_out) == 0))) then - ! Raise an error if the sizes array has not been provided and the pointer - ! array has not been allocated - write (*,*) "[ERROR]: Pointer array has not been allocated" - stop end if ! Have the data_out array point to the Tensor data cptr = torch_to_blob_c(tensor%p, c_dtype) - call c_f_pointer(cptr, data_out, sizes) + call c_f_pointer(cptr, data_out, my_shape) end subroutine torch_tensor_to_array_${PREC}$_${RANK}$d