gcc/testsuite/gfortran.dg/coarray_allocate_1.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-fcoarray=single" }
   3 ! PR 53824 - this used to ICE.
   4 ! Original test case by Vladimír Fuka
   5 program Jac
   6  implicit none
   7
   8  integer,parameter:: KND=KIND(1.0)
   9
  10  type Domain
  11   real(KND),dimension(:,:,:),allocatable:: A,B
  12   integer :: n=64,niter=20000,blockit=1000
  13   integer :: starti,endi
  14   integer :: startj,endj
  15   integer :: startk,endk
  16   integer,dimension(:),allocatable :: startsi,startsj,startsk
  17   integer,dimension(:),allocatable :: endsi,endsj,endsk
  18  end type
  19
  20  type(Domain),allocatable :: D[:,:,:]
  21 ! real(KND),codimension[*] :: sumA,sumB,diffAB
  22  integer i,j,k,ncom
  23  integer nims,nxims,nyims,nzims
  24  integer im,iim,jim,kim
  25  character(20):: ch
  26
  27  nims = num_images()
  28  nxims = nint(nims**(1./3.))
  29  nyims = nint(nims**(1./3.))
  30  nzims = nims / (nxims*nyims)
  31
  32  im = this_image()
  33  if (im==1) write(*,*) "n: [",nxims,nyims,nzims,"]"
  34
  35  kim = (im-1) / (nxims*nyims) + 1
  36  jim = ((im-1) - (kim-1)*(nxims*nyims)) / nxims + 1
  37  iim = (im-1) - (kim-1)*(nxims*nyims) - (jim-1)*(nxims) + 1
  38
  39  write (*,*) im,"[",iim,jim,kim,"]"
  40
  41  allocate(D[nxims,nyims,*])
  42
  43  ncom=command_argument_count()
  44  if (command_argument_count() >=2) then
  45   call get_command_argument(1,value=ch)
  46   read (ch,*) D%n
  47   call get_command_argument(2,value=ch)
  48   read (ch,*) D%niter
  49   call get_command_argument(3,value=ch)
  50   read (ch,*) D%blockit
  51  end if
  52
  53  allocate(D%startsi(nxims))
  54  allocate(D%startsj(nyims))
  55  allocate(D%startsk(nzims))
  56  allocate(D%endsi(nxims))
  57  allocate(D%endsj(nyims))
  58  allocate(D%endsk(nzims))
  59
  60  D%startsi(1) = 1
  61  do i=2,nxims
  62    D%startsi(i) = D%startsi(i-1) + D%n/nxims
  63  end do
  64  D%endsi(nxims) = D%n
  65  D%endsi(1:nxims-1) = D%startsi(2:nxims) - 1
  66
  67  D%startsj(1) = 1
  68  do j=2,nyims
  69    D%startsj(j) = D%startsj(j-1) + D%n/nyims
  70  end do
  71  D%endsj(nyims) = D%n
  72  D%endsj(1:nyims-1) = D%startsj(2:nyims) - 1
  73
  74  D%startsk(1) = 1
  75  do k=2,nzims
  76    D%startsk(k) = D%startsk(k-1) + D%n/nzims
  77  end do
  78  D%endsk(nzims) = D%n
  79  D%endsk(1:nzims-1) = D%startsk(2:nzims) - 1
  80
  81  D%starti = D%startsi(iim)
  82  D%endi = D%endsi(iim)
  83  D%startj = D%startsj(jim)
  84  D%endj = D%endsj(jim)
  85  D%startk = D%startsk(kim)
  86  D%endk = D%endsk(kim)
  87
  88  write(*,*) D%startsi,D%endsi
  89  write(*,*) D%startsj,D%endsj
  90  write(*,*) D%startsk,D%endsk
  91
  92  !$hmpp JacKernel allocate, args[A,B].size={0:D%n+1,0:D%n+1,0:D%n+1}
  93  allocate(D%A(D%starti-1:D%endi+1,D%startj-1:D%endj+1,D%startk-1:D%endk+1),&
  94   D%B(D%starti-1:D%endi+1,D%startj-1:D%endj+1,D%startk-1:D%endk+1))
  95 end program Jac