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