!+
! Function in4hetn (prompt, ivec, n_vec) result (istat)
!
! Prompt for and get an array of integers Entered in Hexadecimal
! Retry if ill formed.
! Return input value if <cr> entered.
! If "@" is the last non-blank char of prompt, "<CR = nnnn, ...>" will be substituted
!   in place of the "@" where "nnnn, ..."  are the default (input) values.
! 
! Input:
!   prompt   -- Character(*): Prompt string.
!   ivec(*)  -- Integer: Input array values will be used as the default.
!
! Output:
!   ivec(*) -- Integer: Return values.
!   istat   -- Integer: Status. 1 = OK. -1 = 'QUIT' typed.
!-

function in4hetn(prompt, ivec, n_vec) result (istat)
use str_find_mod
implicit none

integer ivec(*), ival,dig,i,j, n,  ic, istat, n_vec,llen
character(*) prompt
character(100) line, prompt2, c*1
logical inhex

prompt2 = prompt
n = len_trim(prompt2)
if (prompt2(n:n) == '@') then
  prompt2(n:) = '<CR ='
  do i = 1, n_vec
    n = len_trim(prompt2)
    write (prompt2(n+2:), '(z0, a)') ivec(i), ','
  enddo
  n = len_trim(prompt2)
  prompt2(n:n) = '>'
endif

istat = 1

1 write (*, '(1x, 2a)', advance = 'no') trim(prompt2), ' '

read '(a)', line   ; call str_upcase(line, line) ; llen=len_trim(line)
if (line == 'QUIT') then ;  istat = -1 ; return ;endif
i=1 ; inhex=.false. ; ival=0

do j=1,llen
 c=line(j:) ; ic=ichar(c)
 select case(ic)
  case(9,32)      !blank or tab
   if(inhex) then
    inhex=.false. ; i=i+1 ;if(i.gt.n_vec) return
   endif
  case(48:57,65:70) !legal Hex digit
   if(.not.inhex) ival=0
   inhex=.true. ;dig=ic-48 ; if(dig.gt.9) dig=10+ic-65
   ival=ival*16+dig ;ivec(i)=ival
  case default
   print *, ' BAD HEX INPUT! Retry or type "QUIT"' ; GOTO 1
 end select   
enddo

end function