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

CCCCCCCCCCCCCCCCCC
C
C	FUNCTION KIND(REAL,STRING)
C
C	READS NEXT 'THING' FROM FORTRAN UNIT 4
C	IF 'THING' IS A REAL NUMBER, RETURNS
C	KIND=1, REAL=THE NUMBER
C
C	IF 'THING' WAS A 'QUOTED STRING', RETURNS
C	KIND= -1, STRING= 'THE STRING' IN 2A6 FORMAT.
C
C	IF 'THING' WAS AN END OF LINE, RETURNS
C	KIND=0, STRING AND REAL ARE UNDEFINED
C
C	IF 'THING' WAS NOT A LEGAL NUMBER OR QUOTED STRING, RETURNS
C	KIND=-1, REAL=UNDEFINED, STRING=CHARACTERS UP TO NEXT SPACE
C	STRING(1)=CHARACTER IN A1 FORMAT
C
CCCCCCCCCCCCCCCCCCCCCCC
SOPDEF	JMPI	5400
SOPDEF	TADI	1400
	FUNCTION KIND(REAL,ISTRNG)
	DIMENSION ISTRNG(6),LINE(12)
	REAL=0.0
	ISIGN=1
	KRUNCH=0
	DIV=0.1
S\1001,	JMS	CHAR
C****	CHECK FOR QUOTE
	IF(IC-39)1099,90,1099
1099	IF(IC-43)1002,1001,1002
1002	IF(IC-45)4,3,4
3	ISIGN=-ISIGN
	GO TO 1001
4	IF(IC-32)5,1001,5
S\11,	JMS	CHAR
5	IF(IC-46)6,1007,6
6	IF(IC-48)99,8,8
8	IF(IC-58)1009,99,99
C***	IT'S A DIGIT!!
1009	REAL=REAL*10.0+FLOAT(IC-48)
	KRUNCH=1
	GO TO 11
C
C***	PAST DECIMAL POINT ***
C
S\1007,	JMS	CHAR
	IF(IC-48)99,15,15
15	IF(IC-58)16,99,99
C***	DIGIT!
16	REAL=REAL+(DIV*FLOAT(IC-48))
	DIV=DIV/10.0
	KRUNCH=1
	GO TO 1007
C
C	END OF NUMBER, FIXUP SIGN
C
C****	SEE IF WE ACCUMULATED ANYTHING
99	IF(KRUNCH)747,747,992
992	IF(ISIGN)100,101,101
100	REAL=-REAL
101	KIND=1
	RETURN
C***	UNQUOTED STRING
747	IEND = 32
	I=0
	GOTO 936
C
C****	SCAN QUOTED STRING
C
90	IEND = 39
979	I=0
S\91,	JMS	CHAR	/GET A CHAR
936	IF(IC-IEND)94,95,94
94	I=I+1
	IF(I-12)93,93,91
S\93,	TAD	\IC
S	AND	(77
S	DCA	\IC
	LINE(I)=IC
	GOTO 91

95	J=I+1
	DO 96 I=J,12
96	LINE(I)=0
	DO 92 I=1,6
	J=I+I
92	ISTRNG(I)=LINE(J-1)*64+LINE(J)
	KIND=-1
	REAL=0.0
	RETURN
C	SUBROUTINE 'CHAR': IC<-- EDITED CHAR
C	IGNORES CONTROL CHARS
SCHAR,	0	/ENTRY-EXIT
998	CALL CHRIO(-4,IC)
S	TAD	\IC
S	AND	(177
S	DCA	\IC
	IF(IC-26)981,982,981
981	IF(IC-10)995,919,995
995	IF(IC-13)996,997,996
996	IF(IC-32)998,994,994
997	CONTINUE
	IC=32
S\994,	JMP I	CHAR	/RETURN

C****	LINE FEED FOUND.. RETURN EOL
919	KIND=0
	REAL=0.0
	RETURN
C****	^Z FOUND, GOTO EXIT POINT IF ONE IS ACTIVE
982	CONTINUE
S	TAD	RTFLD	/RETURN ACTIVE?
S	SNA CLA
	GOTO 747
SRTFLD,	0		/RETURN CDF CIF FIELD
S	JMPI	RTADR	/YES, GO TO EXIT ROUTINE
SRTADR,	0
C
C****	EOF: SET EOF EXIT ADDRESS
C	CALL	1,EOF
C	ARG	\####
C			'THING' EXITS TO LINE NUMBER ###
C			WHEN IT ENCOUNTERS END-OF-FILE ON
C			FORTRAN UNIT 4
C
S	ENTRY	EOF
S	CPAGE	22
SS,
SEOF,	0;0
S	TAD	S
S	DCA	\FL
S\FL,	HLT
S	TADI	S#
S	IAC		/MAKE A CDF CIF
S	DCA	RTFLD	/GET RETURN FIELD
S	INC	S#
S	TADI	S#
S	INC	S#
S	DCA	RTADR	/SAVE RETURN ADDRESS
S	RETRN	EOF
	END