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