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