C RULES.FTN CONVERT ASCII VOTRAX RULES TO INTERNAL FORM IMPLICIT INTEGER(A-Z) PARAMETER STRL=900,VTRL=700,RULL=350 BYTE STR,VOT,VSP,VSK,IN(80),IT(10),BCOMP,ICH COMMON /RULES/ IRUL(0:95),RULA(RULL),RULB(RULL),RULC(RULL), C RULD(RULL),STR(STRL),VOT(VTRL),IST,IVT COMMON /VSP/ VSP(4,0:63) C IRP=1 IST=1 IVT=1 DO 31 I=0,95 31 IRUL(I)=0 OPEN(UNIT=1,NAME='RULES.VSK',TYPE='OLD',READONLY) 1 READ (1,101,END=20) IN 101 FORMAT(80A1) IF(IN(1).NE.'+') GO TO 1 IF(IRP.GT.RULL) GO TO 35 DO 17 I=1,80 IN(I)=BAND("177,IN(I)) 17 IF(IN(I).GE.96) IN(I)=IN(I)-32 DO 2 I=2,80 IF(IN(I).NE.' '.AND.IN(I).NE."11) GO TO 3 2 CONTINUE GO TO 1 3 IA=I+1 IB=IA-1 4 IB=IB+1 IF(IN(IB).NE.'[') GO TO 4 IAL=IB-IA IB=IB+1 IC=IB 6 IC=IC+1 IF(IN(IC).NE.']') GO TO 6 IBL=IC-IB IN(IC)=0 IC=IC+1 ID=IC 8 ID=ID+1 IF(IN(ID).NE.'[') GO TO 8 ICL=ID-IC-1 IN(ID-1)=0 ID=ID+1 ICH=IN(IB) IF(IRUL(ICH).EQ.0) IRUL(ICH)=IRP IF(IAL.LT.1) GO TO 7 DO 9 I=1,IAL 9 IT(IAL-I+1)=IN(IA+I-1) 7 IT(IAL+1)=0 CALL INSERT(IT,IAL,IL) RULA(IRP)=IL CALL INSERT(IN(IB),IBL,IL) RULB(IRP)=IL CALL INSERT(IN(IC),ICL,IL) RULC(IRP)=IL ITP=0 10 IF(IN(ID).EQ.'\') GO TO 15 DO 11 IDE=ID,80,1 IF(IN(IDE).EQ.' '.OR.IN(IDE).EQ.']') GO TO 12 11 CONTINUE STOP 'ERROR - D STRING SYNTAX' 12 IN(IDE)=0 DO 13 I=0,63 IF(BCOMP(IN(ID),VSP(1,I)).EQ.1) GO TO 14 13 CONTINUE WRITE (5,201) IN 201 FORMAT(1X,80A1) STOP 'ERROR - ILLEGAL D STRING CODE' 14 ITP=ITP+1 IT(ITP)=I ID=IDE+1 GO TO 10 15 IT(ITP+1)=0 CALL INSERV(IT,ITP,IL) RULD(IRP)=IL IRP=IRP+1 GO TO 1 20 CLOSE(UNIT=1) OPEN(UNIT=2,NAME='RULES.PAR',TYPE='UNKNOWN',FORM='UNFORMATTED') WRITE (2) IRUL,RULA,RULB,RULC,RULD,STR,VOT CLOSE(UNIT=2) CALL EXIT C 35 STOP 'ERROR - RULE OVERFLOW' END SUBROUTINE INSERT(SA,LSA,LOCA) IMPLICIT INTEGER(A-Z) PARAMETER STRL=900,VTRL=700,RULL=350 BYTE STR,VOT,BCOMP,SA(80),SB(80) COMMON /RULES/ IRUL(0:95),RULA(RULL),RULB(RULL),RULC(RULL), C RULD(RULL),STR(STRL),VOT(VTRL),IST,IVT IF(IST.EQ.0) GO TO 2 DO 1 I=1,IST IF(BCOMP(SA,STR(I)).EQ.1) GO TO 4 1 CONTINUE 2 LOCA=IST+1 DO 3 I=1,LSA+1 IST=IST+1 IF(IST.GT.STRL) GO TO 25 3 STR(IST)=SA(I) RETURN 4 LOCA=I RETURN C ENTRY INSERV(SB,LSB,LOCB) IF(IVT.EQ.0) GO TO 12 DO 11 I=1,IVT IF(BCOMP(SB,VOT(I)).EQ.1) GO TO 14 11 CONTINUE 12 LOCB=IVT+1 DO 13 I=1,LSB+1 IVT=IVT+1 IF(IVT.GT.VTRL) GO TO 25 13 VOT(IVT)=SB(I) RETURN 14 LOCB=I RETURN 25 STOP 'ERROR - TABLE OVERFLOW' END