Hirdetés

Új hozzászólás Aktív témák

  • emvy

    félisten

    válasz husztiimi #20797 üzenetére

    o3-high-t probaltad?

    program cusolver_demo use iso_c_binding implicit none interface function cusolverDnCreate(handle) bind(C, name="cusolverDnCreate") import :: c_ptr, c_int type(c_ptr), intent(out) :: handle integer(c_int) :: cusolverDnCreate end function cusolverDnCreate function cusolverDnDestroy(handle) bind(C, name="cusolverDnDestroy") import :: c_ptr, c_int type(c_ptr), value :: handle integer(c_int) :: cusolverDnDestroy end function cusolverDnDestroy function cusolverDnDsyevd(handle, jobz, uplo, n, d_A, lda, d_W, d_work, lwork, d_devInfo) & bind(C, name="cusolverDnDsyevd") import :: c_ptr, c_int, c_double, c_char type(c_ptr), value :: handle character(c_char), value :: jobz character(c_char), value :: uplo integer(c_int), value :: n type(c_ptr) :: d_A integer(c_int), value :: lda type(c_ptr) :: d_W type(c_ptr) :: d_work integer(c_int), intent(inout) :: lwork type(c_ptr) :: d_devInfo integer(c_int) :: cusolverDnDsyevd end function cusolverDnDsyevd function cusolverDnDsyevd_bufferSize(handle, jobz, uplo, n, d_A, lda, d_W, lwork) & bind(C, name="cusolverDnDsyevd_bufferSize") import :: c_ptr, c_int, c_char type(c_ptr), value :: handle character(c_char), value :: jobz character(c_char), value :: uplo integer(c_int), value :: n type(c_ptr) :: d_A integer(c_int), value :: lda type(c_ptr) :: d_W integer(c_int), intent(out) :: lwork integer(c_int) :: cusolverDnDsyevd_bufferSize end function cusolverDnDsyevd_bufferSize end interface integer(c_int) :: n, lda, lwork, status type(c_ptr) :: handle type(c_ptr) :: d_A, d_W, d_work, d_devInfo real(c_double), allocatable :: h_A(:,:), h_W(:) character(c_char) :: jobz, uplo integer :: i, j n = 100 lda = n allocate(h_A(n,n)) allocate(h_W(n)) do i = 1, n do j = 1, n h_A(i,j) = i + j end do end do jobz = 'V' uplo = 'U' status = cusolverDnCreate(handle) if (status /= 0) then write(*,*) "Hiba: cusolverDnCreate" stop end if ! GPU-memória allokálás, pl.: ! call cudaMalloc(d_A, n*n*sizeof(real(c_double))) ! call cudaMalloc(d_W, n*sizeof(real(c_double))) ! Másolás: h_A -> d_A (cudaMemcpy) ! Lekérdezzük a szükséges workspace méretet: status = cusolverDnDsyevd_bufferSize(handle, jobz, uplo, n, d_A, lda, d_W, lwork) if (status /= 0) then write(*,*) "Hiba: Buffer méret lekérdezés" stop end if ! GPU workspace allokálása a lwork méret alapján: ! call cudaMalloc(d_work, lwork*sizeof(real(c_double))) ! call cudaMalloc(d_devInfo, sizeof(integer(c_int))) ! Eigen-dekompozíció meghívása: status = cusolverDnDsyevd(handle, jobz, uplo, n, d_A, lda, d_W, d_work, lwork, d_devInfo) if (status /= 0) then write(*,*) "Hiba: cusolverDnDsyevd" stop end if ! Eredmények visszamásolása: pl. ! call cudaMemcpy(h_W, d_W, n*sizeof(real(c_double)), cudaMemcpyDeviceToHost) ! Ha az eigenvektorokra is szükség van: call cudaMemcpy(h_A, d_A, n*n*sizeof(real(c_double)), cudaMemcpyDeviceToHost) ! GPU erőforrások felszabadítása: ! call cudaFree(d_A); call cudaFree(d_W); call cudaFree(d_work); call cudaFree(d_devInfo) status = cusolverDnDestroy(handle) if (status /= 0) then write(*,*) "Hiba: cusolverDnDestroy" end if write(*,*) "Eigenértékek:" write(*,*) h_W end program cusolver_demo

Új hozzászólás Aktív témák