      SUBROUTINE BKGR(LU,YMIN,YMAX,AM,N,MF,MB,IBKGR,F)
C
C
C  AM IS LOW BKGR PT USED TO CACULATE SD FOR SEARCH
C
      BYTE F(30),IBKGR,MF,MB
C
      YMIN=9999.
      YMAX=-9999.
      DO 100 I=1,N
      J=I
      READ(LU'J) B
      IF(B.LT.1.0) GO TO 100
      IF(B.LT.YMIN) IMIN=I
      IF(B.LT.YMIN) YMIN=B
      IF(B.GT.YMAX) YMAX=B
  100 CONTINUE
      IF(IMIN.LT.2) IMIN=2
      IF(IMIN.EQ.N) IMIN=N-1
      J=IMIN-1
      READ(LU'J) B1
      READ(LU'IMIN) B2
      J=IMIN+1
      READ(LU'J) B3
      AM=(B1+B2+B3)/3.0
C
      IF(IBKGR.EQ.0) RETURN
      DO 200 I=1,30
  200 IF(F(I).EQ.'.') J=I
      F(J+1)='B'
      F(J+2)='K'
       F(J+3)='G'
      F(J+4)=0
      OPEN(UNIT=13,NAME=F,TYPE='NEW',ACCESS='DIRECT',RECORDSIZE=1)
      IF(IBKGR.EQ.1) CALL LBKGR(N,YMIN,YMAX,LU,MF,MB)
      IF(IBKGR.EQ.2) CALL PBKGR(N,YMIN,YMAX,LU,MF,MB)
      RETURN
      END
C
      SUBROUTINE PBKGR(N,YMIN,YMAX,LU,MF,MB)
       IMPLICIT INTEGER*2 (I-N)
	BYTE MF,MB
C A LINEAR LEAST SQUARES BACKGROUND SUBTRACTION PROGRAM
C
C THE PROGRAM IS BASED ON A SEQUENTIAL CURVE FITTING METHOD
C USING A QUADRATIC POLYNOMIAL FITTED TO 50*NF POINTS.  DATA
C POINTS SIGNIFICANTLY GREATER THAN THE ESTIMATED LINE ARE
C EXCLUDED AND THE FIT IS ITERATED UNTIL THE CURVE CONVERGES
C TO THE TRUE BACKGROUND OR THE NUMBER OF ITERATIONS REACHES
C 20.  THE BACKGROUND IS THEN SUBTRACTED FROM 50*(NF-NB) PTS
C AND A NEW CURVE IS FITTED TO THE NEXT SEGMENT OF 50*NF PTS.
C THEREFORE, THE BACKGROUND IS FITTED BY MANY SEGMENTS OF
C QUADRATIC CURVES.  CONTINUITY IS ASSURED BY FIXING THE
C JOIN POINTS OF SUCCESSIVE CURVES.
C
C PROGRAM WAS WRITTEN BY TERRY QUICK (LLL) AND DICK MENSING
C (LLL), AND IS BASED ON ORIGINAL WORK BY RAY GOEHNER (GE).
C
C NF = NUMBER OF 50-POINT BLOCKS TO FIT QUADRATIC FUNCTION
C NB = NUMBER OF 50-POINT BLOCKS TO OVERLAP BETWEEN SEGMENTS
C
C ********************************************************
C *                                                      *
      DIMENSION BK(64),LO(513)
      REAL MSS,MSS1
      N1=MF
      N2=MB
C INT = MAXIMUM NUMBER OF ITERATIONS PER SEGMENT
      INT=20
C ISKIP = NUMBER OF POINTS SKIPPED
      ISKIP=1
      NF=50*N1
      NB=50*N2
      IF(NF.EQ.0) NF=N
      IF(NB.GE.NF) WRITE(7,42)
   42 FORMAT(1X,'VALUES FOR NF & NB ARE IN ERROR')
      IF(NB.GE.NF) GO TO 9999
      NFB=NF - NB
      IF(NF.GT.100) ISKIP=2
      IF(NF.GT.150) ISKIP=3
      IF(NF.GT.200) ISKIP=4
      IF(NF.GT.600) ISKIP=6
      IF(NF.GT.2000) ISKIP=8
      READ(LU'1) YFIX
      AL=0.0
      BE=0.0
      NN=0
      NS=1
      XMIN=YMIN
      XMAX=YMAX
      K=0
   11 ILT5=0
      ST=3.0
      AL1=0.0
      BE1=0.0
      LOOP=0
      LR=3
      NN=NN + NF
      IF(NN.GT.N)NN=N
      YFX=YFIX
      BMIN=9999.
      BMIN1=9999.
      NHALF=NS + NF/2
      DO 23 I=NS,NHALF
      J=I
      READ(LU'J) T
      IF(T.LT.BMIN1)BMIN1=T
   23 CONTINUE
      BMIN2=9999.
      N3=NHALF + 1
      DO 24 I=N3,NN
      J=I
      READ(LU'J) T
      IF(T.GT.BMIN2)GO TO 24
      BMIN2=T
      L2=I
   24 CONTINUE
      BMIN=AMIN1(BMIN1,BMIN2)
      IF(YFIX.LT.BMIN)YFX=BMIN
      DO 13 L=1,INT
      X2=0.0
      X3=0.0
      X4=0.0
      XY=0.0
      X2Y=0.0
      NPT=0
      DO 1 I=NS,NN,ISKIP
      J=I
      READ(LU'J) BX
      Z=I - NS
      ZZ=YFX + Z*(AL1 + BE1*Z)
      IF(ZZ.LT.0.0)ZZ=0.0
C PT IS DELETED ON 1ST PASS IF GREATER THAN 3 STD DEV ABOVE CURVE
      ZZ=ZZ + SQRT(ZZ)*ST
      IF(BX.GT.ZZ)GO TO 1
      NPT=NPT + 1
      LO(NPT)=I
      Z2=Z*Z
      Z3=Z2*Z
      Z4=Z3*Z
      ZY=BX - YFIX
      X2=X2 + Z2
      X3=X3 + Z3
      X4=X4 + Z4
      XY=XY + ZY*Z
      X2Y=X2Y + ZY*Z2
    1 CONTINUE
      IF(LOOP.EQ.1)GO TO 25
      IF(LO(NPT).GT.NHALF)GO TO 25
      AL1=(BMIN2 - YFIX)/(L2 - NS)
      LR=4
      LOOP=1
      YFX=YFIX
      GO TO 13
   25 LOOP=1
      IF(NPT.LT.20)GO TO 40
      GO TO 26
   40 IF(NPT.LT.5)GO TO 43
      AL=XY/X2
      BE=0.0
      Z=ABS(AL-AL1)
      ZZ=0.0
      NPTD=NPT-1
      GO TO 41
   26 DET=X2*X4 - X3*X3
      AL=(XY*X4 - X2Y*X3)/DET
      BE=(X2Y*X2 - XY*X3)/DET
      Z=ABS(AL - AL1)
      ZZ=ABS(BE - BE1)
      NPTD=NPT-2
   41 RSS=0.0
      DO 22 I=1,NPT
      II=I
      ILO=LO(II)
      READ(LU'ILO) BR
      ZRR=ILO - NS
      ZR=YFIX + ZRR*(AL + BE*ZRR)
      RSS=RSS + (ZR - BR)**2
   22 CONTINUE
      MSS=RSS/NPTD
C
C PT IS DELETED ON 2ND AND SUBSEQUENT PASSES IF > 1 STD DEV ABOVE CURVE
      IF(ST.NE.1.0)ST=1.0
      YFX=YFIX
      IF(Z.LT.0.01.AND.ZZ.LT.0.01)GO TO 16
      IF(L.LT.LR)GO TO 18
      SD=MSS - MSS1
      IF(SD.GE.0.0)GO TO 19
   18 AL1=AL
      BE1=BE
      Z1=Z
      ZZ1=ZZ
      MSS1=MSS
      GO TO 13
   19 IF(Z.LT.Z1.AND.ZZ.LT.ZZ1)GO TO 20
D     WRITE(7,1003) L
D1003 FORMAT(1X,'RESIDUALS CRITERION STOPPED FIT AT ITERATION ',I2,'.')
      GO TO 16
   20 CONTINUE
D     WRITE(7,1004) L
D1004 FORMAT(1X,'RESIDUALS CRITERION STOPPED FIT (ITERATION=',I2,
D    X') BEFORE COEFF DIVERGE.')
      GO TO 16
   13 CONTINUE
      WRITE(7,31)
   31 FORMAT(1X,'CURVE FAILS TO CONVERGE IN 20 ITERATIONS')
   16 L=NN-NB
      IF(NN.EQ.N) L=N
      DO 14 I=NS,L
      Z1=I - NS
      BG=YFIX + Z1*(AL + BE*Z1)
      IF(BG.LT.XMIN) BG=XMIN
      IF(ILT5.EQ.1)BG=YFIX
      J=I
      WRITE(13'J) BG
      READ(LU'J) B
      B=B-BG
      K=K + 1
      WRITE(LU'J) B
   14 CONTINUE
      IF(NN.EQ.N) GO TO 95
      NN=L
      NS=NN+1
      IF(ILT5.EQ.1) GO TO 11
      YFIX=YFIX+NFB*(AL+BE*NFB)
      IF(YFIX.LT.XMIN) YFIX=XMIN
      GO TO 11
   43 TYPE *,'LESS THAN 5 PTS AVAILABLE FOR FIT'
      ILT5=1
      GO TO 16
   95 RETURN
 9999 STOP
      END
C
      SUBROUTINE LBKGR(N,YMIN,YMAX,LU,MF,MB)
       IMPLICIT INTEGER*2 (I-N)
	BYTE MF,MB
C A LINEAR LEAST SQUARE BACKGROUND SUBTRACT PROGRAM 
C THE PROGRAM USES A SLIDING APPROACH 
C A LEAST SQUARE LINE IS FITTED TO NF PTS OF THE DATA 
C THEN THE PTS THAT ARE SIGNIFICANTLY ABOVE THIS LINE 
C ARE EXCLUDED AND ANOTHER LEAST SQUARE FIT IS MADE 
C THIS IS REPEATED UNTIL THE LINE COE 
C BACKGROUND     THE BACKGROUND IS THEN SUBTRACTED FROM 
C NF-NB PTS AND ANOTHER FIT IS STARTED.  THEREFORE THE ACTUAL 
C BACKGROUND CAN BE FITTED BY MANY LINEAR SEGMENTS 
C THE OVERLAP IS PROVIDED FOR A SMOOTH TRANSITION OVER 
C THE DATA POINTS 
C  PROGRAM WAS WRITTEN BY RAY GOEHNER 
C NF NUMBER OF POINTS TO FIT LINEAR FUNCTION 
C NB NUMBER OF PTS TO OVERLAP BETWEEN FITS 
C INT NUMBER OF INTERATIONS ALLOWED 
C ISKIP NUMBER OF PTS TO SKIP 
C SENS SENSITIVITY FOR THE EXCLUSION OF PTS IN THE 2ND AND 
C UPPER PASSES OF THE FIT 
C ******************************************************** 
C *                                                      * 
C
      NF=MF
      NB=MB
      INT=20 
      ISKIP=1 
      NNF=50*NF 
      NNB=50*NB 
      IF(NNF.EQ.0) NNF=N 
      IF(NNB.GE.NNF) WRITE(7,42) 
   42 FORMAT(1X,'VALUES FOR NF & NB ARE IN ERROR') 
      IF(NNB.GE.NNF) GO TO 9999 
        IF(NNF.GT.100) ISKIP=2 
      IF(NNF.GT.150) ISKIP=3 
      IF(NNF.GT.200) ISKIP=4 
      IF(NNF.GT.600) ISKIP=6 
      IF(NNF.GT.800) ISKIP=8
      IF(NNF.GT.1000) ISKIP=10
      IF(NNF.GT.1200) ISKIP=12
      IF(NNF.GT.1400) ISKIP=14
      IF(NNF.GT.1600) ISKIP=16
      IF(NNF.GT.1800) ISKIP=18
      IF(NNF.GT.2000) ISKIP=20 
      IF(NNF.GT.3000) ISKIP=30
      SENS=1.0 
      AA=0.0 
      BB=0.0 
      NN=0 
      K=0
      NS=1 
      XMIN=YMIN 
      XMAX=YMAX 
   11 A1=0.0 
      B1=0.9*(XMAX-XMIN)+XMIN 
      NN=NN+NNF 
      IF(NN.GT.N) NN=N 
      DO 13 L=1,INT 
      Y=0.0 
      X=0.0 
      XY=0.0 
      XX=0.0 
      XN=0.0 
      DO 1 I=NS,NN,ISKIP 
      J=I
      READ(LU'J) BX
      Z=I 
      ZZ=A1*Z+B1 
      ZZ=ABS(ZZ) 
      ZZ=ZZ+SQRT(ZZ)*SENS 
      IF(BX.GT.ZZ) GO TO 1 
      Y=Y+BX 
      X=X+Z 
      XY=XY+BX*Z 
      XX=XX+Z*Z 
      XN=XN+1.0 
    1 CONTINUE 
      IF(XN.LT.5.0) GO TO 20 
      DET=X*X-XN*XX 
      AA=(X*Y-XN*XY)/DET 
      BB=(X*XY-XX*Y)/DET 
      Z=ABS(AA-A1) 
      ZZ=ABS(BB-B1) 
      IF(Z.LT.0.01.AND.ZZ.LT.1.0) GO TO 20 
      A1=AA 
   13 B1=BB 
      WRITE(7,31) 
   20 CONTINUE 
      IF(XN.LT.5.0) WRITE(7,31) 
   31 FORMAT(1X,'ERROR IN BKGR') 
      L=NN-NNB 
      IF(XN.LT.5.0) GO TO 40 
      IF(NN.EQ.N) L=N 
      DO 14 I=NS,L 
      X=I 
      J=I
      READ(LU'J) BX
      BG=AA*X+BB 
      IF(BG.LT.XMIN) BG=XMIN 
      WRITE(13'J) BG
      B=BX-BG
      WRITE(LU'J) B
   14 CONTINUE
   40 IF(NN.EQ.N) GO TO 95
      NN=L
      NS=NN+1
      GO TO 11
   95 IF(NF.EQ.0) NF=99
      IF(NF.EQ.0) NF=99
      RETURN
 9999 CONTINUE
      STOP
      END 
