Hi all,
recently I’ve submitted some simple fixes to one Fortran project and noticed a difference in results if the project compiled with different compilers.
After some more checks it became clear that there are two group of compilers with different behaviour.
“A” GNU,Intel/InteLLVM,lfortran,NAG,IBM. (expected results)
“B” AOCC, NVidia, ARM. (problematic results)
In the end the main author of the code has created a reproducer of the problem and I’ve stripped it to the following code.
program aocc_run_test
implicit none
real :: arr_in1(0:10, 2:5), arr1(0:10,2:5)
real :: arr_in2(0:10, 2:5), arr2(0:10,2:5)
real :: arr_in3(0:10, 2:5), arr3(0:10,2:5)
integer i, j
do i=0,10
do j=2,5
arr_in1(i,j) = 1000*i+j
arr_in2(i,j) = 1000*i+j
arr_in3(i,j) = 1000*i+j
end do
end do
call evaluate(arr_in1,arr_in2,arr_in3,arr1,arr2,arr3)
contains
function justcopy(arr_in)
real, intent(in) :: arr_in(0:,:)
real :: justcopy(0:ubound(arr_in,dim=1), 2:5) !This works for "A" GNU,Intel/InteLLVM,lfortran,NAG,IBM. Does not work for "B" AOCC, NVidia, ARM.
! real :: justcopy(0:size(arr_in,dim=1)-1, 2:5) !This works for all compilers
write(*,*)lbound(arr_in,dim=1),ubound(arr_in,dim=1),size(arr_in,1)
write(*,*)lbound(arr_in,dim=2),ubound(arr_in,dim=2),size(arr_in,2)
write(*,*)lbound(justcopy,dim=1),ubound(justcopy,dim=1),size(justcopy,1)
justcopy=arr_in
write(*,*)lbound(justcopy,dim=1),ubound(justcopy,dim=1),size(justcopy,1)
end function justcopy
subroutine evaluate(arr_in1,arr_in2,arr_in3,arr_out1,arr_out2,arr_out3)
real, intent(in) :: arr_in1(:,:)
real, intent(in) :: arr_in2(:,:)
real, intent(in) :: arr_in3(:,:)
real, intent(out) :: arr_out1(:,:)
real, intent(out) :: arr_out2(:,:)
real, intent(out) :: arr_out3(:,:)
real, allocatable :: X(:,:)
arr_out1 = justcopy(arr_in1)
X = justcopy(arr_in2)
arr_out2 = X
arr_out3 = 1.0*justcopy(arr_in3)
write(*,*)"X-- ", lbound(X), ubound(X),size(X,1) !This line is different for "A" and "B" compilers with "ubound"
write(*,*)X
write(*,*)"arr_out1--", lbound(arr_out1), ubound(arr_out1),size(arr_out1,1)
write(*,*)arr_out1
write(*,*)"arr_out2--", lbound(arr_out2), ubound(arr_out2),size(arr_out2,1)
write(*,*)arr_out2
write(*,*)"arr_out3--", lbound(arr_out3), ubound(arr_out3),size(arr_out3,1)
write(*,*)arr_out3
!With ubound arr_out3=arr_out2 != arr_out1 != X
end subroutine evaluate
end program aocc_run_test
It seems the main difference is the way the specification part of the code work. I have looked into the 7.1.11 of https://j3-fortran.org/doc/year/10/10-007r1.pdf and my reading is that the code with ubound
should work, as ubound
is allowed in the specification. But I’m not sure and would appreciate hearing your opinion on this.
Best regards,
Andrii