Dear all, I have met a bug, and the code which has extremely simplified, less than 60 lines.
30 lines versions by @Euler-37 here
In the main program, I call subroutine test01, in it I output an array xout.
xout is non-zero.
However, with Intel Fortran OneAPI, with
-O3 -O2 flags,
it simply gives zeros.
With O0 the result is correct.
No matter windows or linux.
However, gfortran has no problem.
Note than, at line 31,
integer ( kind = i8 ), parameter :: n = 10, np = 10
If I set np <=8, the result is correct.
However if np>8, the result becomes all zero which is incorrect,
However, if I add some write statement, such as at line 17, 43, 45. The result become correct again.
Can anyone point out what could be the problem?
Thank you very much indeed!
The code is extremely simple as below,
module constants
implicit none
integer, public, parameter :: i8=selected_int_kind(15)
integer, public, parameter :: r8=selected_real_kind(15,9)
real(kind=r8), public, parameter :: zero=0.0_r8,one=1.0_r8
end module constants
module stochastic_rk
use constants
implicit none
contains
subroutine rk4_ti_step_mod3 ( x, xstar )
implicit none
real(kind=r8), intent(in) :: x
real(kind = r8), intent(out) :: xstar
real(kind = r8) :: ks, xs
xstar = x
!write(6,*) 'x', x
xs = x
ks = - xs * 0.1_r8
xstar = xstar + ks
return
end subroutine rk4_ti_step_mod3
end module stochastic_rk
module tests
implicit none
contains
subroutine test01
use constants
use stochastic_rk
implicit none
integer ( kind = i8 ), parameter :: n = 10, np = 10
integer ( kind = i8 ) :: i, itot, istart, istep, j, k
real ( kind = r8 ) :: x(0:n)
real (kind = r8) :: xout(5,np)
itot = n
istart = itot/5
istep = istart
do j = 1, np
i = 0
x(i) = 20.0_r8
do i = 1, n
call rk4_ti_step_mod3 ( x(i-1), x(i) ) ! check n=10 bug.
!write ( *, '(2x,i8,2x,f14.6,2x,g14.6)' ) i, x(i-1), x(i)
end do
!write (6,'(''x = '',t20, 5(f15.7,1x))') x(istart:itot:istep)
xout(1:5:1,j) = x(istart:itot:istep)
enddo
write (6,'(5(f15.7,1x))') xout
return
end subroutine test01
end module tests
program main
use tests
use stochastic_rk
implicit none
call test01
stop ('Program end normally.')
end program main