SUBROUTINE SCAN CALL SCANNT(1) RETURN END SUBROUTINE CHEW CALL SCANNT(2) RETURN END SUBROUTINE SCANNT(IZ) LOGICAL*1 IHS,IHR,IHC,IHK,IHE,IHF,IHBLANK,IHDOT,IHP,IHB + ,IHSTAR,IHT,IHQUEST,IHNUM COMMON/HOLLER/IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED, +IHYELLO,IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB +,IHT,IHNUM REAL*8 AITEM,TITEM COMMON/SCANBF/KEY,AITEM EQUIVALENCE (FNUM,AITEM) BYTE LINE(80),KHAR,ITEM(8) EQUIVALENCE (TITEM,ITEM) DATA ICH,KHAR,ITEM/80,1H ,0,0,0,0,0,0,0,0/ GOTO (4,600),IZ C--------READ IN NEW LINE IF NEEDED. 4 IF(ICH.LT.80) GO TO 5 READ (5,100,ERR=700,END=900) ICHAR,LINE 100 FORMAT (Q,80A1) LINE(ICHAR+1)=0 5 AITEM=0 ASSIGN 10 TO IRET 10 IF(KHAR .EQ. 32) GO TO 500 C--------IF END-OF LINE IS HIT, RETURN WITH AITEM=0. IF(ICHAR.EQ.0) GOTO 15 IF(KHAR.NE.0) GOTO 20 15 KEY=IHEOL GO TO 600 C--------IF INPUT IS NOT NUMERIC, PACK ALL CHARACTERS TOGETHER UP TO C A BLANK OR END-OF-LINE, AND RETURN IN 10H FORMAT. 20 IF(KHAR.EQ.43 .OR. KHAR.EQ.45 .OR. KHAR.EQ.46) GO TO 40 IF(KHAR.GE.48 .AND. KHAR.LE.57) GO TO 40 IF(KHAR .LT. 65 .OR. KHAR .GT. 90) GO TO 500 KEY=IHALPHA ASSIGN 25 TO IRET ICHX=1 GO TO 26 25 ICHX=ICHX+1 IF(KHAR .EQ. 0 .OR. KHAR .EQ. 32) GOTO 30 26 IF(ICHX .LE. 8) ITEM(ICHX)=KHAR GOTO 500 30 IF(ICHX.GT.8) GOTO 35 DO 34 IT=ICHX,8 34 ITEM(IT)=32 35 AITEM=TITEM RETURN C--------INPUT IS NUMERIC. RETURN AS A REAL NUMBER. 40 KEY=IHREAL SIGN=1.0 KEXPON=0 KFRACT=0 ASSIGN 50 TO IRET IF(KHAR .EQ. 43) GO TO 500 IF(KHAR .NE. 45) GO TO 50 SIGN=-1.0 GO TO 500 50 IF(KHAR.LT.48 .OR. KHAR.GT.57) GO TO 60 IT=KHAR FNUM=10.0*FNUM+FLOAT(IT-"60) KEXPON=KEXPON-KFRACT GO TO 500 60 IF(KHAR .NE. 46) GO TO 70 IF(KFRACT .NE. 0) GO TO 15 KFRACT=1 GO TO 500 70 AITEM=SIGN*AITEM*10.0**KEXPON RETURN C--------ROUTINE TO RETURN NEXT CHARACTER IN 32FORMAT 500 ICH=ICH+1 IF(ICH .GT. 80) ICH=1 KHAR=LINE(ICH) GO TO IRET C* C ENTRY CHEW C--------DISCARD REMAINDER OF LAST LINE READ IN. 600 ICH=80 KHAR=32 RETURN 700 CALL PROUT(15HTTY READ ERROR.,15) GO TO 4 900 CONTINUE CALL EXIT END