pletnes/foo.f90

## foo.f90
program archaic
    implicit none
    ! This is actually a program input
    integer, parameter :: M = 10000
    integer, allocatable, dimension(:) :: iwork
    integer, pointer, dimension(:) :: ptr
    integer, pointer, dimension(:,:) :: ptr_remap
    integer :: i, start, length

    nullify(ptr)

    allocate(iwork(M))

    do i = 1, M
        iwork(i) = i
    end do

    start = 10
    length = 10

    call routine(iwork(start), length)

    ptr => array_ptr(iwork, start, length)

    call modern_routine(ptr, .false.)

    ! Doing it in 2 steps works fine with
    !   ifort       2015/2016
    !   nagfor      6.0
    !   gfortran    4.8.5 (ubuntu 14.04)
    !   gfortran    5.3.0 (ubuntu 14.04)
    ptr => array_ptr(iwork, start, length)
    ptr_remap(1:2, 1:5) => ptr
    call modern_2(ptr_remap)

    ! Compile-time segfaults occur for:
    !   ifort       15.0.3.187 Build 20150407
    !   gfortran    4.8.5 (ubuntu 14.04)
    !   gfortran    5.3.0 (ubuntu 14.04)
    ! Compiles and runs, but gives weird behavior for:
    !   ifort       16.0.2.181 Build 20160204
    ! Compiles and runs, behaves in an intuitive fashion on
    !   pgfortran   15.7-0, 32-bit version
    !   nagfor      6.0
    ptr_remap(1:2, 1:5) => array_ptr(iwork, start, length)  ! sed-tag-here
    call modern_2(ptr_remap)                                ! sed-tag-here

    ! Crashes due to bounds check, if enabled
    call modern_routine(ptr, .true.)

contains
    subroutine modern_routine(part, fail)
        implicit none
        integer, intent(in) :: part(:)
        logical, intent(in) :: fail

        integer :: i

        write (*,*) "Modern routine output:"
        do i = 1, size(part)
            write (*,'(i10)', advance='no') part(i)
        end do
        write (*,*)

        ! This fails the bounds check if commented out. Getting bounds check
        ! and actual rank 2 / rank 3 arrays is the rationale for all of this.

        if (fail) then
            write (*,*) "Modern routine has bounds check!"
            write (*,'(i10)', advance='no') part(size(part) + 1)
            write (*,*)
        end if

    end subroutine modern_routine

    subroutine modern_2(part)
        implicit none
        integer, intent(in) :: part(:,:)
        integer :: i, j

        write (*,*) "Modern rank 2 routine output:"
        do i = 1, size(part, 2)
            do j = 1, size(part, 1)
                write (*,'(i10)', advance='no') part(j, i)
            end do
        end do
        write (*,*)
    end subroutine modern_2

    function array_ptr(iwork, start, length)
        implicit none
        integer, pointer :: array_ptr(:)
        integer, target, intent(in) :: iwork(:)
        integer, intent(in) :: start, length

        ! Start and length is found via some logic; skipped this for brevity.
        ! This is the reason for writing the function array_ptr.
        array_ptr => iwork(start : start + length - 1)
    end function array_ptr


end program archaic


subroutine routine(part, n)
    implicit none
    integer :: part(*)
    integer :: n
    integer :: i

    write (*,*) "Archaic routine output:"
    do i = 1, n
        write (*,'(i10)', advance='no') part(i)
    end do
    write (*,*)

    ! This is not bounds checked
    write (*,*) "Archaic routine has no bounds check:"
    write (*,'(i10)', advance='no') part(n + 1)

    write (*,*)

end subroutine routine
	program archaic
	implicit none
	! This is actually a program input
	integer, parameter :: M = 10000
	integer, allocatable, dimension(:) :: iwork
	integer, pointer, dimension(:) :: ptr
	integer, pointer, dimension(:,:) :: ptr_remap
	integer :: i, start, length

	nullify(ptr)

	allocate(iwork(M))

	do i = 1, M
	iwork(i) = i
	end do

	start = 10
	length = 10

	call routine(iwork(start), length)

	ptr => array_ptr(iwork, start, length)

	call modern_routine(ptr, .false.)

	! Doing it in 2 steps works fine with
	! ifort 2015/2016
	! nagfor 6.0
	! gfortran 4.8.5 (ubuntu 14.04)
	! gfortran 5.3.0 (ubuntu 14.04)
	ptr => array_ptr(iwork, start, length)
	ptr_remap(1:2, 1:5) => ptr
	call modern_2(ptr_remap)

	! Compile-time segfaults occur for:
	! ifort 15.0.3.187 Build 20150407
	! gfortran 4.8.5 (ubuntu 14.04)
	! gfortran 5.3.0 (ubuntu 14.04)
	! Compiles and runs, but gives weird behavior for:
	! ifort 16.0.2.181 Build 20160204
	! Compiles and runs, behaves in an intuitive fashion on
	! pgfortran 15.7-0, 32-bit version
	! nagfor 6.0
	ptr_remap(1:2, 1:5) => array_ptr(iwork, start, length) ! sed-tag-here
	call modern_2(ptr_remap) ! sed-tag-here

	! Crashes due to bounds check, if enabled
	call modern_routine(ptr, .true.)

	contains
	subroutine modern_routine(part, fail)
	implicit none
	integer, intent(in) :: part(:)
	logical, intent(in) :: fail

	integer :: i

	write (,) "Modern routine output:"
	do i = 1, size(part)
	write (*,'(i10)', advance='no') part(i)
	end do
	write (,)

	! This fails the bounds check if commented out. Getting bounds check
	! and actual rank 2 / rank 3 arrays is the rationale for all of this.

	if (fail) then
	write (,) "Modern routine has bounds check!"
	write (*,'(i10)', advance='no') part(size(part) + 1)
	write (,)
	end if

	end subroutine modern_routine

	subroutine modern_2(part)
	implicit none
	integer, intent(in) :: part(:,:)
	integer :: i, j

	write (,) "Modern rank 2 routine output:"
	do i = 1, size(part, 2)
	do j = 1, size(part, 1)
	write (*,'(i10)', advance='no') part(j, i)
	end do
	end do
	write (,)
	end subroutine modern_2

	function array_ptr(iwork, start, length)
	implicit none
	integer, pointer :: array_ptr(:)
	integer, target, intent(in) :: iwork(:)
	integer, intent(in) :: start, length

	! Start and length is found via some logic; skipped this for brevity.
	! This is the reason for writing the function array_ptr.
	array_ptr => iwork(start : start + length - 1)
	end function array_ptr


	end program archaic


	subroutine routine(part, n)
	implicit none
	integer :: part(*)
	integer :: n
	integer :: i

	write (,) "Archaic routine output:"
	do i = 1, n
	write (*,'(i10)', advance='no') part(i)
	end do
	write (,)

	! This is not bounds checked
	write (,) "Archaic routine has no bounds check:"
	write (*,'(i10)', advance='no') part(n + 1)

	write (,)

	end subroutine routine