      IMPLICIT INTEGER (A-Z)
      EXTERNAL F1, F2, F6, BRKENT; CALL LI(F1); CALL INIT108
      DOUBLE PRECISION BLANKD, C4D
      GLOBAL CLNT(200),CRBUF(3001),C1(121),C4(31),DEBUG,BRKFLG,CLLN,
     *CSZ,C4SZ,I,IOCODE,J,LLLN,MF,RECCNT,TCLLN,TYC,UPF,FILLCHAR
      DIMENSION CLT(30,100),C4D(15)
      EQUIVALENCE (CCLN,CRBUF),(CLT,CRBUF(2)),(C4D,C4)
      DATA BLANKD/'        '/, RECCNT,BRKFLG,DEBUG,CLLN,LLLN/0/
      DATA C4(31),C1(121)/0/,FILLCHAR/'-'/
      DATA DC6/6/
      CALL XOPEN(2,'CONCTMP',2,2,8,1,7,3,IOCODE,SCND,720S,730S)
      CALL INT(BRKENT); CALL PFILE
      READ(105,1005,END=1005) FILLCHAR
 1005 FORMAT(A1)
   99 CLX=100; CLNTX=0
  100 CALL RDWRT(0,190S); IF((I=ISL(C4(1),-24)).EQ.1R1) GOTO 180
      IF(C4(1).EQ.4R  * ) GOTO 190
      IF(I.EQ.1RA) C4(1)=4R    -4RA   +C4(1)
      CLX1=11
      IF(C4(1).EQ.4R    )GOTO115
      I=IAND(2ZFF,ISL(C4(3),-8))
      IF(I.EQ.1R/.OR.I.EQ.1R-) GOTO 115
      CLX1=24
  115 CALL CONCFL(CLT(1,CLX))
      DO 270, I=CLX1,C4SZ*4,13
      IF(C1(I).EQ.1R-.AND.1R0.LE.C1(I-1).LE.1R9) GOTO 130
      IX=I; IF(C1(I+1).EQ.1RS) IX=I+1
      IF(C1(IX+1).NE.1RR.OR.C1(IX+4).NE.1R ) GOTO 270
      IF(C1(IX+2).NE.1RE.OR.C1(IX+3).NE.1RF) GOTO 270
  130 MF=1000
      CLNTX=CLNTX+1; CLNT(CLNTX)=0
      DO 250 J=I-1,I-10,-1
      IF(C1(J).NE.1R.) GOTO 240
      MF=1000; IF((CLNT(CLNTX)=CLNT(CLNTX)/1000).LT.1000) GOTO 250
      GOTO 260
  240 IF(.NOT.(1R0.LE.C1(J).LE.1R9)) GOTO 270
      CLNT(CLNTX)=CLNT(CLNTX)+(C1(J)-1R0)*MF; MF=MF*10
      IF(CLNT(CLNTX).GT.21474836) GOTO 260
  250 CONTINUE
  260 CLNTX=CLNTX-1
  270 CONTINUE
      CALL PRECM2; IF(CLX1.EQ.24) GOTO 140
      CLX=CLX-1; IF(CLX.LT.1) CLX=1
  140 IF(CLNTX.LE.0) GOTO 99
      CLX1=30*(101-CLX)+1
      DO 810 I=1,CLNTX
      CRBUF(3002-CLX1)=CLNT(I)
      CALL KWRT(LI(F2),CRBUF(3002-CLX1),CLX1,100*CRBUF(3002-CLX1))
  810 CONTINUE
      GOTO 99
  190 OUTPUT 'CONCORDANCE NOT FOUND'
  180 REWIND 1; REWIND 2; CCLN=-1; RECCNT=0
  200 CALL RDWRT(1,700S); IF(ISL(C4(1),-24).NE.1R1) GOTO 200
  320 CALL RDWRT(0,700S)
      IF(ISL(C4(2),-24).EQ.1R.) GOTO 637
      IF(ISL(C4(1),-24).EQ.1R1) GOTO 490
      IF(C4(2).EQ.4RNTRO) GOTO 520
      IF(C4(2).EQ.4R   1.AND.C4(3).EQ.4R    ) GOTO 637
      DECODE(11,1020,C4) TCLLN, UPF; IF(TCLLN.EQ.0) GOTO 500
 1020 FORMAT(4XI5,R1)
      IF(UPF.NE.1R*) GOTO 325
      IF(TCLLN.GT.999) TCLLN=999
      CLLN=LLLN+TCLLN; GOTO 330
  325 CLLN=LLLN=TCLLN*1000
  330 IF(DEBUG.NE.0) WRITE(102,1090) RECCNT, CRBUF(1), CLLN
 1090 FORMAT(X99I)
      IF(CLLN-CCLN) 500, 350, 340
  340 CALL BUFFERIN(2,0,CRBUF,30*100+1,TYC,CSZ)
      IF(TYC-3) 330, 520, 520
  350 WRITE(DC6,1030) CSZ/30,((CLT(I,J), I=1,30), J=1,CSZ/30); GOTO 340
 1030 FORMAT(/N(30A4/))
  490 CALL CHKHDR; WRITE(DC6,1091); GOTO 320
 1091 FORMAT(1H1)
  500 CALL BUFFEROUT(DC6,0,C4,C4SZ,X,X); GOTO 320
  520 CALL BUFFEROUT(DC6,0,C4,C4SZ,X,X)
  530 CALL RDWRT(1,710S); GOTO 530
  637 CALL BUFFEROUT(DC6,0,C4,C4SZ,X,X); GOTO 200
  700 OUTPUT 'UNEXPECTED END OF FILE ON LO FILE'; STOP
  710 OUTPUT ' '; OUTPUT 'NORMAL END'; STOP
  720 WRITE(108,1060) IOCODE; STOP
 1060 FORMAT('IO ERR/ABN ON F:2 (CONCTMP):  CODE = 'Z4)
  730 OUTPUT 'XOPEN SYNTAX ERROR ON CONCTMP OPEN'; STOP
      SUBROUTINE RDWRT(RWFLG,*); RECCNT=RECCNT+1
      IF(BRKFLG.NE.0) BRKFLG=0; WRITE(102,1070) RECCNT, (X=CLLN/1000),
     *CLLN-X*1000
 1070 FORMAT('REC 'I' LINE 'I-X'.'I)
      DO 805 I=1,15
  805 C4D(I)=BLANKD
      CALL BUFFERIN(1,0,C4,30,TYC,C4SZ); IF(TYC.EQ.3) RETURN 1
      C4SZ=MIN(C4SZ,30)
      IF(ISL(C4(1),-24).NE.1R1) GOTO 800
      CALL CHKHDR; IF(RWFLG.EQ.1) WRITE(DC6,1080)
      RETURN
  800 IF(RWFLG.NE.1) RETURN
      CALL BUFFEROUT(DC6,0,C4,C4SZ,X,X); RETURN
 1080 FORMAT(1H1)
      SUBROUTINE BRKENT; BRKFLG=1; RETURN
      END
