public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
* Help with fortran pointer ans OpenACC
@ 2023-08-23 10:19 Patrick Begou
  2023-08-23 11:41 ` Tobias Burnus
  0 siblings, 1 reply; 3+ messages in thread
From: Patrick Begou @ 2023-08-23 10:19 UTC (permalink / raw)
  To: fortran


[-- Attachment #1.1: Type: text/plain, Size: 1463 bytes --]

Hi everyone!

For several days I have some trouble with OpenACC offloading and fortran 
pointers. I'm testing with a very small peace of code to investigate but 
I do not progress for several days and I need your help.

The attached code goal is just to initialize some data on the GPU and is 
representative of my problem on a very large code.

    - It works fine with nvfortran (22.11)

    - it do not work with Gnu fortran (14.0.0 20230822 - experimental) 
    => invalid memory

    - it do not work with  Cray Fortran (15.1) => wrong results

so I think the problem is the code, not the compiler.

It is also difficult to find some openACC offloading examples using 
Fortran pointers and I'm stuck with this problem.

Could someone give me advices or a small explanation on what I have not 
understood there ?

Thanks for your help

Patrick


Code details:

- all my fortran modules are grouped in the same file for simplification 
of the provided test-case.

- compilation with GNU Firtran is: "gfortran -cpp -g -fopenacc grouped.f90"

- setting  "runongpu=.false." line 7 (no GPU) the result is:

  Default init OK
  Default value OK

- setting  "runongpu=.true." line 7 (no GPU) the result is:

Default init OK
libgomp: cuStreamSynchronize error: an illegal memory access was encountered

- with nvhpc/22.11 and "runongpu=.true.", built with  "nvfortran 
-acc=gpu,noautopar  -gpu=cc80 -Minfo=accel grouped.f90"

Default init OK
Default value OK

[-- Attachment #2: grouped.f90 --]
[-- Type: text/x-fortran, Size: 3850 bytes --]

!=================================================================
! Just to say run on the device or not.
!=================================================================
module openacc_defs

      implicit none
      logical, save :: runongpu=.true.
end module openacc_defs



!=================================================================
! Data structure for r2_tab and r2_ptr to manage pointers.
! r2_ptr is used in an allocatable array for a dynamivc number of r2_tab variables
! but could be used later in chained lists
! Memory is allocated on GPU each time.
!=================================================================

module tab_m

  implicit none

     type r2_tab
             double precision, dimension(:,:), allocatable :: val
             integer :: dim1
             integer :: dim2
     end type r2_tab

     type r2_ptr
         type(r2_tab), pointer :: ptr
         type(r2_ptr), pointer :: next
     end type r2_ptr


contains

    subroutine  new_r2_tab(tab,n,m)
    implicit none
    integer, intent(in) ::n,m
    type(r2_tab), pointer, intent(inout) ::tab
    !----------------------------

       if (.not. associated(tab)) allocate(tab)
       if (allocated(tab%val)) deallocate(tab%val)

       allocate (tab%val(n,m))
       tab%dim1=n
       tab%dim2=m
       tab%val(:,:)=1.0D0         
       !$acc enter data create(tab)
       !$acc enter data create(tab%val)
    end subroutine new_r2_tab

end module tab_m

!=================================================================
! This module implements data processing (just an initialization here)
! if runongpu is .true. initialization is run on the GPU and then host is updated.
!=================================================================
module manage_data
   use openacc_defs
   use tab_m
   implicit none

   contains

   subroutine set_default_val_gpu(liste, defval, nitems)
     implicit none
     integer, intent(in) :: nitems
     double precision, intent(in) :: defval
     type(r2_ptr), dimension(nitems) :: liste

     type(r2_tab), pointer :: current=>null()
     integer:: item,j,k

     do item=1, nitems
        current=>liste(item)%ptr
!        print*,current%dim1, current%dim2,size(current%val)

        !$acc parallel loop collapse(2) default(present) if(runongpu)
        do k=1, current%dim2
           do j=1, current%dim1
              current%val(j,k)=defval
           end do
        end do
        !$acc update if(runongpu) host(current%val)
     end do
   end subroutine set_default_val_gpu

end module manage_data


!=================================================================
! main program.
!
!=================================================================

program main
      use tab_m
      use manage_data
      implicit none

      integer, parameter:: N=5
      type(r2_ptr), dimension(N) :: liste
      integer:: i,j,k
      type(r2_tab), pointer :: current=>null()
      double precision :: total

     ! Initialize 
     do i=1,N
         nullify(liste(i)%ptr)
         nullify(liste(i)%next)
     end do

     ! Allocate (do not manage "next" pointer, all elements are set to 1.0)
     do i=1,N
        call new_r2_tab(liste(i)%ptr,N,i*N)
     end do

     ! Check all is correct on host side
     do i=1,N
        if (sum(liste(i)%ptr%val) .NE. N*i*N) then
           write(6,*)"Something goes wrong",sum(liste(i)%ptr%val)," != ",N*i*N
           STOP (1)
        end if
     end do
     write(6,*) "Default init OK"

     ! Update on host (runongpu is false)
     call set_default_val_gpu(liste, 2.0D0, N)

     ! Check all is correct on host side
     do i=1,N
        if (sum(liste(i)%ptr%val) .NE. 2*N*i*N) then
           write(6,*)"Something goes wrong",sum(liste(i)%ptr%val)," != ",2*N*i*N
           !STOP (1)
        end if
     end do
     write(6,*) "Default value OK"

end program main

^ permalink raw reply	[flat|nested] 3+ messages in thread

end of thread, other threads:[~2023-08-24  7:40 UTC | newest]

Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-08-23 10:19 Help with fortran pointer ans OpenACC Patrick Begou
2023-08-23 11:41 ` Tobias Burnus
2023-08-24  7:40   ` Patrick Begou

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).