#
#  INPUT-OUTPUT ROUTINES USING QIO'S.
#
#  BY BOB STODOLA, SEPTEMBER 1980
#
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 BUFSIZ
#		BYTE BUF
#		COMMON/IOBUFR/ BUFSIZ, NBUF, BUF(2000)
#		BUFSIZ = 2000
#	THE DEFAULT SIZE IS 1000 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/ 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)
%
	PARAMETER IOWAL = "410
%
BYTE BUF
COMMON/IOBUFR/ BUFSIZ,NBUF,BUF(1)
DIMENSION DPB(6)
DATA DPB/6*0/

IF (NBUF > 0) [
  IF (CRFLAG == -1) [				# DO A <CR> AT END OF LINE
    NBUF = NBUF+1
    BUF(NBUF) = 13
    ]
  CALL GETADR(DPB,BUF)
  DPB(2) = NBUF
  CALL WTQIO(IOWAL,5,5,,,DPB)
  NBUF = 0
  ]
RETURN
END

SUBROUTINE INCHAR(INPUT,SIZE,ECHO,TIMOUT,COUNT,ERR)
IMPLICIT INTEGER (A - Z)
BYTE INPUT(1)
LOGICAL ECHO,LINE
#
#	CALL INCHAR(INPUT,SIZE,ECHO,TIMOUT,COUNT,ERR)
#	BUF	<== 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*10 SECOND
#		    TIMEOUT ON INPUT.
#	COUNT	<== NUMBER OF CHARACTERS READ.
#	ERR	<== ERROR CODE RETURNED:
#			>0 = TERMINATING CHARACTER FOR LINE ORIENTED INPUT
#			-1 = END OF FILE READ
#			-2 = TIMED OUT
#			-3 = OTHER ERROR
#
BYTE BUF
COMMON/IOBUFR/ BUFSIZ,NBUF,BUF(1)
DIMENSION DPB(6),IOSB(2)
BYTE IOER,SB(2),TC
EQUIVALENCE (IOER,SB,IOSB), (SB(2),TC)
%
	PARAMETER IORVB = "10400
	PARAMETER TFRNE = "20
	PARAMETER TFTMO = "200
	PARAMETER IEEOF = -10, ISTMO = 2
%
CALL FLUSH(0)
IOFC = IORVB
IF ( ! ECHO) IOFC = IOFC .OR. TFRNE
IF (TIMOUT >= 0) [
  DPB(3) = TIMOUT
  IOFC = IOFC .OR. TFTMO
  ]
ELSE DPB(3) = 0
CALL GETADR(DPB,INPUT)
DPB(2) = SIZE
CALL WTQIO(IOFC,5,5,,IOSB,DPB,ISW)
COUNT = IOSB(2)
IF (ISW >= 0) [
  IF (IOER == IEEOF) ERR = -1
  ELSE IF (IOER == ISTMO) ERR = -2
  ELSE IF (IOER > 0) ERR = TC
  ELSE ERR = -3
  ]
ELSE ERR = -3
RETURN
END