1! { dg-do compile }
2! { dg-options "-fcoarray=single" }
3! PR 53824 - this used to ICE.
4! Original test case by Vladimír Fuka
5program 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))
95end program Jac
96