      SUBROUTINE BAKPAK(ICHNG)
      IMPLICIT INTEGER*2 (H)
      LOGICAL DEADCL
C----------------------------------------------
C  MACRO CPATLM .... PATTERN RECOGNITION LIMITS
C----------------------------------------------
      COMMON /CPATLM/ PATRLM(5),FLINLM(10),TRELLM(20),ZFITLM(10),BKK(20)
     *               ,XYF(20),IGFP(20),XBKK(40),IADMIN(5),YBKK(20)
      INTEGER IXYF(20),LMPATR(5),LMFLIN(10)
      INTEGER LMTREL(20),LMZFIT(10),IBKK(20)
      DIMENSION GFP(20),IXBKK(40),IYBKK(20)
      EQUIVALENCE (PATRLM(1),LMPATR(1)),(IXBKK(1),XBKK(1)),(IYBKK(1),
     *YBKK(1))   ,(FLINLM(1),LMFLIN(1)),(TRELLM(1),LMTREL(1))
     *           ,(ZFITLM(1),LMZFIT(1)),(BKK(1),IBKK(1))
     *           ,(XYF(1),IXYF(1)),(GFP(1),IGFP(1)),(IADMIN(1),IMCERT)
     *           ,(IYBKK(20),IPPASS),(IADMIN(2),IPFAST)
C----------- END OF MACRO CPATLM --------------
C----------------------------------------------------------------------
C             MACRO CDATA .... BOS COMMON.
C
C             THIS MACRO ONLY DEFINES THE IDATA/HDATA/ADATA NAMES.
C             THE ACTUAL SIZE OF /BCS/ IS FIXED ON MACRO CBCSMX
C             OR BY OTHER MEANS. A DEFAULT SIZE OF 40000 IS GIVEN HERE.
C
C----------------------------------------------------------------------
C
      COMMON /BCS/ IDATA(40000)
      DIMENSION HDATA(80000),ADATA(40000),IPNT(50)
      EQUIVALENCE (HDATA(1),IDATA(1),ADATA(1)),(IPNT(1),IDATA(55))
      EQUIVALENCE (NWORD,IPNT(50))
C
C------------------------ END OF MACRO CDATA --------------------------
C-------------------------------------------------------
C  MACRO CWORKEQ .... PATTERN RECOGNITION CWORK POINTERS
C-------------------------------------------------------
      EQUIVALENCE
C                POINTERS FOR FXYZ HIT ARRAY .. PRIMARY L/R SOLUTION
     +          (HPHT0,HPWRK( 1)),(HPHT9,HPWRK( 2)),(HLDHT,HPWRK( 3))
C                POINTERS FOR CWORK SINGLE TRACK PATR BANK
     +         ,(HPTR0,HPWRK( 4)),(HPTR9,HPWRK( 5)),(HLDTR,HPWRK( 6))
C                POINTERS FOR TRACK ELEMENT HIT LABEL ARRAY
     +         ,(HPHL0,HPWRK( 7)),(HPHL9,HPWRK( 8)),(HLDHL,HPWRK( 9))
C                POINTERS FOR FXYZ HIT ARRAY .. OPPOSITE L/R SOLUTION
     +         ,(HPHT0A,HPWRK(10)),(HPHT9A,HPWRK(11)),(HLDHTA,HPWRK(12))
C               POINTER LIMIT ON FXYZ HIT ARRAY
     +         ,(HPHTLM,HPWRK(13))
C               POINTERS FOR
     +         ,(HPTE0,HPWRK(14)),(HPTE9,HPWRK(15)),(HLDTE,HPWRK(16))
C-------------- END OF MACRO CWORKEQ ------------------
C----------------------------------------------
C  MACRO CWORKPR .... PATTERN RECOGNITION CWORK
C----------------------------------------------
      COMMON /CWORK/ HPLAST,HPFREE,HPWRK(30),ADWRK(600),
     ,               HPRO,HNTR,HNTCEL(98),IPCL(200),NRHT(200),
     ,               NWR1(200),DS1(200),SL1(200),
     ,               NWR2(200),DS2(200),SL2(200),
     ,               LBL(200),NTREL(200),ICRO(200),
     ,               NTR,HNREL(100),HISTR(9,100),HRES(168),
     ,               NTRLM,RLMTR(3,5),
     ,               WRK(7000)
                     DIMENSION TRKAR(200,11),ITRKAR(200,11),
     ,                         LMRTR(3,5)
                     EQUIVALENCE (IPCL(1),TRKAR(1,1),ITRKAR(1,1))
                     EQUIVALENCE (LMRTR(1,1),RLMTR(1,1))
         DIMENSION IWRK(7000),HWRK(14000),IDWRK(600),HDWRK(1200)
                     EQUIVALENCE (IWRK(1),WRK(1),HWRK(1))
                     EQUIVALENCE (IDWRK(1),ADWRK(1),HDWRK(1))
C---------- END OF MACRO CWORKPR --------------
      COMMON/CHEADR/HEAD(17),HRUN,HEV
      COMMON/CADMIN/IEVTP,NREC,NRWRIT,NRERR
       DIMENSION HTEMP(9),MAXC(3),HREP(10)
       EQUIVALENCE (RMSLI1,XBKK(33)),(IDLIM,IYBKK(10))
       EQUIVALENCE (JJPR,IXBKK(38))
       DATA MSKLRL /ZFFFFEFFF/,MAXC/24,24,48/
      CALL SETSL(HREP(1),0,20,0)
      RMSLI2=XBKK(34)
      IENTER=ICHNG
      IF(ICHNG.EQ.99) RMSLI2=0.
      IREM=IXYF(1)
      IXYF(1)=9 + 32
      ICHNG=0
      ILT=0
      IRPKNT=0
      RMSLIM=RMSLI1
      DO 13000 JKREP=1,2
      IKXKTR=0
16000 CONTINUE
      IKXKTR=IKXKTR+1
      KTR=IKXKTR
      IF(
     - JKREP.EQ.2
     -)THEN
      ILT=ILT+1
      IF(
     - ILT.LE.ITREP
     -)THEN
      KTR=HREP(ILT)
      ELSE
      GOTO 16001
      ENDIF
      ENDIF
      IF(
     - HNREL(KTR).NE.0
     -)THEN
       INUM=HNREL(KTR)
      IXX=KTR
      ASSIGN 17001 TO IZZZ01
      GOTO 17000
17001 CONTINUE
      IF(
     - IR1.GT.1.OR.IR2.LT.3
     -)THEN
      IRNG1=IR1
      IRNG2=IR2
      ICL1=KMP2
      LR1=0
      IF(KMP1.NE.KMP2) LR1=1
      RMSOLD=9999.
      DO 13002 JTR=1,100
      IF(
     - HNREL(JTR).NE.0.AND.JTR.NE.KTR
     -)THEN
      IXX=JTR
      ASSIGN 17002 TO IZZZ01
      GOTO 17000
17002 CONTINUE
      IF(
     - IR2.LT.IRNG1.OR.KMP1.NE.KMP2.AND.IR2.LE.IRNG1
     -)THEN
      IPTRK=HISTR(1,JTR)
      IPTRK=IABS(IPTRK)
      ISPEC=0
      IF(HNREL(JTR).EQ.1.AND.NRHT(IPTRK).LT.5.AND.IR2.EQ.1) ISPEC=1
      IF(
     - HNREL(JTR).GT.1.OR.NRHT(IPTRK).GT.0.OR.IR2.GT.1
     -)THEN
      ICL2=KMP1
      IF(IRNG1.EQ.3) ICL=(ICL1+1)/2
      IF(IRNG1.EQ.2) ICL=ICL1-24
      IF(IRNG1.EQ.3.AND.IR2.EQ.1) ICL=ICL-24
      IF(IR2.EQ.IRNG1) ICL=ICL1
      IDIF=IABS(ICL-ICL2)
      IF(
     - IDIF.GT.MAXC(IR2)/2
     -)THEN
      IF(
     - ICL.GT.ICL2
     -)THEN
       ICL=ICL-MAXC(IR2)
      IDIF=IABS(ICL-ICL2)
      ELSE
       ICL2=ICL2-MAXC(IR2)
      IDIF=IABS(ICL-ICL2)
      ENDIF
      ENDIF
      IF(IENTER.EQ.99.AND.IABS(IR2-IRNG1).GT.1.AND.IXBKK(35).EQ.0
     % .AND.HNREL(JTR).EQ.1.AND.NRHT(IPTRK).LT.8) IDIF=99
      LR2=0
      IF(KMP1.NE.KMP2) LR2=1
      IF(
     - IDIF.LE.IDLIM
     -)THEN
      IAB=HNREL(JTR)
      CALL MVC2(HTEMP(1),0,HISTR(1,KTR),0,18) !PMF 28/06/99 MVC -> MVC2
      LRP=1
      LRD=1
      DO 13004 IKOUNT=1,4
      IF(
     - IKOUNT.GE.2
     -)THEN
      IF(
     - LR1.NE.0.AND.LR2.NE.0
     -)THEN
      GOTO 13005
      ENDIF
      IF(
     - LR1.NE.0.AND.LR2.EQ.0
     -)THEN
      IF(
     - IKOUNT.EQ.2
     -)THEN
      LRD=-LRD
      ELSE
      GOTO 13005
      ENDIF
      ENDIF
      IF(
     - LR1.EQ.0.AND.LR2.NE.0
     -)THEN
      IF(
     - IKOUNT.EQ.2
     -)THEN
      LRP=-1
      ELSE
      GOTO 13005
      ENDIF
      ENDIF
      IF(
     - LR1.EQ.0.AND.LR2.EQ.0
     -)THEN
      IF(IKOUNT.EQ.2) LRD=-LRD
      IF(IKOUNT.EQ.3) LRP=-LRP
      IF(IKOUNT.EQ.4) LRD=-LRD
      ENDIF
      ENDIF
      DO 13006 JJ=1,INUM
      HISTR(JJ,KTR)=HISTR(JJ,KTR)*LRP
13006 CONTINUE
13007 CONTINUE
      ASSIGN 17004 TO IZZZ02
      GOTO 17003
17004 CONTINUE
      IF(
     - IEXIT.EQ.99.OR.IEXIT.EQ.98
     -)THEN
      CALL MVC2(HISTR(1,KTR),0,HTEMP(1),0,18)  !PMF 28/06/99 MVC -> MVC2
      GOTO 13005
      ENDIF
      IF(
     - JCOUNT.EQ.INUM+IAB.AND.IR2.EQ.IRNG1
     -)THEN
      ML1=INUM
      ML1=HISTR(ML1,KTR)
      ML1=IABS(ML1)
      ML1=NWR1(ML1)
      ML2=HISTR(1,JTR)
      ML2=IABS(ML2)
      ML2=NWR2(ML2)
      IF(
     - ML2-ML1.GE.IBKK(7)
     -)THEN
      CALL MVC2(HISTR(1,KTR),0,HTEMP(1),0,18) !PMF 28/06/99 MVC -> MVC2
      IF(LAND(JJPR,64).NE.0) PRINT 295,ML1,ML2
 295  FORMAT('   LAYER DIFFERENCE IS TOO LARGE',2I5)
      GOTO 13005
      ENDIF
      ENDIF
       HPOLD=HPFREE
       CALL FXYZ(KTR)
       HPTR0=HPFREE
       HPTR9=HPTR0+49
       HLDTR=50
      HPFREE=HPTR9+1
      IF(
     - HPFREE.LE.HPLAST
     -)THEN
      CALL XYFIT
      RMS=WRK(HPTR0+22)
      IF(
     - RMS.LT.RMSLI2.AND.RMS.GT.RMSLIM.AND.JKREP.EQ.1.AND.ISPEC.EQ.0
     * .AND.(HREP(IRPKNT).NE.KTR.AND.IRPKNT.GT.0.OR.IRPKNT.EQ.0)
     * .AND.IENTER.NE.99
     -)THEN
      IF(
     - IRPKNT.LT.10
     -)THEN
      IRPKNT=IRPKNT+1
      HREP(IRPKNT)=KTR
      ENDIF
      ENDIF
      IF(
     - IRNG1.EQ.3.AND.IR2.EQ.1.AND.IXBKK(35).NE.0
     % .AND.RMS.LT.RMSLIM.AND.RMS.LT.RMSOLD
     -)THEN
      IPREM1=IGFP(1)
      IPREM2=IGFP(6)
      IPREM3=IGFP(9)
       PREM4=GFP(2)
       PREM5=GFP(14)
      IGFP(6)=17
      IGFP(9)=0
      GFP(2)=999999.
      GFP(14)=999999.
      IGFP(1)=LOR(IGFP(1),1)
      RMIN=150.
      RMAX=850.
      CALL PATROL(RMIN,RMAX)
      IFOUND=0
      DO 13008 ICNT=HPHT0,HPHT9,HLDHT
      IF(IWRK(ICNT+10).LT.2.AND.IWRK(ICNT+12).EQ.2) IFOUND=IFOUND+1
13008 CONTINUE
13009 CONTINUE
      IC1=ICL2+24
      IC2=(ICL1+1)/2
      NRUN=HRUN
      NCL1=HNTCEL(IC1+1)-HNTCEL(IC1)
      NCL2=HNTCEL(IC2+1)-HNTCEL(IC2)
      IF(IDIF.EQ.0.AND.IFOUND.LT.IYBKK(9).AND..NOT.(DEADCL(IC1,NRUN)
     $.AND.NCL1.EQ.0.OR.DEADCL(IC2,NRUN).AND.NCL2.EQ.0)) RMS=99.
      IF(IDIF.EQ.1.AND.IFOUND.LT.IYBKK(16).AND..NOT.(DEADCL(IC1,NRUN)
     $.AND.NCL1.EQ.0.OR.DEADCL(IC2,NRUN).AND.NCL2.EQ.0)) RMS=99.
      IGFP(1)=IPREM1
      IGFP(6)=IPREM2
      IGFP(9)=IPREM3
       GFP(2)=PREM4
       GFP(14)=PREM5
      ENDIF
      IF(
     - RMS.LT.RMSLIM.AND.RMS.LT.RMSOLD
     -)THEN
      IF(
     - ISPEC.EQ.0.OR.ISPEC.EQ.1.AND.RMS.LT.RMSLI1
     -)THEN
      RMSOLD=RMS
      ITRACK=JTR
      LRDFIN=LRD
      LRPFIN=LRP
      ENDIF
      ENDIF
      ELSE
      PRINT 33,HRUN,HEV,NREC,KTR,JTR
 33   FORMAT(' +++++++++  NOT ENOUGH SPACE IN CWORK  +++++++(BAKPAK)',
     * 5I10)
      ENDIF
      HPFREE=HPOLD
      CALL MVC2(HISTR(1,KTR),0,HTEMP(1),0,18) !PMF 28/06/99 MVC -> MVC2
13004 CONTINUE
13005 CONTINUE
      HNREL(KTR)=INUM
      ENDIF
      ENDIF
      ENDIF
      ENDIF
13002 CONTINUE
13003 CONTINUE
      IF(
     - RMSOLD.NE.9999.
     -)THEN
      DO 13010 JJ=1,INUM
      HISTR(JJ,KTR)=HISTR(JJ,KTR)*LRPFIN
13010 CONTINUE
13011 CONTINUE
      IF(
     - HREP(IRPKNT).EQ.KTR.AND.JKREP.EQ.1
     -)THEN
      IKXKTR=IKXKTR-1
      HREP(IRPKNT)=0
      IRPKNT=IRPKNT-1
      ENDIF
      IAB=HNREL(ITRACK)
      JTR=ITRACK
      LRD=LRDFIN
      ASSIGN 17005 TO IZZZ02
      GOTO 17003
17005 CONTINUE
      DO 13012 IY=1,JCOUNT
      ITC=HISTR(IY,KTR)
      ITC=IABS(ITC)
      LBL(ITC)=LAND(LBL(ITC),MSKLRL)
13012 CONTINUE
13013 CONTINUE
      IF(IEXIT.EQ.99.OR.IEXIT.EQ.98) WRITE(6,769)
 769  FORMAT('  ********* ERROR IN BAKPAK  EXIT ****** ')
      HNREL(ITRACK)=0
      ICHNG=1
      ENDIF
      ENDIF
      ENDIF
      IF(.NOT.(
     - IKXKTR.GE.100
     -))GOTO 16000
16001 CONTINUE
      IF(
     - HREP(1).EQ.0
     -)THEN
      GOTO 13001
      ELSE
      ITREP=IRPKNT
      RMSLIM=RMSLI2
      ENDIF
13000 CONTINUE
13001 CONTINUE
      IXYF(1)=IREM
      IBTRK=NTR
      NTR=100
      NTR=IBTRK
      RETURN
17000 CONTINUE
      IR1=1
      IR2=1
      KMP1=HISTR(1,IXX)
      KMP1=IABS(KMP1)
      KMP1=IPCL(KMP1)
      KMP2=HISTR(HNREL(IXX),IXX)
      KMP2=IABS(KMP2)
      KMP2=IPCL(KMP2)
      IF(KMP2.GT.24) IR1=2
      IF(KMP2.GT.48) IR1=3
      IF(KMP1.GT.24) IR2=2
      IF(KMP1.GT.48) IR2=3
      GOTO IZZZ01
17003 CONTINUE
      IEXIT=0
      JCOUNT=INUM
      DO 13014 KK=1,IAB
      ISIG=0
      ITP2=HISTR(KK,JTR)
      ITP2=IABS(ITP2)
      DO 13016 IJT=1,INUM
      ITP1=HISTR(IJT,KTR)
      IF(
     - IABS(ITP1).EQ.ITP2
     -)THEN
      ISIG=1
      GOTO 13017
      ENDIF
13016 CONTINUE
13017 CONTINUE
      IF(
     - ISIG.EQ.0
     -)THEN
      JCOUNT=JCOUNT+1
      IF(
     - JCOUNT.LE.9
     -)THEN
      HISTR(JCOUNT,KTR)=HISTR(KK,JTR)*LRD
      ELSE
      IEXIT=99
      GOTO 13015
      ENDIF
      ENDIF
13014 CONTINUE
13015 CONTINUE
      HNREL(KTR)=JCOUNT
      IF(
     - JCOUNT.EQ.INUM.OR.JCOUNT.EQ.IAB
     -)THEN
      IEXIT=98
      ENDIF
      GOTO IZZZ02
      END
