FTN4 SUBROUTINE REPOP(I,J,IERR),92069-16061 REV. 1912 781017 INTEGER I,J,IERR C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18099 C RELOC: 92069-16060 C C C************************************************************ C C INTEGER R8,R9 INTEGER SPACE(3),SKIP(2),ADD(2),COUNT(3),AVER(4) INTEGER A1,A2,A3,A4,A5,B1,B2,B3,B4,B5 INTEGER EZ,E0,E1,E2,E3,E4,E5,E6,E7,E8,E9 INTEGER A,B C C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ DATA SPACE/2HSP,2HAC,2HE / DATA SKIP/2HSK,2HIP/ DATA ADD/2HAD,2HD / DATA COUNT/2HCO,2HUN,2HT / DATA AVER/2HAV,2HER,2HAG,2HE / DATA A1/2HA1/ DATA A2/2HA2/ DATA A3/2HA3/ DATA A4/2HA4/ DATA A5/2HA5/ DATA B1/2HB1/ DATA B2/2HB2/ DATA B3/2HB3/ DATA B4/2HB4/ DATA B5/2HB5/ DATA EZ/2HEZ/ DATA E0/2HE0/ DATA E1/2HE1/ DATA E2/2HE2/ DATA E3/2HE3/ DATA E4/2HE4/ DATA E5/2HE5/ DATA E6/2HE6/ DATA E7/2HE7/ DATA E8/2HE8/ DATA E9/2HE9/ DATA A/101B/ DATA B/102B/ C C FORM REPORT OPTIONS C C IERR = 0 NORMAL RETURN C IERR =-1 ERROR RETURN C I2 = 0 I3 = 0 I4 = 0 I5 = 0 I6 = 0 I7 = 0 I8 = 0 I9 = 0 R8 = 0 C C GET OPTION 10 CALL LSCAN(IB,I,J,K) C IF SEMI-COLON - WRAPUP IF (K.EQ.5) GO TO 55 20 IF(J-I.NE.4) GOTO 90 IF (JSCOM(SPACE,1,5,IB,I,IERR).NE.0) GO TO 90 C C SPACE OPTION C C GET SPACE CONTROL CALL LSCAN (IB,I,J,K) C C ONE OR TWO CHARACTERS IF (I.NE.J) GO TO 80 C C ONE CHARACTER C IS IT A "B" C CALL SGET(IB,I,ICHAR) IF (ICHAR.NE.B) GO TO 60 IF (I2.NE.0) GO TO 70 I2 = 1 50 R8 = 1 C GET TERMINATOR CHAR (, OR ;) CALL LSCAN(IB,I,J,K) C COMMA IF (K.EQ.4) GO TO 10 C SEMI-COLON IF (K.NE.5) GO TO 70 55 I2 = I2+I3+I4+I5+I6 SS(5,R3) = I2 I7 = I7+I8+I9 SS(6,R3) = I7 IERR = 0 RETURN C C IS IT AN "A" C 60 IF (ICHAR.NE.A) GO TO 70 IF (I3.NE.0) GO TO 70 I3 = 10 GO TO 50 C C ERROR RETURN 70 IERR = -1 RETURN C C TWO CHARACTERS - THEN "AX" OR "BX" 80 R9 = 10 IF(J-I.NE.1) GOTO 70 IF (JSCOM(A1,1,2,IB,I,IERR).EQ.0) GO TO 82 R9 = R9 + 10 IF (JSCOM(A2,1,2,IB,I,IERR).EQ.0) GO TO 82 R9 = R9 + 10 IF (JSCOM(A3,1,2,IB,I,IERR).EQ.0) GO TO 82 R9 = R9 + 10 IF (JSCOM(A4,1,2,IB,I,IERR).EQ.0) GO TO 82 R9 = R9 + 10 IF (JSCOM(A5,1,2,IB,I,IERR).EQ.0) GO TO 82 R9 = 1 IF (JSCOM(B1,1,2,IB,I,IERR).EQ.0) GO TO 84 R9 = R9 +1 IF (JSCOM(B2,1,2,IB,I,IERR).EQ.0) GO TO 84 R9 = R9 + 1 IF (JSCOM(B3,1,2,IB,I,IERR).EQ.0) GO TO 84 R9 = R9 + 1 IF (JSCOM(B4,1,2,IB,I,IERR).EQ.0) GO TO 84 R9 = R9 + 1 IF (JSCOM(B5,1,2,IB,I,IERR).EQ.0) GO TO 84 81 IF (R8.EQ.1) GO TO 20 GO TO 70 82 IF (I3.NE.0) GO TO 70 I3 = R9 GO TO 50 84 IF (I2.NE.0) GO TO 70 I2 = R9 GO TO 50 C C SKIP OPTION C 90 IF(J-I.NE.3) GOTO 100 IF (JSCOM(SKIP,1,4,IB,I,IERR).NE.0) GO TO 100 C C ERROR IF HEADER STATEMENT IF (SS(1,R3).GT.20 .AND. SS(1,R3).LT.30) GO TO 70 R8 = 0 C C GET SKIP CONTROL ("A" OR "B") CALL LSCAN(IB,I,J,K) IF(I.NE.J) GOTO 70 CALL SGET (IB,I,ICHAR) C IS IT "B" IF (ICHAR.NE.B) GO TO 92 IF (I4.NE.0) GO TO 70 I4 = 100 GO TO 50 C C MUST BE "A" OR ELSE ERROR 92 IF (ICHAR.NE.A) GO TO 81 IF (I5.NE.0) GO TO 70 I5 = 1000 GO TO 50 C C ADD OPTION C 100 IF(J-I.NE.2) GOTO 110 IF (JSCOM(ADD,1,3,IB,I,IERR).NE.0) GO TO 110 IF (I6.NE.0) GO TO 70 IF (SS(1,R3).LT.30 .OR. SS(1,R3).GT.40) GO TO 70 C MUST BE TOTAL OR ELSE ERROR I6 = 10000 GO TO 50 C C COUNT OPTION C 110 IF(J-I.NE.4) GOTO 120 IF (JSCOM(COUNT,1,5,IB,I,IERR).NE.0) GO TO 120 IF (I8.NE.0) GO TO 70 IF (SS(1,R3).LT.30 .OR. SS(1,R3).GT.40) GO TO 70 I8 = 100 GO TO 50 C C AVERAGE OPTION C 120 IF(J-I.NE.6) GOTO 130 IF (JSCOM(AVER,1,7,IB,I,IERR).NE.0) GO TO 130 IF(I9.NE.0) GO TO 70 IF (SS(1,R3).LT.30 .OR. SS(1,R3).GT.40) GO TO 70 I9 = 1000 GO TO 50 C C EDIT OPTION C 130 IF (SS(1,R3).LT.30 .OR. SS(1,R3).GT.59) GO TO 70 IF (J-I.GT.1) GO TO 70 R9 = 1 CALL SMOVE (IB,I,J,ID,1) IF (ID.EQ.EZ) GO TO 132 R9 = 60 IF (ID.EQ.E0) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E1) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E2) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E3) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E4) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E5) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E6) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E7) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E8) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E9) GO TO 132 GO TO 70 132 IF (I7.NE.0) GO TO 70 I7 = R9 GO TO 50 END $