Fortran直接调用cuBLAS.lib时cublasCreate返回错误码7的问题

我尝试在Fortran中不借助独立C代码直接调用cuBLAS.lib，参考过可正常运行的cudart和cusolver示例，已配置好CUDA 12.2的依赖库路径及链接库，编译无问题，但运行代码时cublasCreate返回错误码7（CUBLAS_STATUS_INVALID_VALUE）。

环境：Windows 10、Intel Fortran、CUDA 12.2、930M显卡

原始代码：

!==================================================================
!Interface to cusolverDn and CUDA C functions
!==================================================================
! C binding
!     https://gcc.gnu.org/onlinedocs/gfortran/ISO_005fC_005fBINDING.html
!
! Similar CUDA examples
!     https://stackoverflow.com/questions/27507169/find-available-graphics-card-memory-using-fortran%5B/url%5D
!     https://forums.developer.nvidia.com/t/using-cusolverdn-in-fortran-code/39732/5
!     https://stackoverflow.com/questions/22390812/returning-a-pointer-to-a-device-allocated-matrix-from-c-to-fortran
!     https://stackoverflow.com/questions/35150748/mixed-language-cuda-programming

module cudaThings

interface

    ! cudaMalloc
    integer (c_int) function cudaMalloc ( buffer, size ) bind (C, name="cudaMalloc" ) 
        use iso_c_binding
        implicit none
        type (c_ptr)  :: buffer
        integer (c_size_t), value :: size
    end function cudaMalloc
    
    ! cudaMemcpy 
    ! A_mem_stat = cudaMemcpy(gpuPtr,cpuPtr,sizeof(ptr),cudaMemcpyHostToDevice)
    !     note: cudaMemcpyHostToDevice = 1
    !     note: cudaMemcpyDeviceToHost = 2
    integer (c_int) function cudaMemcpy ( dst, src, count, kind ) bind (C, name="cudaMemcpy" )
        use iso_c_binding
        type (C_PTR), value :: dst, src
        integer (c_size_t), value :: count, kind
    end function cudaMemcpy
    
    ! cudaFree
    integer (c_int) function cudaFree(buffer)  bind(C, name="cudaFree")
        use iso_c_binding
        implicit none
        type (C_PTR), value :: buffer
    end function cudaFree
    
    ! get memory info
    integer (c_int) function cudaMemGetInfo(fre, tot) bind(C, name="cudaMemGetInfo")
        use iso_c_binding
        implicit none
        type(c_ptr),value :: fre
        type(c_ptr),value :: tot
    end function cudaMemGetInfo


     integer(c_int) function cusolverDnCreate(cusolver_Hndl) bind(C,name="cusolverDnCreate")
       use iso_c_binding
       implicit none
     
       type(c_ptr)::cusolver_Hndl
     end function
     
     integer(c_int) function cusolverDnDestroy(cusolver_Hndl) bind(C,name="cusolverDnDestroy")
       use iso_c_binding
       implicit none
     
       type(c_ptr),value::cusolver_Hndl
     end function
     
     integer(c_int) function cublasCreate(cublas_Hndl) bind(C,name="cublasCreate_v2")
        use iso_c_binding
        implicit none
        
        type(c_ptr),value::cublas_Hndl
     end function
     
    integer(c_int) function cublasDestroy(cublas_Hndl) bind(C,name="cublasDestroy_v2")
      use iso_c_binding
      implicit none
     
      type(c_ptr),value::cublas_Hndl
    end function
end interface  
  
end module 

program cudaTest
  use iso_c_binding
  use cudaThings
  implicit none
  
  ! GPU stuff
  type(c_ptr) :: cublas_Hndl
  integer*4    :: cublas_stat
  
  ! get handle
  cublas_stat = cublasCreate(cublas_Hndl) 
  write(*,*) cublas_stat
  if (cublas_stat .ne. 0 ) then
     write (*, '(A, I2)') " cublasCreate error: ", cublas_stat
     stop
  end if
end program

错误根源是cublasCreate接口的参数传递方式不符合C函数的要求：C语言中cublasCreate_v2需要接收一个指针的指针（cublasHandle_t*）来输出创建的句柄，但你当前的Fortran接口将cublas_Hndl声明为type(c_ptr),value，这会导致参数按值传递，cuBLAS无法正确写入句柄，最终返回CUBLAS_STATUS_INVALID_VALUE（错误码7）。

修改要点 #

仅需修正cublasCreate的接口定义，移除参数的value属性，让它按引用传递：

integer(c_int) function cublasCreate(cublas_Hndl) bind(C,name="cublasCreate_v2")
    use iso_c_binding
    implicit none
    type(c_ptr)::cublas_Hndl  ! 去掉value属性，改为按引用传递
end function

修改后的完整代码 #

!==================================================================
!Interface to cusolverDn and CUDA C functions
!==================================================================

module cudaThings

interface

    ! cudaMalloc
    integer (c_int) function cudaMalloc ( buffer, size ) bind (C, name="cudaMalloc" ) 
        use iso_c_binding
        implicit none
        type (c_ptr)  :: buffer
        integer (c_size_t), value :: size
    end function cudaMalloc
    
    ! cudaMemcpy 
    ! A_mem_stat = cudaMemcpy(gpuPtr,cpuPtr,sizeof(ptr),cudaMemcpyHostToDevice)
    !     note: cudaMemcpyHostToDevice = 1
    !     note: cudaMemcpyDeviceToHost = 2
    integer (c_int) function cudaMemcpy ( dst, src, count, kind ) bind (C, name="cudaMemcpy" )
        use iso_c_binding
        type (C_PTR), value :: dst, src
        integer (c_size_t), value :: count, kind
    end function cudaMemcpy
    
    ! cudaFree
    integer (c_int) function cudaFree(buffer)  bind(C, name="cudaFree")
        use iso_c_binding
        implicit none
        type (C_PTR), value :: buffer
    end function cudaFree
    
    ! get memory info
    integer (c_int) function cudaMemGetInfo(fre, tot) bind(C, name="cudaMemGetInfo")
        use iso_c_binding
        implicit none
        type(c_ptr),value :: fre
        type(c_ptr),value :: tot
    end function cudaMemGetInfo


     integer(c_int) function cusolverDnCreate(cusolver_Hndl) bind(C,name="cusolverDnCreate")
       use iso_c_binding
       implicit none
     
       type(c_ptr)::cusolver_Hndl
     end function
     
     integer(c_int) function cusolverDnDestroy(cusolver_Hndl) bind(C,name="cusolverDnDestroy")
       use iso_c_binding
       implicit none
     
       type(c_ptr),value::cusolver_Hndl
     end function
     
     integer(c_int) function cublasCreate(cublas_Hndl) bind(C,name="cublasCreate_v2")
        use iso_c_binding
        implicit none
        
        type(c_ptr)::cublas_Hndl  ! 已移除value属性
     end function
     
    integer(c_int) function cublasDestroy(cublas_Hndl) bind(C,name="cublasDestroy_v2")
      use iso_c_binding
      implicit none
     
      type(c_ptr),value::cublas_Hndl
    end function
end interface  
  
end module 

program cudaTest
  use iso_c_binding
  use cudaThings
  implicit none
  
  ! GPU stuff
  type(c_ptr) :: cublas_Hndl
  integer*4    :: cublas_stat
  
  ! get handle
  cublas_stat = cublasCreate(cublas_Hndl) 
  write(*,*) cublas_stat
  if (cublas_stat .ne. 0 ) then
     write (*, '(A, I2)') " cublasCreate error: ", cublas_stat
     stop
  end if
  
  ! 记得销毁句柄
  cublas_stat = cublasDestroy(cublas_Hndl)
end program

内容的提问来源于stack exchange，提问作者js1