Directory of image this file is from
This file as a plain text file

	SUBROUTINE GTCHR(ICHAR,FILNAM,IRSTW,IEOF,IRJUST)
C GETS SEQUENTIAL CHARACTERS IN 6-BIT ASCII RIGHT JUSTIFIED FROM
C THE SPECIFIED ".DA" FILE. SWITCH IRSTW IS USED TO REOPEN A FILE
C AT THE START OF THE FILE OR TO GET THE NEXT CHARACTER IN THE FILE
C THE FILE EOF IS DETECTED BY THE EOF(IFLAG) ROUTINE WHICH DETECTS
C CONTROL/Z CHARACTERS. A LINE MAY BE UP TO 127 CHARACTERS LONG
C ANY LEGAL 6-BIT CHARACTER IS ALLOWED
C ARGUMENTS :
C  ICHAR  = NEXT CHAR IN THE FILE (=-1 AT END OF LINE)
C  FILNAM = THE *.DA ASCII SOURCE FILE NAME
C  IRSTSW = 0 TO GET THE NEXT CHARACTER
C         = 1 TO REOPEN A FILE
C	  = 2 PRINT OUT THE CURRENT LINE ON THE OUTPUT DEVICE
C	  = 3 TO UNDERLINE THE CURRENT CHARACTER IN THE LINE
C  IEOF   = 0 NO EOF FOUND ON THIS CHARACTER
C	  = 1 EOF FOUND ON THIS CHARACTER
C  IRJUST = 0 TO LEFT JUSTIFY
C	  = 1 TO RIGHT JUSTIFY
C FORTRAN II / OPTION (I)
C SR : UTILEO.SB
	DIMENSION IA(128)
	IERRMSG=1
C SWITCH OFF THE EOF SWITCH
	IEOF=0
C TEST IF THE FILE IS TO BE OPENED
	IF(IRSTW-1)2,1,20
C DO A SYS LOOKUP OF THE FILENAME
1	CALL IOPEN('SYS',FILNAM)
C RESET THE EOF FLAG
	CALL EOF(ICHY)
	IEND=0
C ISPACE IS THE VALUE OF "SPACE" LEFT JUSTIFIED
	ISPACE=32*64+32
	ICOUNT=0
C GET THE NEXT CHARACTER
C TEST IF NEED A NEW BUFFER
2	IF(ICOUNT-IEND)10,3,10
C NEED A NEW BUFFER - ZERO IT OUT FIRST
3	DO 4 I=1,128
4	IA(I)=0
	READ(4,101)(IA(J),J=1,128)
101	FORMAT(128A1)
C NOW PUSH A CARRIAGE RETURN
C TEST IF THERE ARE EXTRA SPACES AT THE END OF THE LINE
	DO 6 K=1,127
	L=128-K
C COUNT BACKWARDS - SEE IF ZERO
	ISSS=IA(L)-ISPACE
	IF(ISSS)7,6,7
6	CONTINUE
7	IEND=L
C WHERE IEND IS THE INDEX OF THE LAST NON SPACE CHARACTER
	ICHAR=-1
	ICOUNT=0
	RETURN
C NOW GET THE DATA CHARACTER REQUESTED
10	ICOUNT=ICOUNT+1
C STRIP OFF THE SPACE IN THE SECOND CHARACTER POSITION
	ICHAR=IA(ICOUNT)-32
C RIGHT JUSTIFY
S	CLA CLL
S	TAD I \ICHAR
S	RTR;RTR;RTR
S	AND (0077
S	DCA \ICH	/ SAVE IT
C TEST IF RIGHT JUSTIFY
	IF(IRJUST-1)17,16,17
16	ICHAR=ICH
C TEST IF EOF
17	CALL EOF(ICHY)
	IF(ICHY+1)19,18,19
18	IEOF=1
19	RETURN
C SEE IF PRINT OR UNDERLINE IT
20	IF(IRSTW-2)22,22,23
22	WRITE(IERRMSG,101)(IA(K),K=1,IEND)
	RETURN
C UNDERLINE IT
23	ISPC=32*64
	K1=ICOUNT-1
	IUPAR=30*64
	WRITE(IERRMSG,101)(ISPC,K=1,K1),IUPAR
	RETURN
	END