C----
C---- $Id: data.f,v 1.2 1995/11/10 14:16:18 hooft Exp $
C----
      SUBROUTINE CALC_EXTREMES
      INCLUDE    'SCATTER.INC'
      REAL       HULP, AXMAX
      INTEGER    I

      DMAXX=DATAX(1)+DATASDX(1)
      DMINX=DATAX(1)-DATASDX(1)
      DO I=2,NDATA
        DMINX=MIN(DMINX,DATAX(I)-DATASDX(I))
        DMAXX=MAX(DMAXX,DATAX(I)+DATASDX(I))
      END DO
      IF (SCUMAV.LE.0) THEN
        DMAXY=DATAY(1)+DATASDY(1)
        DMINY=DATAY(1)-DATASDY(1)
        DO I=2,NDATA
          DMINY=MIN(DMINY,DATAY(I)-DATASDY(I))
          DMAXY=MAX(DMAXY,DATAY(I)+DATASDY(I))
        END DO
      END IF
      HULP=DMAXX-DMINX
      DMINX=DMINX-HULP*SPACE/100.0
      DMAXX=DMAXX+HULP*SPACE/100.0
      HULP=DMAXY-DMINY
      DMINY=DMINY-HULP*SPACE/100.0
      DMAXY=DMAXY+HULP*SPACE/100.0
      DMAXR=DATAR(1)
      DMINR=DATAR(1)
      DO I=2,NDATA
        DMINR=MIN(DMINR,DATAR(I))
        DMAXR=MAX(DMAXR,DATAR(I))
      END DO
C----
C---- Fit plot extremes to account for extra lines.
C----
      DO I=1,EXTRALINE1
        DMAXX=MAX(DMAXX,LINE1VAL(I))
        DMINX=MIN(DMINX,LINE1VAL(I))
      END DO
      IF (SCUMAV.LE.0) THEN
        DO I=1,EXTRALINE2
          DMAXY=MAX(DMAXY,LINE2VAL(I))
          DMINY=MIN(DMINY,LINE2VAL(I))
        END DO
      END IF
C----
C---- Fit plot extremes to account for SX SY EX EY options
C----
      HULP=DMINX
      IF (SX.LT.DMAXX) DMINX=SX
      IF (EX.GT.HULP) DMAXX=EX
      HULP=DMINY
      IF (SY.LT.DMAXY) DMINY=SY
      IF (EY.GT.HULP) DMAXY=EY
      IF (NR.GE.0) THEN
        HULP=DMINR
        IF (SR.LT.DMAXR) DMINR=SR
        IF (ER.GT.HULP) DMAXR=ER
      ENDIF
C----
C---- Make domain square if asked.
C----
      IF (SHRINK_SQUARE) THEN
        DMINX=MAX(DMINX,DMINY)
        DMINY=DMINX
        DMAXX=MIN(DMAXX,DMAXY)
        DMAXY=DMAXX
      ELSE IF (EXTEND_SQUARE) THEN
        DMINX=MIN(DMINX,DMINY)
        DMINY=DMINX
        DMAXX=MAX(DMAXX,DMAXY)
        DMAXY=DMAXX
      ENDIF 
C----
C---- Make scaling.
C----
      IF (DMAXX.EQ.DMINX) THEN
        DMAXX=DMAXX+0.5
        DMINX=DMINX-0.5
        WRITE (*,*) 'WARNING: all X equal. X-scaling fake.'
      ENDIF
      XRANG=DMAXX-DMINX
      IF (DMAXY.EQ.DMINY) THEN
        DMAXY=DMAXY+0.5
        DMINY=DMINY-0.5
        WRITE (*,*) 'WARNING: all Y equal. Y-scaling fake.'
      ENDIF
      YRANG=DMAXY-DMINY

      AXMAX=AXDIV

      ASCALX=IFIX(100+LOG(XRANG/AXMAX)/LOG(10.))-99
      ASCALY=IFIX(100+LOG(YRANG/AXMAX)/LOG(10.))-99
      PSCALX=10.0**ASCALX
      PSCALY=10.0**ASCALY

      IF (XSIXTY) THEN
        PSCALX=60.0
        WRITE (*,*) 'PSCALX set to 60.0'
      ENDIF

      IF (YSIXTY) THEN
        PSCALY=60.0
        WRITE (*,*) 'PSCALY set to 60.0'
      ENDIF

      IF (TEX) THEN
         WRITE(SSCALX,1001) ASCALX
         WRITE(SSCALY,1001) ASCALY
      ELSE
         WRITE(SSCALX,1090) ASCALX
         WRITE(SSCALY,1090) ASCALY
      END IF
 1001 FORMAT ('/10$^',I4,'$')
 1090 FORMAT ('/10^',I4)
      CALL COLLAPSE (SSCALX)
      CALL COLLAPSE (SSCALY)
C----
C---- if AX given, make round numbers
C----
      IF (AX) THEN
         HULP=DMINX
         DMINX=IFIX(DMINX/PSCALX+0.0001)*PSCALX
         IF (HULP/PSCALX.LT.0) DMINX=DMINX-PSCALX
         HULP=DMINY
         DMINY=IFIX(DMINY/PSCALY+0.0001)*PSCALY
         IF (HULP/PSCALY.LT.0) DMINY=DMINY-PSCALY
         HULP=DMAXX
         DMAXX=IFIX(DMAXX/PSCALX-0.0001)*PSCALX
         IF (HULP/PSCALX.GT.0) DMAXX=DMAXX+PSCALX
         HULP=DMAXY
         DMAXY=IFIX(DMAXY/PSCALY-0.0001)*PSCALY
         IF (HULP/PSCALY.GT.0) DMAXY=DMAXY+PSCALY
      END IF
C----
C---- Reverse axes if asked to do so.
C----
      IF (REVX) THEN
         RMINX=DMAXX 
         RMAXX=DMINX 
      ELSE
         RMINX=DMINX
         RMAXX=DMAXX
      END IF
      IF (REVY) THEN
         RMINY=DMAXY 
         RMAXY=DMINY 
      ELSE
         RMINY=DMINY
         RMAXY=DMAXY
      END IF
C----
C---- Make labels in text format for the axes
C----
      IF (FULLNUM) THEN
         WRITE (SMINX,1002) NINT(RMINX)
         WRITE (SMAXX,1002) NINT(RMAXX)
         WRITE (SMINY,1002) NINT(RMINY)
         WRITE (SMAXY,1002) NINT(RMAXY)
         SSCALY=' '
         SSCALX=' '
      ELSE
         WRITE (SMINX,1002) NINT(RMINX/PSCALX)
         WRITE (SMAXX,1002) NINT(RMAXX/PSCALX)
         WRITE (SMINY,1002) NINT(RMINY/PSCALY)
         WRITE (SMAXY,1002) NINT(RMAXY/PSCALY)
      END IF
 1002 FORMAT(I7)
      CALL COLLAPSE (SMINX)
      CALL COLLAPSE (SMINY)
      CALL COLLAPSE (SMAXX)
      CALL COLLAPSE (SMAXY)

      RETURN
      END


      SUBROUTINE SMOOTH_DATA
      INCLUDE    'SCATTER.INC'
      INTEGER    I
      REAL       XSUM, YSUM, RSUM, XPNT, YPNT, RPNT

      XSUM=0.0
      YSUM=0.0
      RSUM=0.0
      IF (NDATA.LE.SMOOTH) THEN
         STOP 'Too much smoothing requested.'
      END IF
      DO I=1,SMOOTH
         XSUM=XSUM+DATAX(I)
         YSUM=YSUM+DATAY(I)
         RSUM=RSUM+DATAR(I)
      END DO
      DO I=SMOOTH+1,NDATA
         XPNT=XSUM/SMOOTH
         YPNT=YSUM/SMOOTH
         RPNT=RSUM/SMOOTH
         XSUM=XSUM+DATAX(I)-DATAX(I-SMOOTH)
         YSUM=YSUM+DATAY(I)-DATAY(I-SMOOTH)
         RSUM=RSUM+DATAR(I)-DATAR(I-SMOOTH)
         DATAX(I-SMOOTH)=XPNT
         DATAY(I-SMOOTH)=YPNT
         DATAR(I-SMOOTH)=RPNT
      END DO
      NDATA=NDATA-SMOOTH+1
      DATAX(NDATA)=XSUM/SMOOTH
      DATAY(NDATA)=YSUM/SMOOTH
      DATAR(NDATA)=RSUM/SMOOTH
      RETURN
      END

      SUBROUTINE AVER_DATA
      INCLUDE     'SCATTER.INC'
      INTEGER     I, J, K, L
      REAL        XSUM, YSUM, RSUM

      IF (NDATA.LE.AVER) THEN
        STOP 'Too much averaging requested.'
      END IF
      J=1
      L=0
      DO WHILE (J.LT.NDATA)
        L=L+1
        K=J+AVER-1
        IF (K.GT.NDATA) K=NDATA
        XSUM=0
        YSUM=0
        RSUM=0
        DO I=J,K
          XSUM=XSUM+DATAX(I)
          YSUM=YSUM+DATAY(I)
          RSUM=RSUM+DATAR(I)
        END DO
        DATAX(L)=XSUM/(K-J+1)
        DATAY(L)=YSUM/(K-J+1)
        DATAR(L)=RSUM/(K-J+1)
        J=K+1
      END DO
      NDATA=L        
      RETURN
      END

      SUBROUTINE CUMAV_DATA
      INCLUDE    'SCATTER.INC'
      INTEGER    I
      REAL       YSUM
      DO I=1,NDATA
        YSUM=YSUM+DATAY(I)
        DATAY(I)=YSUM/I
      ENDDO
C----
C---- If line at cumav requested, add horizontal line.
C----
      IF (LCUMAV) THEN
        IF (EXTRALINE2.GE.NLMAX) STOP 'Too many horizontal lines'
        EXTRALINE2=EXTRALINE2+1
        LINE2VAL(EXTRALINE2)=YSUM/NDATA
      ENDIF
C----
C---- Change vertical scale?
C----
      IF (SCUMAV.GT.0) THEN
        DMINY=YSUM/NDATA-SCUMAV
        DMAXY=YSUM/NDATA+SCUMAV
      ENDIF
      RETURN
      END

      SUBROUTINE CUMSUM_DATA
      INCLUDE 'SCATTER.INC'
      INTEGER I
      DO I=2,NDATA
         DATAY(I)=DATAY(I)+DATAY(I-1)
      END DO
      WRITE(*,*) 'Final sum of all data: ',DATAY(NDATA)
      IF (LOGY) THEN
         WRITE(*,*) 'Log of this sum: ',LOG(DATAY(NDATA))/LOG(10.0)
      END IF
      END

      SUBROUTINE FFT_DATA
      INCLUDE    'SCATTER.INC'
      REAL       SUM, AV
      INTEGER    NN, I

      IF (NDATA.GT.1024) WRITE(*,*) 'Calculating FFT...'
      NN=2
      DO WHILE (NN.LT.NDATA)
         NN=NN*2
      END DO
      IF (NN*2.GT.IMAX) STOP 'FFT too large.'
      SUM=0.0
      DO I=1,NDATA
         SUM=SUM+DATAY(I)
      END DO
      AV=SUM/NDATA
      DO I=NDATA+1,2*NN
         DATAY(I)=AV
      END DO
      CALL FOURIER (DATAY,2*NN)
      DO I=1,NDATA
         DATAX(I)=DATAX(I)*NDATA/(2*NN)
      END DO
      RETURN
      END

      SUBROUTINE PFFT_DATA
      INCLUDE 'SCATTER.INC'
      INTEGER NN
      IF (NDATA.GT.2048) WRITE(*,*) 'Calculating PFFT...'
      NN=2
      DO WHILE (NN.LT.NDATA)
         NN=NN*2
      END DO
      IF (NN.NE.NDATA) STOP 'PFFT not power of two.'
      CALL FOURIER (DATAY,NDATA)
      NDATA=NDATA/2
      RETURN
      END

      SUBROUTINE PEAK_DATA
      INCLUDE 'SCATTER.INC'
      REAL    XPEAK(200), YPEAK(200), XX, YY
      INTEGER I, NPEAK, J, K

      IF (PEAK.GT.199) THEN
         WRITE(*,*) ' No more than 199 peaks will be located.'
         PEAK=199
      END IF
      DO I=2,NDATA-1
         IF (DATAY(I).GT.DATAY(I-1).AND.DATAY(I).GT.DATAY(I+1)) THEN
            XX=DATAX(I)
            YY=DATAY(I)
            J=1
            DO WHILE (J.LE.NPEAK.AND.YPEAK(J).GT.YY) 
               J=J+1
            END DO
            IF (J.GT.NPEAK) THEN
               IF (NPEAK.LT.PEAK) THEN
                  NPEAK=J
                  XPEAK(J)=XX
                  YPEAK(J)=YY
               END IF                           
            ELSE
               DO K=NPEAK,J,-1
                  XPEAK(K+1)=XPEAK(K)
                  YPEAK(K+1)=YPEAK(K)
               END DO
               IF (NPEAK.LT.PEAK) NPEAK=NPEAK+1
               XPEAK(J)=XX
               YPEAK(J)=YY
            END IF
        END IF
      END DO
      IF (NPEAK.EQ.0) THEN 
         WRITE(*,*) 'No peaks could be located.'
      ELSE
         WRITE(*,*) '-->',NPEAK,' Peaks were located:'
      END IF      
      DO I=1,NPEAK
         WRITE(*,*) '  at ',XPEAK(I),' height ',YPEAK(I)
      END DO
      RETURN
      END

      SUBROUTINE LOGX_DATA
      INCLUDE 'SCATTER.INC'
      INTEGER I
      DO I=1,NDATA
         IF (DATAX(I).LE.0) THEN
            WRITE(*,*) 'Just prevented logarithm of negative/zero x'
            DATAX(I)=0
            DATASDX(I)=10000*DATASDX(I)
         ELSE
            DATASDX(I)=DATASDX(I)/DATAX(I)/LOG(10.0)
            DATAX(I)=LOG(DATAX(I))/LOG(10.0)
         END IF
      END DO
      RETURN
      END

      SUBROUTINE LOGY_DATA
      INCLUDE    'SCATTER.INC'
      INTEGER    I

      DO I=1,NDATA
         IF (DATAY(I).LE.0) THEN
            WRITE(*,*) 'Just prevented logarithm of negative/zero y'
            DATAY(I)=0
            DATASDY(I)=10000*DATASDY(I)+10.0
         ELSE
            DATASDY(I)=DATASDY(I)/DATAY(I)/LOG(10.0)
            DATAY(I)=LOG(DATAY(I))/LOG(10.0)
         END IF
      END DO
      RETURN
      END

      SUBROUTINE LOGR_DATA
      INCLUDE 'SCATTER.INC'
      INTEGER I

      DO I=1,NDATA
         IF (DATAR(I).LE.0) THEN
            WRITE(*,*) 'Just prevented logarithm of negative/zero r'
            DATAR(I)=1
         END IF
         DATAR(I)=LOG(DATAR(I))/LOG(10.0)
      END DO
      RETURN
      END

      SUBROUTINE LEAST_SQUARES
      INCLUDE 'SCATTER.INC'
      INTEGER II
      REAL    Z

      IF (ROBUST) THEN
         IF (NDATA.GT.512) PRINT *,'Calculating robust fit.'
         CALL MEDFIT(DATAX,DATAY,NDATA,A,B,ABDEV)
      ELSE
         CALL FIT(DATAX,DATAY,NDATA,DATASDY,NSDY,A,B,SIGA,SIGB,CHI2,Q)
         IF (NSDY.EQ.0) CALL PEARSN(DATAX,DATAY,NDATA,R,PROB,Z)
         IF (BLSQ) THEN
            IF (NSDX.EQ.0) THEN
               PRINT*,' USED FIXED ERROR IN X TO DETERMINE BLSQ'
               DO II=1,NDATA
                  DATASDX(II)=ERX
               END DO
            END IF
            IF (NSDY.EQ.0) THEN
               PRINT*,' USED FIXED ERROR IN Y TO DETERMINE BLSQ'
               DO II=1,NDATA
                  DATASDY(II)=ERY
               END DO
            END IF
            CALL GENERAL_FIT(DATAX,DATAY,DATASDX,DATASDY,NDATA,A,B,
     1           CHI2,Q)
         END IF
      END IF
      RETURN
      END

      SUBROUTINE RESTRAIN_DATA
      INCLUDE 'SCATTER.INC'
      INTEGER I

      DO I=1,NDATA
         IF (DATAX(I).GT.DMAXX) THEN
            DATAX(I)=DMAXX
         ELSE IF (DATAX(I).LT.DMINX) THEN
            DATAX(I)=DMINX
         END IF
         IF (DATAY(I).GT.DMAXY) THEN
            DATAY(I)=DMAXY
         ELSE IF (DATAY(I).LT.DMINY) THEN
            DATAY(I)=DMINY
         END IF
      END DO
      RETURN
      END

      SUBROUTINE ACF_DATA
      INCLUDE 'SCATTER.INC'
      REAL    ANS(IMAX)
      REAL    SUM, AV
      INTEGER NN,I
      IF (NDATA.GT.1024) WRITE(*,*) 'Calculating ACF...'
      nn=2
      DO WHILE (NN.LT.NDATA)
         NN=NN*2
      END DO
      IF (NN*2.GT.IMAX) STOP 'ACF too large.'
      SUM=0.0
      DO I=1,NDATA
         SUM=SUM+DATAY(I)
      END DO
      AV=SUM/NDATA
      DO I=1,NDATA
         DATAY(I)=DATAY(I)-AV
      END DO
      DO I=NDATA+1,2*NN
         DATAY(I)=0.0
      END DO
      CALL CORREL (DATAY,DATAY,NN,ANS)
      DO I=1,NDATA
         DATAY(I)=(NDATA)/(NDATA-I+1)*ANS(I)/ANS(1)
      END DO
      RETURN
      END

      SUBROUTINE RANK_DATA
      INCLUDE 'SCATTER.INC'
      REAL    DUM1(IMAX),DUM2(IMAX),ZD,Z

      CALL SPEAR (DATAX,DATAY,NDATA,DUM1,DUM2,DD,ZD,DDPROB,RS,RSPROB)
C      WRITE(*,600) DD,DDPROB,RS,RSPROB
C 600  FORMAT(' NON PARAMETRIC CORRELATION CALCULATION:'/
C     1    ' SUM OF SQUARES D-SQUARED=',G,' PROBABILITY= ',F8.6/
C     2    ' SPEARMAN''S RANK-CORRELATION RS=',F8.5,
C     3    ' PROBABILITY= ',F8.6)
      IF (NDATA.LT.ITAU) THEN
         CALL KENDL1 (DATAX,DATAY,NDATA,TAU,Z,TAUPROB)
C        WRITE(*,601) TAU,TAUPROB
C 601    FORMAT(' KENDALL''S TAU=',F8.5,' PROBABILITY= ',F8.6)
      ELSE
         WRITE(*,602)
  602    FORMAT(' Too much data for Kendall''s tau computation.')
      END IF
      RETURN
      END

