Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0147/tstcas.for
There is 1 other file named tstcas.for in the archive. Click here to see a list.
C     RENBR(TSTCAS/SEQUENCE NUMBER TEST CASES)
C
C     THIS PROGRAM PROCESSES THE FILE CONTAINING THE
C     TEST CASES FOR THE FORMAT PROGRAM.  THE NAMES
C     OF THE TEST CASES ARE MADE TO BE SEQUENTIAL
C
      DIMENSION LTRBFR(100),LTRTST(5),LWRTST(5),LTRDGT(10)
      DOUBLE PRECISION FILINP,FILOUT
      DATA LTRTST/1H%,1HT,1HE,1HS,1HT/
      DATA LWRTST/1H%,1Ht,1He,1Hs,1Ht/
      DATA LTRDGT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA ITTY,IDISK,JDISK/5,1,20/
      DATA LTRSPA/1H /
      DATA LMTBFR,LMTTST/100,5/
C
C     GET NAME OF FILE TO BE PROCESSED
    1 WRITE(ITTY,2)
    2 FORMAT(' INPUT FILE? ',$)
      READ(ITTY,3)FILINP
    3 FORMAT(1A10)
      OPEN(UNIT=IDISK,FILE=FILINP,ACCESS='SEQIN',ERR=1)
C
C     GET NAME OF NEW FILE
    4 WRITE(ITTY,5)
    5 FORMAT(' OUTPUT FILE? ',$)
      READ(ITTY,3)FILOUT
      OPEN(UNIT=JDISK,FILE=FILOUT,ACCESS='SEQOUT',ERR=4)
C
C     GET VALUE OF FIRST NUMBER
      WRITE(ITTY,6)
    6 FORMAT(' VALUE OF FIRST GENERATED CASE NUMBER? ',$)
      READ(ITTY,7)JVALUE
    7 FORMAT(I)
C
C     PROCESS THE FILE
    8 READ(IDISK,9,END=24)LTRBFR
    9 FORMAT(100A1)
      MAXBFR=LMTBFR+1
   10 MAXBFR=MAXBFR-1
      IF(MAXBFR.LE.1)GO TO 23
      IF(LTRBFR(MAXBFR).EQ.LTRSPA)GO TO 10
C
C     CHECK FOR PERCENT SIGN FOLLOWED BY WORD TEST
      DO 13 ITEST=1,MAXBFR
      IF((ITEST-1+LMTTST).GT.MAXBFR)GO TO 23
      JTEST=ITEST
      DO 12 KTEST=1,LMTTST
      IF(LTRBFR(JTEST).EQ.LTRTST(KTEST))GO TO 11
      IF(LTRBFR(JTEST).EQ.LWRTST(KTEST))GO TO 11
      GO TO 13
   11 JTEST=JTEST+1
   12 CONTINUE
      GO TO 14
   13 CONTINUE
      GO TO 23
C
C     CHECK FOR NUMBER RIGHT OF WORD TEST
   14 ITEST=JTEST
      IVALUE=0
   15 IF(JTEST.GT.MAXBFR)GO TO 18
      DO 16 KTEST=1,10
      IF(LTRBFR(JTEST).NE.LTRDGT(KTEST))GO TO 16
      IVALUE=(10*IVALUE)+KTEST-1
      GO TO 17
   16 CONTINUE
      IF(LTRBFR(JTEST).EQ.LTRSPA)GO TO 17
      GO TO 23
   17 JTEST=JTEST+1
      GO TO 15
   18 WRITE(ITTY,19)IVALUE,JVALUE
   19 FORMAT(' Test case',1I5,' becomes',1I5)
      IDIGIT=JVALUE
      JDIGIT=IDIGIT/10
      KDIGIT=JDIGIT/10
      LDIGIT=KDIGIT/10
      IDIGIT=IDIGIT-(10*JDIGIT)+1
      JDIGIT=JDIGIT-(10*KDIGIT)+1
      KDIGIT=KDIGIT-(10*LDIGIT)+1
      LDIGIT=LDIGIT+1
      ITEST=ITEST-1
      JVALUE=JVALUE+1
      IF(JVALUE.GT.1000)GO TO 22
      IF(JVALUE.GT.100)GO TO 21
      IF(JVALUE.GT.10)GO TO 20
      WRITE(JDISK,9)(LTRBFR(I),I=1,ITEST),LTRSPA,
     1LTRDGT(IDIGIT)
      GO TO 8
   20 WRITE(JDISK,9)(LTRBFR(I),I=1,ITEST),LTRSPA,
     1LTRDGT(JDIGIT),LTRDGT(IDIGIT)
      GO TO 8
   21 WRITE(JDISK,9)(LTRBFR(I),I=1,ITEST),LTRSPA,
     1LTRDGT(KDIGIT),LTRDGT(JDIGIT),LTRDGT(IDIGIT)
      GO TO 8
   22 WRITE(JDISK,9)(LTRBFR(I),I=1,ITEST),LTRSPA,
     1LTRDGT(LDIGIT),LTRDGT(KDIGIT),LTRDGT(JDIGIT),LTRDGT(IDIGIT)
      GO TO 8
C
C     WRITE ANY LINE NOT CONTAINING CASE NUMBER
   23 WRITE(JDISK,9)(LTRBFR(I),I=1,MAXBFR)
      GO TO 8
   24 STOP
      END