mirror of git://gcc.gnu.org/git/gcc.git
				
				
				
			
		
			
				
	
	
		
			84 lines
		
	
	
		
			1.9 KiB
		
	
	
	
		
			Fortran
		
	
	
	
			
		
		
	
	
			84 lines
		
	
	
		
			1.9 KiB
		
	
	
	
		
			Fortran
		
	
	
	
| ! { dg-do run }
 | |
| 
 | |
| program main
 | |
|   use openacc
 | |
|   use iso_c_binding
 | |
|   implicit none
 | |
| 
 | |
|   integer, target :: a_3d_i(10, 10, 10)
 | |
|   complex a_3d_c(10, 10, 10)
 | |
|   real a_3d_r(10, 10, 10)
 | |
| 
 | |
|   integer i, j, k
 | |
|   complex c
 | |
|   real r
 | |
|   integer, parameter :: i_size = sizeof (i)
 | |
|   integer, parameter :: c_size = sizeof (c)
 | |
|   integer, parameter :: r_size = sizeof (r)
 | |
| 
 | |
|   if (acc_get_num_devices (acc_device_nvidia) .eq. 0) call exit
 | |
| 
 | |
|   call acc_init (acc_device_nvidia)
 | |
| 
 | |
|   call set3d (.FALSE., a_3d_i, a_3d_c, a_3d_r)
 | |
| 
 | |
|   call acc_copyin (a_3d_i)
 | |
|   call acc_copyin (a_3d_c)
 | |
|   call acc_copyin (a_3d_r)
 | |
| 
 | |
|   if (acc_is_present (a_3d_i) .neqv. .TRUE.) call abort
 | |
|   if (acc_is_present (a_3d_c) .neqv. .TRUE.) call abort
 | |
|   if (acc_is_present (a_3d_r) .neqv. .TRUE.) call abort
 | |
| 
 | |
|   do i = 1, 10
 | |
|     do j = 1, 10
 | |
|       do k = 1, 10
 | |
|         if (acc_is_present (a_3d_i(i, j, k), i_size) .neqv. .TRUE.) call abort
 | |
|         if (acc_is_present (a_3d_c(i, j, k), i_size) .neqv. .TRUE.) call abort
 | |
|         if (acc_is_present (a_3d_r(i, j, k), i_size) .neqv. .TRUE.) call abort
 | |
|       end do
 | |
|     end do
 | |
|   end do
 | |
| 
 | |
|   call acc_shutdown (acc_device_nvidia)
 | |
| 
 | |
| contains
 | |
| 
 | |
|   subroutine set3d (clear, a_i, a_c, a_r)
 | |
|   logical clear
 | |
|   integer, dimension (:,:,:), intent (inout) :: a_i
 | |
|   complex, dimension (:,:,:), intent (inout) :: a_c
 | |
|   real, dimension (:,:,:), intent (inout) :: a_r
 | |
| 
 | |
|   integer i, j, k
 | |
|   integer lb1, ub1, lb2, ub2, lb3, ub3
 | |
| 
 | |
|   lb1 = lbound (a_i, 1)
 | |
|   ub1 = ubound (a_i, 1)
 | |
| 
 | |
|   lb2 = lbound (a_i, 2)
 | |
|   ub2 = ubound (a_i, 2)
 | |
| 
 | |
|   lb3 = lbound (a_i, 3)
 | |
|   ub3 = ubound (a_i, 3)
 | |
| 
 | |
|   do i = lb1, ub1
 | |
|     do j = lb2, ub2
 | |
|       do k = lb3, ub3
 | |
|         if (clear) then
 | |
|           a_i(i, j, k) = 0
 | |
|           a_c(i, j, k) = cmplx (0.0, 0.0)
 | |
|           a_r(i, j, k) = 0.0
 | |
|         else
 | |
|           a_i(i, j, k) = i
 | |
|           a_c(i, j, k) = cmplx (i, j)
 | |
|           a_r(i, j, k) = i
 | |
|         end if
 | |
|       end do
 | |
|     end do
 | |
|   end do
 | |
| 
 | |
|   end subroutine
 | |
| 
 | |
| end program
 |