FORTRAN: pghpf_maxloc_i8 has no acc info & maxloc inside subroutine

Hi,

When used in subroutine maxloc seems to be replaced by pghpf_maxloc_i8 without acc routine info. But direct usage in program unit is ok. Is there a workaround?

program pro
    use mdl
    implicit none
    real(8) :: arr(100,100)
    integer :: pos(100)
    integer :: i
    
    arr = reshape([(real(mod(i,100)),i=1,100*100)],shape(arr))
     
    !$acc data copy(arr(:,:),pos(:)) 
    !$acc parallel loop
    do i=1,100,1
        pos(i) = fun(arr(:,i))
    end do
    !$acc end data
    write(*,*) sum(pos)/99
    
end program pro



module mdl
    implicit none
    contains
    
    pure integer function fun(arr)
        !$acc routine seq
        real(8), intent(in), dimension(:) :: arr
        fun = maxloc(arr**2,1)
    end function fun

end module mdl



pgfortran -o pro -fast -ta=tesla:cc60 mdl.f90 pro.f90 
mdl.f90:
PGF90-S-1000-Call in OpenACC region to procedure 'pghpf_maxloc_i8' which has no acc routine information (mdl.f90: 9)
  0 inform,   0 warnings,   1 severes, 0 fatal for fun
pro.f90:

I think it should be supported. Someone else who will know for certain might chime in, in any case, TPR #27582 is filed to track the issue.

MAXVAL works just fine, can be used to define new MAXLOC

    ! MAXLOC (PGFORTRAN 19.4)
    PURE INTEGER FUNCTION MAXLOC_(ARR)
        !$ACC ROUTINE SEQ
        REAL(RK),DIMENSION(:),INTENT(IN) :: ARR
        REAL(RK),DIMENSION(SIZE(ARR)) :: LIS
        REAL(RK) :: VAL
        INTEGER :: I
        VAL=MAXVAL(ARR)
        DO I=1,SIZE(ARR),1
            IF(ARR(I)==VAL)THEN
                MAXLOC_=I
                RETURN
            END IF
        END DO
    END FUNCTION MAXLOC_