	PROGRAM BKGRND
C
C	TO DETERMINE POSITION OF BACKGROUND 
C
	BYTE INFI(16),OUTFI(16),IEXT(3),IANS,IEXP,LABX(9),LABY(6)
	INTEGER IN,OUT,LI,LO,SNUM,MON,DATE,YEAR
	DIMENSION XA(100),YA(100),C(4),DELY(100)
	DIMENSION AX(102),BX(102),CX(102),DX(102),TEMP(816)
	COMMON/IO/IN,OUT,LI,LO
	COMMON/FILE/INFI,OUTFI,IEXT
	COMMON/DATA/NPTS,A(8000)
	COMMON/HEAD/SNUM,MON,DATE,YEAR,INST(2),MESG(24),TMIN,DELT,
     1 DY,IRAD,WLT,TMAX
	COMMON/FS/XS,XF,YS,YF,XXS,XXF,YYS,YYF
	COMMON/PLOT/STR,FIN,CSTR,CFIN,YMIN,YMAX,CYMIN,CYMAX,IG,ISQ,NS,NF
C
	DATA IN,OUT,LI,LO/2,2,1,1/
	DATA LABX/'T','W','O','-','T','H','E','T','A'/
	DATA LABY/'C','O','U','N','T','S'/
	DATA IEXT/'B','K','G'/
C
	CALL ASSIGN (LO,'TI:')
	CALL ERASE
	CALL RDNAM
	CALL RDFIL
	STR=TMIN
	FIN=TMAX
	YMIN=1000.0
	YMAX=-1000.0
	DO 10 I=1,NPTS
	IF(A(I).LT.YMIN) YMIN=A(I)
	IF(A(I).GT.YMAX) YMAX=A(I)
10	CONTINUE
	CSTR=STR
	CFIN=FIN
	IG=0
	ISQ=0
C
C
16	CALL PLSET(1,2)
	CALL BLKMIN(NBLKS,XA,YA,BYMAX)
	CYMIN=0.0
	CYMAX=2.0*BYMAX
C	ALLOW INTENSE PEAKS TO GO OFF SCALE TO BETTER OBSERVE BACKGROUND
	CALL ERASE
	CALL XAXIS(LABX,2,2)
	CALL YAXIS(LABY,1,2)
	CALL PLTPT(NPTS,A,0)
	CALL PLTLIN(NBLKS,XA,YA)
	CALL LINE(NBLKS,XA,YA)
	Y1=YYS-30.00
	CALL TPLOT(2,0.0,Y1)
	WRITE (LO,50)
	READ (LI,60) IANS
	IF (IANS.EQ.'Y') GO TO 109
	WRITE (LO,103)
103	FORMAT ('$DO YOU WANT TO DELETE SOME BACKGROUND POINTS ? ')
	READ (LI,60) IANS
	IF (IANS.NE.'Y') GO TO 108
	WRITE (LO,104)
104	FORMAT(' USE X-CURSOR AND TYPE "D" TO DELETE BKG POINTS')
	DFX=XXF-XXS
	FA=FLOAT(NPTS)/DFX
	FB=FLOAT(NPTS)-FA*XXF
205	CALL CURSOR(LI,ID,X1,Y1)
	IF(ID.NE.'D') GO TO 209
	IF(X1.LT.XXS) X1=XXS
	IF(X1.GT.XXF) X1=XXF
	X=FA*X1+FB
	DIFX=10000.0
	DO 105 I=1,NBLKS
	DIF=ABS(X-XA(I))
	IF (DIFX.LT.DIF) GO TO 105
	DIFX=DIF
	J1=I
105	CONTINUE
	DO 106	I=J1,NBLKS
	XA(I)=XA(I+1)
	YA(I)=YA(I+1)
106	CONTINUE
	NBLKS=NBLKS-1
	Y1=YYS+20.0
	CALL TPLOT(2,X1,Y1)
	CALL OUTPUT('D',1)
	GO TO 205
108	CALL ERASE
	GO TO 16
C
209	Y1=YYS-100.0
	CALL TPLOT(2,0.0,Y1)
109	WRITE(LO,114)
114	FORMAT ('$ENTER STIFFNESS PARAMETER (0 TO 1000): ')
	READ (LI,115) S
115	FORMAT (F10.0)
	ISQ=0
	CYMIN=0.0
	CYMAX=1.5*BYMAX
	CALL ERASE
	CALL XAXIS(LABX,2,2)
	CALL YAXIS(LABY,1,2)
	CALL PLTLIN(NBLKS,XA,YA)
C
C
C	CUBIC SPLINE
C
222	DO 223 I=1,NBLKS
	IF(INST(1).EQ.'DI') DELY(I)=SQRT(YA(I))
	IF(INST(1).EQ.'FI') DELY(I)=2.
223	CONTINUE
	CALL SMOSP1(XA,YA,DELY,NBLKS,S,AX,BX,CX,DX,TEMP)
	DO 225 I=1,NPTS
	XEVAL=FLOAT(I)
	CALL SMOSP2(XA,AX,BX,CX,DX,NBLKS,XEVAL,YVAL,FDRVAL,SDRVAL)
	A(I)=YVAL
225	CONTINUE
C
230	CALL PLTPT(NPTS,A,1)
	Y1=YYS-50.0
	CALL TPLOT(2,0.0,Y1)
	WRITE (LO,50)
50	FORMAT ('$IS THIS CORRECT ? ')
	READ (LI,60) IANS
60	FORMAT (3A1)
	IF (IANS.NE.'Y') GO TO 109
	CALL RENAME
	CALL WRFILE
C
	CALL CLOSE(LO)
C
	STOP 'BKGRND'
	END
      SUBROUTINE SPLINE(ND2,ISEC)
C                                                           **********
C                                                           **SPLINE**
C                                                           **********
C	CALCULATES A SPLINE FIT FOR A WINDOW OF UP TO 25 POINTS
C
	DIMENSION XA(25),YA(25),DELY(25)
	DIMENSION AX(27),BX(27),CX(27),DX(27),TEMP(216)
	INTEGER IN,OUT,LI,LO,SNUM,MON,DATE,YEAR
	COMMON/IO/ IN,OUT,LI,LO
	COMMON/DATA/NPTS,B(8000)
	COMMON/HEAD/SNUM,MON,DATE,YEAR,INST(2),MESG(24),TMIN,DELT,
     1 DY,IRAD,WLT,TMAX
C	COMMON/SPLIN/ND2,S,DR2L,NUM,IPF,AM
      WRITE(LO,8)
8	FORMAT ('$ENTER SMOOTHING PARAMETER (0 - 10000) : ')
	READ (LI,9) S
9	FORMAT (F10.0)
C
5      NN=0
      IST=1
      M2=ND2/2
      L=-M2
      M=0
      M3=M2+1
      XM2=M2
      M4=ND2-1
C
C	DO LOOP IS FULLY EXECUTED ONLY 1ST TIME
C	AFTERWARDS, IST=ND2
   16 DO 18 I=IST,ND2
      NN=NN+1
      L=L+1
      IF(NN.GT.NPTS) GO TO 95
	XA(I)=FLOAT(NN)
	YA(I)=B(NN)
	IF(YA(I).LT.0.0) YA(I)=0.0
	IF(INST(1).EQ.'DI') DELY(I)=SQRT(YA(I))
	IF(INST(1).EQ.'FI') DELY(I)=2.0
C SHOULD REALLY CALCULATE STD DEV FOR FILM DATA - WILL CHANGE SOMETIME
   18 CONTINUE
      IST=ND2
	CALL SMOSP1(XA,YA,DELY,ND2,S,AX,BX,CX,DX,TEMP)
	XEVAL=XA(M3)
	CALL SMOSP2(XA,AX,BX,CX,DX,ND2,XEVAL,YVAL,FDRVAL,D2)
	IF(ISEC.EQ.0) B(NN-M2)=YVAL
	IF(ISEC.EQ.1) B(NN-M2)=D2
      DO 34 I=1,M4
      J=I+1
	XA(I)=XA(J)
	YA(I)=YA(J)
34	DELY(I)=DELY(J)
      GO TO 16
   95 CONTINUE
      RETURN
      END
       SUBROUTINE SMOSP1(X,Y,DELY,N,S,A,B,C,D,TEMP)
       DIMENSION X(N),Y(N),DELY(N),A(N+2),B(N+2),C(N+2),D(N+2),
     1 TEMP(8*(N+2))
	INTEGER IN,OUT,LI,LO
	COMMON/IO/ IN,OUT,LI,LO
C
C       TEMP ASSUMED TO BE AT LEAST  8*(N+2)
C
       DO 10 I = 2,N
       IF( X(I) .GT. X(I-1) ) GO TO 10
       WRITE (LO,5) I,X(I-1),X(I)
 5     FORMAT('0SMOSP1 CALLED WITH X IN NON-ASCENDING ORDER',I3,2E16.8)
       RETURN
 10    CONTINUE
       DO 20 I = 1,8
       K = (I-1)*N + 2*I-1
       KK = K + N + 1
        TEMP(K ) = 0
        TEMP(KK) = 0
 20    CONTINUE
       CALL SM1SP1(X,Y,DELY,N,S,A,B,C,D,TEMP(1),TEMP(N+3),TEMP(2*N+5),
     1TEMP(3*N+7),TEMP(4*N+9),TEMP( 5*N+11),TEMP(6*N+13),TEMP(7*N+15))
       RETURN
       END
       SUBROUTINE SM1SP1(X,Y,DYT,NOBS,S,A,B,C,D,DY,R,R1,R2,T,T1,U,V)
       DIMENSION X(NOBS),Y(NOBS),DYT(NOBS),A(NOBS+2),B(NOBS+2),
     1 C(NOBS+2),D(NOBS+2),DY(NOBS+2),R(NOBS+2),R1(NOBS+2),
     2 R2(NOBS+2),T(NOBS+2),T1(NOBS+2),U(NOBS+2),V(NOBS+2)
       NN = NOBS
C
C       X    AND Y ARE  U AND V  ARRAYS UNTIL STATEMENT 100
C
       DO 50 I = 1,NN
       U(I+1) = X(I)
       V(I+1) = Y(I)
       DY(I+1) = DYT(I)
 50    CONTINUE
         U(1) = 0
       U(NN+2) = 0
       V(1) = 0
       V(NN+2) = 0
       DY(1) = 0
       DY(NN+2) = 0
C
      N1 = 2
      N2=NOBS+1
      NM1=N1-1
      M2 = N2 - 1
      M1 = N1 + 1
      R(NM1)=0.
      R(N1) = 0.
      R1(N2) = 0.
      R2(N2) = 0.
      R2(M2) = 0.
      P = 0.
       H = U(M1) - U(N1)
       F = ( V(M1) - V(N1))/H
      DO 100 I = M1,M2
      G = H
       H = U(I+1) - U(I)
      E = F
       F = (V(I+1) - V(I))/H
      A(I) = F - E
      T(I) = 2. * (G + H) / 3.
      T1(I) = H / 3.
      R2(I) = DY(I-1) / G
      R(I) = DY(I+1) / H
 100  R1(I) = - DY(I) / G - DY(I) / H
      U(NM1)=0.
      U(N1) = 0.
      U(N2) = 0.
      U(M2) = 0.
      DO 110 I = M1,M2
      B(I) = R(I) * R(I) + R1(I) * R1(I) + R2(I) * R2(I)
      C(I) = R(I) * R1(I+1) + R1(I) * R2(I+1)
 110  D(I) = R(I) * R2(I+2)
      F2 = - S
C     ** NEXT ITERATION
 115  CONTINUE
      DO 120 I = M1,M2
      R1(I-1) = F * R(I-1)
      R2(I-2) = G * R(I-2)
      R(I) = 1. / (P*B(I) + T(I) - F* R1(I-1) - G* R2(I-2))
      U(I) = A(I) - R1(I-1) * U(I-1) -R2(I-2) * U(I-2)
      F = P * C(I) + T1(I) - H*R1(I-1)
      G = H
 120  H = D(I) * P
      DO 130 I = M2,M1,-1
      U(I) = R(I) * U(I) - R1(I) * U(I+1) - R2(I) * U(I+2)
  130 CONTINUE
      E = 0.
      H=0.
      DO 140 I = N1,M2
      G = H
      H = (U(I+1) - U(I)) / (X(I) - X(I-1))
      V(I) = (H - G) * DY(I) * DY(I)
 140  E = E + V(I) * (H - G)
      G = - H * DY(N2) * DY(N2)
      V(N2) = G
      E = E - G * H
      G = F2
      F2 = E * P * P
      IF(F2 .GE. S .OR. F2 .LE. G) GO TO 160
      F = 0.
      H = (V(M1) - V(N1)) / (X(2) - X(1))
      DO 150 I = M1,M2
      G = H
      H = (V(I+1) - V(I)) / (X(I) - X(I-1))
      G = H - G - R1(I-1) * R(I-1) - R2(I-2) * R(I-2)
      F = F + G * R(I) * G
 150  R(I) = G
      H = E - P * F
      IF(H .LE. 0.) GO TO 160
      P = P + (S - F2) / ((SQRT(S/E) + P) * H)
      GO TO 115
C     ** FIN
 160  DO 170 I = N1,N2
       A(I) = Y(I-1) - P*V(I)
 170  C(I) = U(I)
      DO 180 I = N1,M2
       H = X(I) - X(I-1)
      D(I) = (C(I+1) - C(I)) / (3. * H)
 180  B(I) = (A(I+1) - A(I)) / H - (H * D(I) + C(I)) * H
C
      RETURN
      END
       SUBROUTINE SMOSP2(X,A,B,C,D,N,XEVAL,YVAL,FDRVAL,SDRVAL)
       DIMENSION X(N),A(N+2),B(N+2),C(N+2),D(N+2)
       I = 1
       IF ( XEVAL  .LT. X(1)) GO TO 100
       I = N -1
       IF( XEVAL  .GE.  X(N-1)) GO TO 100
        I = 1
 40    IF(XEVAL  .GE.X(I)   .AND.  XEVAL.LE. X(I+1)) GO TO 100
       I = I+1
       GO TO 40
 100   H = XEVAL - X(I)
       I = I+1
       YVAL=((D(I)*H +C(I))*H +B(I))*H+A(I)
      FDRVAL=(3.*D(I)*H +2.*C(I))*H + B(I)
      SDRVAL= 6.*D(I)*H +2.*C(I)
      RETURN
      END
	SUBROUTINE BLKMIN(NBLKS,XA,YA,BYMAX)
C
C	RETURN ARRAY OF MINIMUM INTENSITIES
C
	BYTE IANS
	INTEGER IN,OUT,LI,LO,SNUM,MON,DATE,YEAR
	DIMENSION XA(100),YA(100)
	COMMON/IO/IN,OUT,LI,LO
	COMMON/DATA/NPTS,A(8000)
	COMMON/HEAD/SNUM,MON,DATE,YEAR,INST(2),MESG(24),TMIN,DELT,
     1 DY,IRAD,WLT,TMAX
C
C
	MINPB=NPTS/99
	WRITE(LO,20) MINPB
20	FORMAT(/,' THE DATA POINTS WILL BE DIVIDED INTO BLOCKS'/
     1 ' THE MINIMUM NUMBER OF POINTS PER BLOCK IS :'I3/
     2 '$ENTER NUMBER OF POINTS PER BLOCK :')
	READ (LI,30) NPB
30	FORMAT (I)
	IF (NPB.LT.MINPB) NPB=MINPB
	NBLKS=NPTS/NPB
C
C	NBLKS EXCUDES THE LAST FEW POINTS - MAY WANT TO FIX THIS LATER
C
C	FIND THE MINIMUM INTENSITY WITHIN EACH BLOCK AND AVERAGE ITS
C	VALUE WITH ITS NEIGHBORS.  PLOT OUT POINTS.
C
	WRITE (LO,60)
60	FORMAT (/,' POINTS AROUND THE MINIMUM WILL BE AVERAGED FROM'/
     1  '$MIN-NP TO MIN+NP. ENTER NUMBER OF POINTS, NP: ')
	READ (LI,30) NP
	J1=1
	J2=NPB
	BYMAX=-9999.
	DO 100 I=1,NBLKS
	YMIN=9.0E6
	DO 70 J=J1,J2
	IF (A(J).GE.YMIN) GO TO 70
	YMIN=A(J)
	JSAV=J
70	CONTINUE
	XA(I)=FLOAT(JSAV)
	K1=JSAV-NP
	K2=JSAV+NP
	YMIN=0.0
	IF (K1.GT.0) GO TO 80
	K1=1
	K2=1+2*NP
	GO TO 82
80	IF(K2.LE.NPTS) GO TO 82
	K1=NPTS-2*NP
	K2=NPTS
82	DO 90 K=K1,K2
90	YMIN=YMIN+A(K)
	YA(I)=YMIN/(2*NP+1)
	IF(YA(I).GT.BYMAX) BYMAX=YA(I)
	J1=J1+NPB
	J2=J2+NPB
100	CONTINUE
	RETURN
	END
