#
#  INPUT-OUTPUT ROUTINES USING QIO'S.
#
#  BY BOB STODOLA, SEPTEMBER 1980
#  MODIFIED FOR VAXEN BY WILLIAM WOOD  NOV. 1980
#
SUBROUTINE IOINIT
IMPLICIT INTEGER (A-Z)
BYTE BUF
COMMON /IOBUFR/ ICHNL,BUFSIZ,NBUF,BUF(1)
%
      CHARACTER*63 PNAM
%
 
CALL SYS$TRNLOG('SYS$INPUT', ILEN, PNAM, , , )
CALL SYS$ASSIGN(PNAM(5:ILEN), ICHNL, , )
#$TYPE *,' ICHNL = ',ICHNL
RETURN
END
 
 
 
SUBROUTINE OUTCH(OUTPUT,COUNT)
IMPLICIT INTEGER (A - Z)
BYTE OUTPUT(1)
#
#	THE USER MUST SET UP AN INTERNAL BUFFER BY DEFINING A COMMON
#	AREA IOBUFR.  TO ALLOCATE 2000 BYTES TO THESE ROUTINES, TYPE:
#		INTEGER ICHNL, BUFSIZ
#		BYTE BUF
#		COMMON/IOBUFR/ ICHNL, BUFSIZ, NBUF, BUF(2000)
#		BUFSIZ = 2000
#	THE DEFAULT SIZE IS 3000 BYTES.
#
#	CALL OUTCH(BUF,COUNT)
#	BUF	==> CHARACTER(S) TO OUTPUT
#	COUNT	==> NUMBER OF CHARACTERS TO OUTPUT.  IF ZERO, THE
#		    INTERNAL BUFFER IS FLUSHED. IF -1, THE INTERNAL
#		    BUFFER IS FLUSHED WITH A TRAILING CARRIAGERETURN.
#
#	NOTE:	A CALL TO INCHAR WILL ALSO FLUSH THE BUFFER!
#
PARAMETER DEFSIZ = 3000
BYTE BUF
COMMON /IOBUFR/ ICHNL,BUFSIZ,NBUF,BUF(DEFSIZ)
DATA BUFSIZ,NBUF/DEFSIZ,0/

IF (COUNT <= 0) CALL FLUSH(COUNT)
ELSE
  DO IP = 1,COUNT [
    IF (NBUF >= BUFSIZ-1) CALL FLUSH(0)
    NBUF = NBUF+1
    BUF(NBUF) = OUTPUT(IP)
    ]
RETURN
END

SUBROUTINE FLUSH(CRFLAG)
IMPLICIT INTEGER (A - Z)
BYTE BUF
COMMON /IOBUFR/ ICHNL,BUFSIZ,NBUF,BUF(1)
%
      EXTERNAL IO$_WRITEVBLK, IO$M_NOFORMAT
%

IF (NBUF > 0) [
  IF (CRFLAG == -1) [				# DO A <CR> AT END OF LINE
    NBUF = NBUF+1
    BUF(NBUF) = 13
    ]
%
      IWRITE = %LOC(IO$_WRITEVBLK)  .OR.  %LOC(IO$M_NOFORMAT)
%
CALL SYS$QIOW( , %VAL(ICHNL), %VAL(IWRITE), , , , BUF, %VAL(NBUF), , %VAL(0),
               , )
  NBUF = 0
  ]
RETURN
END

SUBROUTINE INCHAR(INPUT,SIZE,ECHO,TIMOUT,COUNT,IERR)
IMPLICIT INTEGER (A - Z)
BYTE INPUT(1)
LOGICAL ECHO
#
#	CALL INCHAR(INPUT,SIZE,ECHO,TIMOUT,COUNT,IERR)
#	INPUT	<== BUFFER TO ACCEPT INPUT
#	SIZE	==> LENGTH OF THIS BUFFER
#	ECHO	==> .TRUE. FOR ECHO, .FALSE. FOR NO ECHO.
#	TIMOUT	==> -1 FOR NO TIMEOUT, ELSE 0-? FOR TIMOUT SECONDS
#		    TIMEOUT ON INPUT.
#	COUNT	<== NUMBER OF CHARACTERS READ.
#	IERR	<== IERROR CODE RETURNED:
#			>= 0 : TERMINATING CHARACTER FOR LINE ORIENTED INPUT
#			-1 : END OF FILE READ
#			-2 : TIMED OUT
#			-3 : OTHER IERROR
#
BYTE BUF
COMMON /IOBUFR/ ICHNL,BUFSIZ,NBUF,BUF(1)
INTEGER*2 IOSB(4)
INTEGER*2 IOER
BYTE TC
%
      EXTERNAL IO$_READVBLK, IO$M_NOECHO, IO$M_TIMED, IO$M_TRMNOECHO,
     *         SS$_TIMEOUT, SS$_NORMAL
%
EQUIVALENCE (IOER, IOSB(1))
EQUIVALENCE (TC, IOSB(3))
 
CALL FLUSH(0)
%
      IOFC = %LOC(IO$_READVBLK)  .OR.  %LOC(IO$M_TRMNOECHO)
%
IF (! ECHO)
%
      IOFC = IOFC  .OR.  %LOC(IO$M_NOECHO)
%
IF (TIMOUT >= 0) [
  P3 = TIMOUT
%
      IOFC = IOFC .OR. %LOC(IO$M_TIMED)
%
  ]
ELSE P3 = 0
ISW =  SYS$QIOW( , %VAL(ICHNL), %VAL(IOFC), IOSB, , , INPUT, %VAL(SIZE),
           %VAL(P3), , , )
COUNT = IOSB(2)
IF (ISW != %LOC(SS$_NORMAL))
  IERR = -3
ELSE IF (IOER == %LOC(SS$_NORMAL)) [
  IF (TC == 26) IERR = -1		# EOF? (^Z)
  ELSE  IERR = TC
  ]
ELSE IF (IOER == %LOC(SS$_TIMEOUT))
  IERR = -2
ELSE
  IERR = -3
#$TYPE *,' IERR=',IERR
RETURN
END