Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

C     RENBR(SELECT/SELECT PARTICULAR FROFF TEST CASES)
C
C     COPYRIGHT 1982 BY DONALD E. BARTH
C
C     This program selects individual test cases  from  the
C     composite  test  or  result  files  for  FROFF.  This
C     program must be run twice if these test cases are  to
C     be selected from both the test and result files.  The
C     test cases can be selected  in  any  order.   If  the
C     selected   test   case  does  not  appear  after  the
C     previously selected cases,  then the  input  file  is
C     closed  and  reopened  and the earlier test cases are
C     searched.
C
      DOUBLE PRECISION FILOLD,FILNEW
      DIMENSION LTRBFR(132),LTRDBG(5),LWRDBG(5),LTRMCH(6),
     1LWRMCH(6),LTRABC(26),LWRABC(26)
      DATA IDISK,JDISK,ITTY,JTTY/1,20,5,5/
      DATA LTRABC /1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
     1 1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,1HW,
     2 1HX,1HY,1HZ/
      DATA LWRABC /1Ha,1Hb,1Hc,1Hd,1He,1Hf,1Hg,1Hh,1Hi,1Hj,
     1 1Hk,1Hl,1Hm,1Hn,1Ho,1Hp,1Hq,1Hr,1Hs,1Ht,1Hu,1Hv,1Hw,
     2 1Hx,1Hy,1Hz/
      DATA LTRDBG/1HD,1HE,1HB,1HU,1HG/
      DATA LWRDBG/1Hd,1He,1Hb,1Hu,1Hg/
      DATA LTRSPA/1H /
      DATA LMTMCH,LMTBFR/6,132/
C
C     INFORM USER WHAT PROGRAM THIS IS
      WRITE(ITTY,1)
    1 FORMAT(' SELECT'/
     1' COPIES SELECTED TEST CASES FROM THE FROFF COMPOSITE'/
     2' TEST OR RESULT FILES')
C
C     ASK FOR AND OPEN THE INPUT FILE
    2 WRITE(ITTY,3)
    3 FORMAT(' SELECT FROM WHICH FILE (INCLUDE PERIOD): ',$)
      READ(JTTY,4)FILOLD
    4 FORMAT(1A10)
      OPEN(UNIT=IDISK,FILE=FILOLD,ACCESS='SEQIN',ERR=5)
      GO TO 7
    5 WRITE(ITTY,6)
    6 FORMAT(' OLD FILE CANNOT BE OPENED')
      GO TO 2
    7 CONTINUE
C
C     ASK FOR AND OPEN THE OUTPUT FILE
    8 WRITE(ITTY,9)
    9 FORMAT(' WRITE TO WHICH FILE (INCLUDE PERIOD): ',$)
      READ(JTTY,4)FILNEW
      OPEN(UNIT=JDISK,FILE=FILNEW,ACCESS='SEQOUT',ERR=10)
      GO TO 12
   10 WRITE(ITTY,11)
   11 FORMAT(' NEW FILE CANNOT BE OPENED')
      GO TO 8
   12 CONTINUE
C
C     PREPARE FOR FIRST PASS THROUGH INPUT FILE
      GO TO 16
C
C     KOPY   = -1, DEBUG LINE READ AT END OF COPIED CASE
C            = 0, COPY THE CASE
C            = 1, FIRST PASS LOOKING FOR CASE TO BE COPIED
C            = 2, SECOND PASS LOOKING FOR CASE TO BE COPIED
C
C     OPEN COMPOSITE INPUT TEST FILE
   13 CLOSE(UNIT=IDISK)
      OPEN(UNIT=IDISK,FILE=FILOLD,ACCESS='SEQIN',ERR=14)
      GO TO 17
   14 WRITE(ITTY,15)
   15 FORMAT(' OLD FILE CANNOT BE OPENED SECOND TIME')
      STOP
   16 KOPY=0
   17 KNTLIN=0
C
C     GET NAME OF NEXT TEST CASE
      IF(KOPY.NE.0)GO TO 24
      IFENCE=KNTLIN
      KOPY=1
   18 WRITE(ITTY,19)
   19 FORMAT(' COPY WHICH CASE (NULL TO EXIT): ',$)
      READ(JTTY,20)LTRMCH
   20 FORMAT(6A1)
      MAXMCH=0
      DO 23 I=1,LMTMCH
      LTRNOW=LTRMCH(I)
      IF(LTRNOW.EQ.LTRSPA)GO TO 23
      MAXMCH=MAXMCH+1
      LTRMCH(MAXMCH)=LTRNOW
      LWRMCH(MAXMCH)=LTRNOW
      DO 22 J=1,26
      IF(LTRNOW.NE.LTRABC(J))GO TO 21
      LWRMCH(MAXMCH)=LWRABC(J)
      GO TO 23
   21 IF(LTRNOW.NE.LWRABC(J))GO TO 22
      LTRMCH(MAXMCH)=LTRABC(J)
      GO TO 23
   22 CONTINUE
   23 CONTINUE
      IF(MAXMCH.LE.0)GO TO 49
   24 CONTINUE
C
C     READ NEXT LINE FROM INPUT FILE
   25 IF(KOPY.LT.0)GO TO 29
      IF(KOPY.NE.2)GO TO 26
      IF(KNTLIN.GE.IFENCE)GO TO 47
   26 READ(IDISK,27,END=43)LTRBFR
   27 FORMAT(132A1)
      KNTLIN=KNTLIN+1
      MAXBFR=LMTBFR+1
   28 MAXBFR=MAXBFR-1
      IF(MAXBFR.LE.0)GO TO 30
      IF(LTRBFR(MAXBFR).EQ.LTRSPA)GO TO 28
      GO TO 30
   29 IFENCE=KNTLIN-1
      KOPY=1
C
C     IF NOT COPYING, LOOK FOR START OF CASE TO BE COPIED
   30 IF(KOPY.EQ.0)GO TO 38
      IF(MAXBFR.LE.0)GO TO 25
      MATCH=1
      DO 31 I=1,5
      MATCH=MATCH+1
      IF(LTRBFR(MATCH).EQ.LTRDBG(I))GO TO 31
      IF(LTRBFR(MATCH).EQ.LWRDBG(I))GO TO 31
      GO TO 25
   31 CONTINUE
   32 MATCH=MATCH+1
      IF(MATCH.GT.MAXBFR)GO TO 25
      IF(LTRBFR(MATCH).EQ.LTRSPA)GO TO 32
      INIMCH=MATCH
      IF((MATCH+MAXMCH-1).NE.MAXBFR)GO TO 36
      DO 34 I=1,MAXMCH
      IF(LTRBFR(MATCH).EQ.LTRMCH(I))GO TO 33
      IF(LTRBFR(MATCH).EQ.LWRMCH(I))GO TO 33
      GO TO 36
   33 MATCH=MATCH+1
   34 CONTINUE
      WRITE(ITTY,35)(LTRBFR(I),I=INIMCH,MAXBFR)
   35 FORMAT('    FOUND CASE ',6A1)
      KOPY=0
      GO TO 41
   36 WRITE(ITTY,37)(LTRBFR(I),I=INIMCH,MAXBFR)
   37 FORMAT(' SKIPPING CASE ',6A1)
      GO TO 25
C
C     IF COPYING, LOOK FOR START OF NEXT CASE
   38 MATCH=1
      DO 39 I=1,5
      MATCH=MATCH+1
      IF(LTRBFR(MATCH).EQ.LTRDBG(I))GO TO 39
      IF(LTRBFR(MATCH).EQ.LWRDBG(I))GO TO 39
      GO TO 41
   39 CONTINUE
      IF(MATCH.GE.MAXBFR)GO TO 41
      WRITE(ITTY,40)
   40 FORMAT('   END OF CASE')
      KOPY=-1
      GO TO 18
C
C     COPY THE LINE
   41 IF(MAXBFR.LE.0)WRITE(JDISK,42)
   42 FORMAT(1X)
      IF(MAXBFR.GT.0)WRITE(JDISK,27)(LTRBFR(I),I=1,MAXBFR)
      GO TO 25
C
C     END OF INPUT FILE ENCOUNTERED
   43 IF(KOPY.EQ.1)GO TO 45
      IF(KOPY.EQ.2)GO TO 47
      WRITE(ITTY,44)
   44 FORMAT(' END OF INPUT FILE')
      GO TO 13
   45 WRITE(ITTY,46)
   46 FORMAT(' NOT FOUND IN SUBSEQUENT CASES, CONTINUING SEARCH')
      KOPY=2
      GO TO 13
   47 WRITE(ITTY,48)
   48 FORMAT(' NOT FOUND IN EARLIER CASES, ABANDONING SEARCH')
      KOPY=0
      GO TO 13
C
C     NULL TEST CASE NAME SPECIFIED
   49 STOP
      END