https://gcc.gnu.org/bugzilla/show_bug.cgi?id=105558

--- Comment #10 from federico <federico.perini at gmail dot com> ---
Hi Sam, 

Thanks for looking into it - here is a simplified version of the test program:
you can also test it live at the Compiler Explorer, at this link:
https://godbolt.org/z/r63G348hM

Thanks,
Federico

module subs
    use iso_fortran_env, only: ip => int8
    implicit none

    contains

    ! from two indices in [1:6] and [1:32], create a unique int8 code
    elemental integer(ip) function ENCODE(i,j)
        integer(ip), intent(in) :: i   ! loops in [1:6] range
        integer(ip), intent(in) :: j   ! loops in [1:32] range
        integer(ip) :: k
        ENCODE = -122_ip + i 
        do k=1_ip,j+1_ip
          ENCODE = ENCODE+6_ip
        end do  
    end function ENCODE

    elemental subroutine DECODE(code,i,j)
        integer(ip), intent(in)  :: code
        integer(ip), intent(out) :: i,j

        select case (code)
           case (-121_ip:82_ip)

              i = code
              j = -1_ip

              ! Child ID loop
              do while (i>-116_ip)
                 j = j+1_ip
                 i = i-6_ip
              end do

              i = i+122_ip

           case default
              i = -huge(i)
              j = -huge(j)
        end select
    end subroutine DECODE
end module subs

program test_int1
  use iso_fortran_env, only: ip => int8
  use subs
  implicit none

  integer(ip) :: i,j,code,id,jd
  logical :: success
  integer :: errors

  errors = 0
  do j=1_ip,32_ip
     do i=1_ip,6_ip
        code = ENCODE(i,j)
        call DECODE(code,id,jd)
        if (i/=id .or. j/=jd) then 
           errors = errors+1
           print *, 'i=',i,' j=',j,' code=',code, &
                    merge('error','     ',i/=id.or.j/=jd) 
        endif 
     end do
  end do

  success = errors==0

  print *, merge('SUCCESS!','ERROR   ',errors==0)
  if (errors>0) print "(*(i0,a))", errors,'/',6_ip*32_ip,' decoding errors '

end program test_int1

Reply via email to