C----
C---- $Id: scatter.f,v 1.2 1995/11/10 14:16:27 hooft Exp $
C----
C---- Scatter V2 by Rob W.W. Hooft, 1990-1995
C----
      PROGRAM SCATTER
      INCLUDE       'SCATTER.INC'
      INTEGER       I,LENGTH
      EXTERNAL      SWAPDATA
      REAL          XTEMP
C----
C---- INITIALISATION
C----
      CALL INIT_DEFAULTS
      CALL READ_OPTIONS
      CALL POSTER_POSITIONING
C----
C---- Interpretation of options, check for illegal combinations.
C----
      IF (NDOT.GT.0.AND.SECSTR)
     +     STOP 'Combination of NDOT and SECSTR impossible.'
      IF (IPL.GT.1.AND..NOT.APPEND)
     +     WRITE(*,*) 'Warning: no APPEND, but IPL<>1. New POSFILE.'
      IF (IPL.GT.NPLX*NPLY)
     +     STOP 'IPL refers to impossible position'
      IF (LSQ.EQ.1.AND.(NSDX.NE.0.OR.ERX.GT.0))
     +     BLSQ=.true.
      IF (NSDY.GT.0.AND.CUMAV)
     +     STOP 'Do not select CUMAV and NSDY.'
      IF (NSDY.GT.0.AND.CUMSUM)
     +     STOP 'Do not select CUMSUM and NSDY.'
      IF (NSDX.GT.0.AND.CUMAV)
     +     STOP 'Do not select CUMAV and NSDX.'
      IF (NSDX.GT.0.AND.CUMSUM)
     +     STOP 'Do not select CUMSUM and NSDX.'
      IF (NSDY.GT.0.AND.SMOOTH.GT.1)
     +     STOP 'Do not select SMOOTH and NSDY.'
      IF (NSDX.GT.0.AND.SMOOTH.GT.1)
     +     STOP 'Do not select SMOOTH and NSDX.'
      IF (NSDY.GT.0.AND.AVER.GT.1)
     +     STOP 'Do not select AVER and NSDY.'
      IF (NSDX.GT.0.AND.AVER.GT.1)
     +     STOP 'Do not select AVER and NSDX.'
      IF (NX.NE.0.AND.FFT) 
     +     STOP 'Use FFT only with NX 0'
      IF (NX.NE.0.AND.PFFT) 
     +     STOP 'Use PFFT only with NX 0'
      IF (FFT.AND.PFFT) 
     +     STOP 'Combination of PFFT and FFT nonsense'
      IF (NX.NE.0.AND.ACF) 
     +     STOP 'Use ACF only with NX 0'
      IF (ROBUST.AND.NSDY.GT.0) 
     +     STOP 'Cannot handle ROBUST with NSDY'
      IF (ROBUST.AND.NSDX.GT.0) 
     +     STOP 'Cannot handle ROBUST with NSDX'
      IF (ROBUST.AND.BLSQ) 
     +     STOP 'Cannot handle ROBUST with Error in X'
      IF (CUMAV.AND.FFT) 
     +     STOP 'Combination of CUMAV and FFT not sensible'
      IF (CUMSUM.AND.FFT) 
     +     STOP 'Combination of CUMSUM and FFT not sensible'
      IF (CUMAV.AND.PFFT) 
     +     STOP 'Combination of CUMAV and PFFT not sensible'
      IF (CUMSUM.AND.PFFT) 
     +     STOP 'Combination of CUMSUM and PFFT not sensible'
      IF (CUMAV.AND.ACF) 
     +     STOP 'Combination of CUMAV and ACF not sensible'
      IF (CUMSUM.AND.ACF) 
     +     STOP 'Combination of CUMSUM and ACF not sensible'
      IF (ACF.AND.FFT)
     +     STOP 'Combination of FFT and ACF not sensible'
      IF (ACF.AND.PFFT)
     +     STOP 'Combination of PFFT and ACF not sensible'
      IF (CUMAV.AND.AVER.GT.1)
     +     STOP 'Combination of CUMAV and AVER not sensible'
      IF (CUMSUM.AND.AVER.GT.1)
     +     STOP 'Combination of CUMSUM and AVER not sensible'
      IF (SMOOTH.GT.1.AND.AVER.GT.1)
     +     STOP 'Combination of SMOOTH and AVER not sensible'
      IF (SMOOTH.GT.1.AND.CUMAV)
     +     STOP 'Combination of SMOOTH and CUMAV not sensible'
      IF (SMOOTH.GT.1.AND.CUMSUM)
     +     STOP 'Combination of SMOOTH and CUMSUM not sensible'
      IF (SHRINK_SQUARE.AND.SCUMAV.GT.0)
     +     STOP 'Combination of SHRINK_SQUARE and SCUMAV questionable'
      IF (EXTEND_SQUARE.AND.SCUMAV.GT.0)
     +     STOP 'Combination of EXTEND_SQUARE and SCUMAV questionable'
      IF (TORSR.AND.NSDX.GT.0)
     +     STOP 'Combination of TORSR and SDX impossible'
      IF (TORSR.AND.NSDY.GT.0)
     +     STOP 'Combination of TORSR and SDY impossible'
      IF (RANK.AND.NSDX.GT.0)
     +     STOP 'Combination of RANK and SDX impossible'
      IF (RANK.AND.NSDY.GT.0)
     +     STOP 'Combination of RANK and SDY impossible'
      IF (POLYGRADE.GT.50) 
     +     STOP 'Too high polynomial grade'
      IF (POLYGRADE.GT.0.AND.NSDX.GT.0) 
     +     STOP 'Poly-fit only without NSDX'
      IF (POLYGRADE.GT.0.AND.NSDY.LE.0) 
     +     PRINT *,'Be careful when using POLY without NSDY!'
      IF (POLYGRADE.GT.0.AND.LSQ.EQ.1)
     +     STOP 'Do not combine LSQ and POLY'
C----
C---- Generate filenames
C----
      CALL FILNAM (FN,'scatter','dat',FILENAME)
      IF (LENGTH(FILENAME2).EQ.0)
     +     CALL FILNAM_THISTYPE(FN,'scatter','fig',FILENAME2)
C----
C---- Generate default axes-text.
C----
      IF (LENGTH(XTEKST).EQ.0) THEN
         IF (NX.EQ.0) THEN
            IF (FFT) THEN
               XTEKST='Frequency'
            ELSE IF (PFFT) THEN
               XTEKST='Frequency'
            ELSE IF (ACF) THEN
               XTEKST='Lag'
            ELSE
               XTEKST='Time'
            ENDIF
         ELSE
            WRITE(XTEKST,1010) NX
 1010       FORMAT ('Column',I3)
         ENDIF
      ENDIF
      IF (LENGTH(YTEKST).EQ.0) THEN
         IF (NX.EQ.0) THEN
            IF (FFT.OR.PFFT) THEN
               YTEKST='Relative Amplitude'
            ELSE IF (ACF) THEN
               YTEKST='Correlation'
            ENDIF
         ELSE IF (NY.EQ.0) THEN
            YTEKST='Time'
         ELSE
            WRITE (YTEKST,1010) NY
         ENDIF
      ENDIF
C----
C---- Read datafile.
C----
      CALL READ_DATA
C----
C---- Quit if no data.
C----
      IF (NDATA.EQ.0) GOTO 995
C----
C---- Sort data if required.
C----
      IF (SORTX) THEN
         CALL AQSORTS (DATAX,NDATA,SWAPDATA)
      ENDIF
C----
C---- Smooth data if required.
C----
      IF (SMOOTH.GT.1) CALL SMOOTH_DATA
C----
C---- Average data if required.
C----
      IF (AVER.GT.1) CALL AVER_DATA
C----
C---- Calculate Rank-correlation
C----
      IF (RANK) CALL RANK_DATA
C----
C---- Calculate cumulative average
C----
      IF (CUMAV) CALL CUMAV_DATA
C----
C---- Calculate cumulative average
C----
      IF (CUMSUM) CALL CUMSUM_DATA
C----
C---- fourier transform data
C----
      IF (FFT) CALL FFT_DATA
      IF (PFFT) CALL PFFT_DATA
      IF (ACF) CALL ACF_DATA
C----
C---- Logarithmic scaling?
C----
      IF (LOGX) CALL LOGX_DATA
      IF (LOGY) CALL LOGY_DATA
      IF (LOGR) CALL LOGR_DATA
C----
C---- Peak location
C----
      IF (PEAK.GT.0) CALL PEAK_DATA
C----
C---- Compute least squares line.
C----
      IF (LSQ.GT.0) CALL LEAST_SQUARES
C----
C---- Compute POLYNOMIAL fit
C----
      IF (POLYGRADE.GT.0) THEN
         IF (NSDY.LT.1) THEN
            DO I=1,NDATA
               DATASDY(I)=1.0
            ENDDO
         ENDIF
         CALL POLYNOMIAL_FIT(DATAX,DATAY,DATASDY,NDATA,CHI2,POLYGRADE)
      ENDIF
C----
C---- Determine extremes.
C----
      CALL CALC_EXTREMES
C----
C---- restrain data to plot.
C----
      CALL RESTRAIN_DATA
C----
C---- Print summary
C----
      NXLINES=0
      WRITE(6,1098)
 1098 FORMAT(72('='))
      CALL LINECI (.FALSE.,'Number of lines :',NLIN)
      IF (SMOOTH.GT.1) THEN
         CALL LINECIC (.FALSE.,'Number of data :',NDATA,'(smoothed)')
      ELSE IF (AVER.GT.1) THEN
         CALL LINECIC (.FALSE.,'Number of data :',NDATA,'(averaged)')
      ELSE
         CALL LINECI (.FALSE.,'Number of data :',NDATA)
      ENDIF
      CALL LINECRCR (.FALSE.,'x Range :',DMINX,'-',DMAXX)
      CALL LINECRCR (.FALSE.,'y Range :',DMINY,'-',DMAXY)
      IF (NR.GT.-1.AND..NOT.SECSTR) THEN
         CALL LINECRCR (.TRUE.,'r Range :',DMINR,'-',DMAXR)
      ENDIF
      WRITE (6,1099)
 1099 FORMAT()
      IF (LSQ.EQ.1) THEN
         IF (BLSQ) THEN
            CALL LINEC (.TRUE.,'ERX Least Squares fit:')
            CALL LINECR (.TRUE.,'Slope :',B)
            CALL LINECR (.TRUE.,'Intercept :',A)
            CALL LINECR (.TRUE.,'Chi2 :',CHI2)
         ELSE IF (ROBUST) THEN
            CALL LINEC (.TRUE.,'Least Abs Deviations fit:')
            CALL LINECR (.TRUE.,'Slope :',B)
            CALL LINECR (.TRUE.,'Intercept :',A)
            CALL LINECR (.TRUE.,'Abdev :',ABDEV)
         ELSE IF (NSDY.NE.0) THEN
            CALL LINEC (.TRUE.,'Weighted Least Squares fit:')
            CALL LINECRCR (.TRUE.,'Slope :',B,'+/-',SIGB)
            CALL LINECRCR (.TRUE.,'Intercept :',A,'+/-',SIGA)
            CALL LINECRCR (.TRUE.,'Chi2 / Q :',CHI2,'/',Q)
         ELSE
            CALL LINEC (.TRUE.,'Least Squares fit:')
            CALL LINECRCR (.TRUE.,'Slope :',B,'+/-',SIGB)
            CALL LINECRCR (.TRUE.,'Intercept :',A,'+/-',SIGA)
            CALL LINECR (.TRUE.,'Chi2 :',CHI2)
            CALL LINECRCR (.TRUE.,'R / Prob :',R,' / ',PROB)
         ENDIF
         IF (EXTRALINE1.GT.0) WRITE (6,1099)
         DO I=1,EXTRALINE1
            XTEMP=B*LINE1VAL(I)+A
            CALL LINECRCR (.TRUE.,'X=',LINE2VAL(I),'at Y=',XTEMP)
         ENDDO
         IF (EXTRALINE2.GT.0) WRITE (6,1099)
         DO I=1,EXTRALINE2
            XTEMP=(LINE2VAL(I)-A)/B
            CALL LINECRCR (.TRUE.,'Y=',LINE2VAL(I),'at X=',XTEMP)
         ENDDO
      ENDIF
      IF (RANK) THEN
         CALL LINEC (.TRUE.,'Non parametric correlation calculation:')
         CALL LINECRCR (.TRUE.,'D-squared :',DD,'Prob :',DDPROB)
         CALL LINECRCR (.TRUE.,'Spearman-R :',RS,'Prob :',RSPROB)
         IF (NDATA.LT.ITAU) THEN
            CALL LINECRCR (.TRUE.,'Kendall tau :',TAU,'Prob :',TAUPROB)
         END IF
      END IF
      IF (POLYGRADE.GT.0) THEN
         CALL LINECI (.TRUE.,'Polynomial order: ',POLYGRADE)
      END IF
      WRITE(6,1098)
      IF (IWAR1.GE.2) WRITE(6,635) IWAR1
635   FORMAT (I6,' errors in numbers')
      IF (IWAR2.GE.2) WRITE(6,645) IWAR2
645   FORMAT (I6,' times not enough words')
C----
C---- INITIALIZE PARAMETERS FOR POSITIONING FUNCTIONS IX,IY AND IR
C----
      CALL INITSCAL
C----
C---- NOW CREATE THE PLOT. 
C----
      CALL CREATE_POSFILE
      CALL CREATE_FIG
C----
C---- Normal end
C----
9999  CONTINUE
      STOP 'Normal end'

995   CONTINUE
      WRITE (6,*) 'No data, no plot.'
      CALL ERROR
      END 

      SUBROUTINE SWAPDATA(I,J)
      INCLUDE 'SCATTER.INC'
      REAL RR
      INTEGER I,J
      RR=DATAY(I)  
      DATAY(I)=DATAY(J)    
      DATAY(J)=RR
      RR=DATAR(I)
      DATAR(I)=DATAR(J)
      DATAR(J)=RR
      RR=DATASDX(I)
      DATASDX(I)=DATASDX(J)
      DATASDX(J)=RR
      RR=DATASDY(I)
      DATASDY(I)=DATASDY(J)
      DATASDY(J)=RR
      RETURN
      END

      SUBROUTINE BETTER_FIT(X,Y,SX,SY,N,A,B,SIGA,SIGB,COV,R)
C----
C---- WATCH OUT: Y = BX+A AS IN THE ARTICLE
C----
C---- REFERENCE:
C----  JOURNAL OF CHEMICAL EDUCATION, 60 (1983) 711-712
C----  J.A. IRVIN AND T.I. QUICKENDEN
C----      
      INTEGER N,NITER,I
      REAL X(N),Y(N),SX(N),SY(N)
      REAL W(32767)
      REAL B,A,SIGB,SIGA,COV,R,OLDB
      REAL SUMX,SUMY,SUMXX,SUMXY,SUMYY,SUMW,SUMDD

      IF (N.GT.32767) STOP 'BLSQ has been dimensioned to 32767'
      NITER=0
      B=-0.73
        
10    CONTINUE
      NITER=NITER+1
      IF (NITER.GT.10) THEN
         WRITE (6,*) 'Better fit did not converge.'
         GOTO 20
      ENDIF
      OLDB=B
      WRITE (6,*) 'Least squares iteration, slope = ',B
      DO I=1,N
         W(I)=1/(SY(I)**2+(B*SX(I))**2)
      ENDDO
      SUMX=0
      SUMY=0
      SUMXY=0
      SUMXX=0
      SUMYY=0
      SUMW=0
      DO I=1,N         
         SUMW =SUMW +W(I)
         SUMX =SUMX +W(I)*X(I)
         SUMY =SUMY +W(I)*Y(I)
         SUMXY=SUMXY+W(I)*X(I)*Y(I)
         SUMXX=SUMXX+W(I)*(X(I)**2)
         SUMYY=SUMYY+W(I)*(Y(I)**2)
      ENDDO
      B=(SUMW*SUMXY-SUMX*SUMY)/(SUMW*SUMXX-SUMX**2)
      IF (ABS((OLDB-B)/B).GT.1.E-5) GOTO 10
20    CONTINUE
      A=(SUMXX*SUMY-SUMX*SUMXY)/(SUMW*SUMXX-SUMX**2)
      SUMDD=0
      DO I=1,N
         SUMDD=SUMDD+(Y(I)-B*X(I)-A)**2
      ENDDO
      SIGA=SQRT((SUMXX*SUMDD)/((N-2)*(SUMW*SUMXX-SUMX**2)))
      SIGB=SQRT((SUMW*SUMDD)/((N-2)*(SUMW*SUMXX-SUMX**2)))
      COV=(-SUMX*SUMDD)/((N-2)*(SUMW*SUMXX-SUMX**2))
      R=(SUMW*SUMXY-SUMX*SUMY)/
     +     SQRT((SUMW*SUMXX-SUMX**2)*(SUMW*SUMYY-SUMY**2))
      RETURN
      END

      SUBROUTINE INIT_DEFAULTS
      INCLUDE 'SCATTER.INC'
      PUB=.TRUE.
      AX=.TRUE.
      FULLNUM=.FALSE.
      APPEND=.FALSE.
      XMOD=1.E+34
      YMOD=1.E+34
      FOLD=.FALSE.
      WIT=0.1
      IPL=1
      NPLX=1
      NPLY=1
      SPACE=0.0
      ERX=0
      ERY=1
      RHO=0
      RAD=0.05
      NR=-1
      NX=1
      NY=2
      SECSTR=.FALSE.
      RM=0.40
      SX=1.E34
      SY=1.E34
      SR=1.E34
      EX=-1.E34
      EY=-1.E34
      ER=-1.E34
      WI=24.0
      HI=18.0
      TEKST=' '
      XTEKST=' '
      YTEKST=' '
      NDOT=0
      INTERVAL=1
      NZ=0
      LINESTYLE=0
      DOTSTYLE=1
      NSDX=0
      NSDY=0
      NSPLIN=10
      SORTX=.FALSE.
      DO_SPLINE=.FALSE.
      EXTRALINE1=0
      EXTRALINE2=0
      EXTRALINE3=.FALSE.
      EXTRALINE4=.FALSE.
      TORSR=.FALSE.
      SMOOTH=0
      AVER=0
      SHRINK_SQUARE=.FALSE.
      EXTEND_SQUARE=.FALSE.
      LOGX=.FALSE.
      LOGY=.FALSE.
      LOGR=.FALSE.
      ABSX=.FALSE.
      ABSY=.FALSE.
      ABSR=.FALSE.
      LSQ=-1
      THOR=.FALSE.
      BLSQ=.FALSE.
      ROBUST=.FALSE.
      SAMELENGTH=.FALSE.
      LSQL=.FALSE.
      FN='scatter.dat'      
      FILENAME=' '
      FILENAME2=' '
      CSL=.FALSE.
      CUMAV=.FALSE.
      CUMSUM=.FALSE.
      LCUMAV=.FALSE.
      SCUMAV=-1
      FFT=.FALSE.
      TIC=.FALSE.
      PFFT=.FALSE.
      PEAK=0
      ACF=.FALSE.
      NOTEXT=.FALSE.
      AXDIV=30
      RANK=.FALSE.
      XSIXTY=.FALSE.
      YSIXTY=.FALSE.
      TITLE=.TRUE.
      TEX=.FALSE.
      REVX=.FALSE.
      REVY=.FALSE.
      RETURN
      END

      SUBROUTINE READ_OPTIONS
      INCLUDE 'SCATTER.INC'
      INTEGER IER,KOLOM,LENSTR
      REAL CONSTRAINT,DX,DY,DR
      CHARACTER*80 CCONSTRAINT,S,ORIGS
      CHARACTER*2 REL

 10   CONTINUE
         CALL GET_WORD(S,IER)
         ORIGS=S
         CALL GVSCUC (S)
         IF (IER.NE.0) RETURN
         IF (S.EQ.'NX') THEN
            CALL GET_INT(NX,IER)
         ELSE IF (S.EQ.'"') THEN
            CONTINUE
         ELSE IF (S.EQ.'SECSTR') THEN
            CALL GET_INT (NR,IER)
            SECSTR=.TRUE.
         ELSE IF (S.EQ.'XSIXTY') THEN
            XSIXTY=.TRUE.
         ELSE IF (S.EQ.'YSIXTY') THEN
            YSIXTY=.TRUE.
         ELSE IF (S.EQ.'APPEND') THEN
            APPEND=.TRUE.
         ELSE IF (S.EQ.'NOPUB') THEN
            PUB=.FALSE.
         ELSE IF (S.EQ.'NOTITLE') THEN
            TITLE=.FALSE.
         ELSE IF (S.EQ.'RANK') THEN
            RANK=.TRUE.
         ELSE IF (S.EQ.'NOAX') THEN
            AX=.FALSE.
         ELSE IF (S.EQ.'FULLNUM') THEN
            FULLNUM=.TRUE.
         ELSE IF (S.EQ.'AXDIV') THEN
            CALL GET_INT(AXDIV,IER)
         ELSE IF (S.EQ.'SPACE') THEN
            CALL GET_FLOAT(SPACE,IER)
         ELSE IF (S.EQ.'ERX') THEN
            CALL GET_FLOAT(ERX,IER)
         ELSE IF (S.EQ.'RHO') THEN
            CALL GET_FLOAT(RHO,IER)
         ELSE IF (S.EQ.'ERY') THEN
            CALL GET_FLOAT(ERY,IER)
         ELSE IF (S.EQ.'SDX'.OR.S.EQ.'NSDX') THEN
            CALL GET_INT(NSDX,IER)
         ELSE IF (S.EQ.'XMOD') THEN
            CALL GET_FLOAT(XMOD,IER)
         ELSE IF (S.EQ.'YMOD') THEN
            CALL GET_FLOAT(YMOD,IER)
         ELSE IF (S.EQ.'FOLD') THEN
            FOLD=.TRUE.
         ELSE IF (S.EQ.'SAMELENGTH') THEN
            SAMELENGTH=.TRUE.
         ELSE IF (S.EQ.'ROBUST') THEN
            ROBUST=.TRUE.
            LSQ=1
         ELSE IF (S.EQ.'SDY'.OR.S.EQ.'NSDY') THEN
            CALL GET_INT(NSDY,IER)
         ELSE IF (S.EQ.'SX') THEN
            CALL GET_FLOAT(SX,IER)
         ELSE IF (S.EQ.'SY') THEN
            CALL GET_FLOAT(SY,IER)
         ELSE IF (S.EQ.'SR') THEN
            CALL GET_FLOAT(SR,IER)
         ELSE IF (S.EQ.'EX') THEN
            CALL GET_FLOAT(EX,IER)
         ELSE IF (S.EQ.'EY') THEN
            CALL GET_FLOAT(EY,IER)
         ELSE IF (S.EQ.'DX') THEN
            CALL GET_FLOAT(DX,IER)
            IF (DX.LE.0) STOP 'DX MUST BE POSITIVE.'
            EX=DX+SX
         ELSE IF (S.EQ.'DY') THEN
            CALL GET_FLOAT(DY,IER)
            IF (DY.LE.0) STOP 'DY MUST BE POSITIVE.'
            EY=DY+SY
         ELSE IF (S.EQ.'CSL') THEN
            CSL=.TRUE.
         ELSE IF (S.EQ.'LSQ') THEN
            LSQ=1
         ELSE IF (S.EQ.'SCUMAV') THEN
            CALL GET_FLOAT(SCUMAV,IER)
         ELSE IF (S.EQ.'LCUMAV') THEN
            LCUMAV=.TRUE.
            SORTX=.TRUE.
            CUMAV=.TRUE.
         ELSE IF (S.EQ.'TIC') THEN
            TIC=.TRUE.
         ELSE IF (S.EQ.'TEX') THEN
            TEX=.TRUE.
         ELSE IF (S.EQ.'FFT') THEN
            FFT=.TRUE.
         ELSE IF (S.EQ.'PFFT') THEN
            PFFT=.TRUE.
         ELSE IF (S.EQ.'ACF') THEN
            ACF=.TRUE.
         ELSE IF (S.EQ.'NOTEXT') THEN
            NOTEXT=.TRUE.
         ELSE IF (S.EQ.'CUMAV') THEN
            SORTX=.TRUE.
            CUMAV=.TRUE.
         ELSE IF (S.EQ.'CUMSUM') THEN
            CUMSUM=.TRUE.
         ELSE IF (S.EQ.'THOR') THEN
            THOR=.TRUE.
         ELSE IF (S.EQ.'LSQL') THEN
            LSQL=.TRUE.
            IF (LSQ.LT.0) LSQ=1
         ELSE IF (S.EQ.'POLY') THEN
            CALL GET_INT(POLYGRADE,IER)
            IF (POLYGRADE.LT.1) THEN
               STOP 'Not enough parameters for polynome'
            ELSE IF (POLYGRADE.GT.50) THEN
               STOP 'Too many parameters for polynome'
            ENDIF
            LINESTYLE=1      
         ELSE IF (S.EQ.'LOGX') THEN
            LOGX=.TRUE.
         ELSE IF (S.EQ.'LOGY') THEN
            LOGY=.TRUE.
         ELSE IF (S.EQ.'LOGR') THEN
            LOGR=.TRUE.
         ELSE IF (S.EQ.'ABSX') THEN
            ABSX=.TRUE.
         ELSE IF (S.EQ.'ABSY') THEN
            ABSY=.TRUE.
         ELSE IF (S.EQ.'ABSR') THEN
            ABSR=.TRUE.
         ELSE IF (S.EQ.'REVX') THEN
            REVX=.TRUE.
         ELSE IF (S.EQ.'REVY') THEN
            REVY=.TRUE.
         ELSE IF (S.EQ.'LOGLOG') THEN
            LOGX=.TRUE.
            LOGY=.TRUE.
         ELSE IF (S.EQ.'SORTX') THEN
            SORTX=.TRUE.
         ELSE IF (S.EQ.'SHRINK_SQUARE') THEN
            SHRINK_SQUARE=.TRUE.
         ELSE IF (S.EQ.'EXTEND_SQUARE') THEN
            EXTEND_SQUARE=.TRUE.
         ELSE IF (S.EQ.'TORSR') THEN
            TORSR=.TRUE.
         ELSE IF (S.EQ.'SPLIN'.OR.S.EQ.'SPLINE') THEN
            SORTX=.TRUE.
            DO_SPLINE=.TRUE.
            IF (LINESTYLE.EQ.0) LINESTYLE=1
         ELSE IF (S.EQ.'LIN'.OR.S.EQ.'LINESTYLE') THEN
            CALL GET_INT(LINESTYLE,IER)
         ELSE IF (S.EQ.'NSP') THEN
            CALL GET_INT(NSPLIN,IER)
            IF (NSPLIN.LT.2) STOP 'NSP MUST BE .GE. 2'
         ELSE IF (S.EQ.'DOT'.OR.S.EQ.'DOTSTYLE') THEN
            CALL GET_INT(DOTSTYLE,IER)
         ELSE IF (S.EQ.'INTERVAL') THEN
            CALL GET_INT(INTERVAL,IER)
         ELSE IF (S.EQ.'ND') THEN
            CALL GET_INT(NDOT,IER)
         ELSE IF (S.EQ.'PEAK') THEN
            CALL GET_INT(PEAK,IER)
            SORTX=.TRUE.
         ELSE IF (S.EQ.'NDOT') THEN
            CALL GET_INT(NDOT,IER)
         ELSE IF (S.EQ.'TE'.OR.S.EQ.'TEXT') THEN
            CALL GET_WORD(TEKST,IER)
         ELSE IF (S.EQ.'TEX'.OR.S.EQ.'XTEXT') THEN
            CALL GET_WORD(XTEKST,IER)
         ELSE IF (S.EQ.'TEY'.OR.S.EQ.'YTEXT') THEN
            CALL GET_WORD(YTEKST,IER)
         ELSE IF (S.EQ.'TEZ'.OR.S.EQ.'ZTEXT') THEN
            IF (NZ.LT.MAXZ) THEN
               NZ=NZ+1
               CALL GET_FLOAT(XZ(NZ),IER)
               CALL GET_FLOAT(YZ(NZ),IER)
               CALL GET_WORD(ZTEKST(NZ),IER)
            ELSE
               WRITE(*,*) 'Too much Z-text'
            ENDIF
         ELSE IF (S.EQ.'ER') THEN
            CALL GET_FLOAT(ER,IER)
         ELSE IF (S.EQ.'DR') THEN
            CALL GET_FLOAT(DR,IER)
            ER=SR+DR
         ELSE IF (S.EQ.'RM'.OR.S.EQ.'RADMAX') THEN
            CALL GET_FLOAT(RM,IER)
         ELSE IF (S.EQ.'NPLX') THEN
            CALL GET_INT(NPLX,IER)
         ELSE IF (S.EQ.'NPLY') THEN
            CALL GET_INT(NPLY,IER)
         ELSE IF (S.EQ.'IPL') THEN
            CALL GET_INT(IPL,IER)
         ELSE IF (S.EQ.'NY') THEN
            CALL GET_INT(NY,IER)
         ELSE IF (S.EQ.'HI') THEN
            CALL GET_FLOAT(HI,IER)
            IF (HI.LT.2) STOP 'Cannot Plot less than 2 cm high.'
         ELSE IF (S.EQ.'WIT'.OR.S.EQ.'MARGIN'.OR.S.EQ.'MARG') THEN
            CALL GET_FLOAT(WIT,IER)
         ELSE IF (S.EQ.'WI') THEN
            CALL GET_FLOAT(WI,IER)
            IF (WI.LT.2) STOP 'Cannot Plot less than 2 cm width.'
         ELSE IF (S.EQ.'RA'.OR.S.EQ.'RAD') THEN
            CALL GET_FLOAT(RAD,IER)
         ELSE IF (S.EQ.'NR') THEN
            CALL GET_INT(NR,IER)
         ELSE IF (S.EQ.'SMOOTH') THEN
            CALL GET_INT(SMOOTH,IER)
            IF (SMOOTH.GT.0) SORTX=.TRUE.
         ELSE IF (S.EQ.'AVER') THEN
            CALL GET_INT(AVER,IER)
            IF (AVER.GT.0) SORTX=.TRUE.
         ELSE IF (S.EQ.'X=0') THEN
            IF (EXTRALINE1.GE.NLMAX) STOP 'Too many vertical lines'
            EXTRALINE1=EXTRALINE1+1
            LINE1VAL(EXTRALINE1)=0.0
         ELSE IF (S.EQ.'X=') THEN
            IF (EXTRALINE1.GE.NLMAX) STOP 'Too many vertical lines'
            EXTRALINE1=EXTRALINE1+1
            CALL GET_FLOAT(LINE1VAL(EXTRALINE1),IER)
         ELSE IF (S.EQ.'Y=0') THEN
            IF (EXTRALINE2.GE.NLMAX) STOP 'Too many horizontal lines'
            EXTRALINE2=EXTRALINE2+1
            LINE2VAL(EXTRALINE2)=0.0
         ELSE IF (S.EQ.'Y=') THEN
            IF (EXTRALINE2.GE.NLMAX) STOP 'Too many horizontal lines'
            EXTRALINE2=EXTRALINE2+1
            CALL GET_FLOAT (LINE2VAL(EXTRALINE2),IER)
         ELSE IF (S.EQ.'Y=X') THEN
            EXTRALINE3=.TRUE.
         ELSE IF (S.EQ.'Y=-X') THEN
            EXTRALINE4=.TRUE.
         ELSE IF (S.EQ.'HELP') THEN
            WRITE (6,*) 'Help not yet available'
         ELSE IF (S.EQ.'XHELP') THEN
            WRITE (6,*) 'Xhelp not yet available'
         ELSE IF (S.EQ.'NC') THEN ! NUMERIC CONSTRAINT.
            IF (INC.GE.NCMAX) STOP 'Too many numeric constraints.'
            CALL GET_INT (KOLOM,IER)
            CALL GET_WORD (REL,IER)
            CALL GVSCUC (REL)
            IF (REL.EQ.'GT') REL='>'
            IF (REL.EQ.'LT') REL='<'
            IF (REL.EQ.'EQ') REL='='
            IF (REL.EQ.'NE') REL='<>'
            IF (REL.NE.'>'.AND.REL.NE.'='.AND.
     1           REL.NE.'<'.AND.REL.NE.'<>') THEN
               WRITE (6,*) 'Invalid relational operator.'
            ELSE
               CALL GET_FLOAT (CONSTRAINT,IER)
               INC=INC+1
               NCK(INC)=KOLOM
               NCREL(INC)=REL
               NCC(INC)=CONSTRAINT
            ENDIF
         ELSE IF (S.EQ.'CC') THEN ! CHARACTER CONSTRAINT.
            IF (ICC.GE.NCMAX) STOP 'Too many character constraints.'
            CALL GET_INT (KOLOM,IER)
            CALL GET_WORD (REL,IER)
            CALL GVSCUC (REL)
            IF (REL.EQ.'GT') REL='>'
            IF (REL.EQ.'LT') REL='<'
            IF (REL.EQ.'EQ') REL='='
            IF (REL.EQ.'NE') REL='<>'
            IF (REL.NE.'>'.AND.REL.NE.'='.AND.
     1           REL.NE.'<'.AND.REL.NE.'<>') THEN
               PRINT*,'Invalid relational operator.'
            ELSE
               CALL GET_WORD(CCONSTRAINT,IER)
               ICC=ICC+1
               CCK(ICC)=KOLOM
               CCREL(ICC)=REL
               CCC(ICC)=CCONSTRAINT
            ENDIF
         ELSE IF (S.EQ.'FI'.OR.S.EQ.'FILE') THEN
            CALL GET_WORD(FN,IER)
         ELSE IF (S.EQ.'OUTFI'.OR.S.EQ.'OUTFILE') THEN
            CALL GET_WORD(FILENAME2,IER)
         ELSE
            WRITE(*,*) 'Data will be read from ',ORIGS(1:LENSTR(ORIGS))
            FN=ORIGS
         ENDIF
      IF (IER.EQ.0) GOTO 10
      RETURN
      END

      SUBROUTINE READ_DATA
      INCLUDE 'SCATTER.INC'
      LOGICAL       VALID
      INTEGER       II, NWAR1, NWAR2, MINWORD, IOSTAT, NWORD, LENSTR
      CHARACTER*80  WORD(40), S
      CHARACTER*132 LINE
      REAL          XMOD2, YMOD2, GETAL2, GETALR, GETALX, GETALY,
     +              GETALSX, GETALSY
C
C INITIALISE
C
      NDATA=0
      NLIN=0
      IWAR1=0
      NWAR1=1
      IWAR2=0
      NWAR2=1
      XMOD2=XMOD/2
      YMOD2=YMOD/2
      MINWORD=MAX(NX,NY,NSDX,NSDY,NDOT)
      DO II=1,INC
         MINWORD=MAX(MINWORD,NCK(II))
      ENDDO      
      DO II=1,ICC
         MINWORD=MAX(MINWORD,CCK(II))
      ENDDO      

      IF (NR.GT.0) MINWORD=MAX(MINWORD,NR)
C
C OPEN I/O
C
      OPEN(UNIT=1,FILE=FILENAME,STATUS='OLD',ERR=998)
      IF (CSL) OPEN(45,STATUS='UNKNOWN')
C
C READ TITLE CARD (IF ANY)
C
      IF (TIC) THEN
         READ(1,'(A)',IOSTAT=IOSTAT) LINE
         IF (IOSTAT.NE.0) THEN
            CLOSE(1)
            RETURN
         ENDIF
         NLIN=NLIN+1
         CALL NEW_LINE_TO_WORDS(LINE,WORD,NWORD,MINWORD)
         IF (NWORD.LT.MINWORD) THEN
            PRINT *,'%ROB-W-NOTTITWOR, NOT ENOUGH TITLE WORDS.'
         ELSE
            IF (CSL) WRITE(45,'(A)') LINE(1:LENSTR(LINE))
            XTEKST=WORD(NX)
            YTEKST=WORD(NY)
         ENDIF
      ENDIF
C
C READ LINE BY LINE
C
20    CONTINUE
      READ(1,'(A)',IOSTAT=IOSTAT) LINE
      IF (IOSTAT.NE.0) THEN
         CLOSE(1)
         RETURN
      ENDIF
      NLIN=NLIN+1
      CALL NEW_LINE_TO_WORDS(LINE,WORD,NWORD,MINWORD)
      IF (NWORD.LT.MINWORD) THEN
         IWAR2=IWAR2+1
         IF (IWAR2.GE.NWAR2) THEN
            IF (IWAR2.EQ.1) THEN
               WRITE(*,644) NLIN
            ELSE
               WRITE(*,645) IWAR2,NLIN
            ENDIF
 644        FORMAT ('Not enough words at line',i6)
 645        FORMAT (i6,' times not enough words at line',i6)
            NWAR2=IWAR2*10
         ENDIF
         GOTO 20
      ENDIF
C
C CHECK CONSTRAINTS
C
      VALID=.TRUE.
 1234 FORMAT(BN,F20.0)
      DO II=1,INC
         IF (NCK(II).EQ.0) THEN
            GETAL2=NLIN
         ELSE
            READ(WORD(NCK(II)),1234,ERR=996) GETAL2
         ENDIF
         IF (NCREL(II).EQ.'<') THEN
            IF (NCC(II).LE.GETAL2) VALID=.FALSE.
         ELSE IF (NCREL(II).EQ.'>') THEN
            IF (NCC(II).GE.GETAL2) VALID=.FALSE.
         ELSE IF (NCREL(II).EQ.'=') THEN
            IF (NCC(II).NE.GETAL2) VALID=.FALSE.
         ELSE IF (NCREL(II).EQ.'<>') THEN
            IF (NCC(II).EQ.GETAL2) VALID=.FALSE.
         ENDIF
      ENDDO
      DO II=1,ICC
         S=WORD(CCK(II))
         IF (CCREL(II).EQ.'<') THEN
            IF (CCC(II).LE.S) VALID=.FALSE.
         ELSE IF (CCREL(II).EQ.'>') THEN
            IF (CCC(II).GE.S) VALID=.FALSE.
         ELSE IF (CCREL(II).EQ.'=') THEN
            IF (CCC(II).NE.S) VALID=.FALSE.
         ELSE IF (CCREL(II).EQ.'<>') THEN
            IF (CCC(II).EQ.S) VALID=.FALSE.
         ENDIF
      ENDDO
      IF (.NOT.VALID) GOTO 20
C
C GET RADIUS
C
      IF (NR.GT.0) THEN
         IF (SECSTR) THEN
            IF (WORD(NR).EQ.'H'.OR.WORD(NR).EQ.'3') THEN 
               GETALR=1
            ELSE IF (WORD(NR).EQ.'S'.OR.WORD(NR).EQ.'E') THEN
               GETALR=2
            ELSE
               GETALR=3
            END IF
         ELSE
            READ (WORD(NR),1234,ERR=996) GETALR
         END IF
      ELSE IF (NR.EQ.0) THEN
         GETALR=NLIN
      ELSE
         GETALR=RAD
      ENDIF
C
C GET DOTSTYLE
C
      IF (NDOT.GT.0) THEN
         READ(WORD(NDOT),1234,ERR=996) GETALDOT
      ELSE
         GETALDOT=DOTSTYLE
      ENDIF
C
C GET X-COORDINATE
C
      IF (NX.EQ.0) THEN
         GETALX=NLIN
      ELSE
         READ(WORD(NX),1234,ERR=996) GETALX
      ENDIF
C
C GET Y-COORDINATE
C
      IF (NY.EQ.0) THEN
         GETALY=NLIN
      ELSE
         READ(WORD(NY),1234,ERR=996) GETALY
      ENDIF
C
C- READ THE STANDARD DEVIATIONS
C
      IF (NSDX.GT.0) THEN
         READ(WORD(NSDX),1234,ERR=996) GETALSX
      ELSE
         GETALSX=0.0
      ENDIF
      IF (NSDY.GT.0) THEN
         READ(WORD(NSDY),1234,ERR=996) GETALSY
      ELSE
         GETALSY=0.0
      ENDIF
C
C- ACCOUNT FOR PERIODIC DATA
C
      IF (FOLD) THEN
         IF (XMOD.GT.0) THEN
            IF (GETALX.LT.0) THEN
               GETALX=XMOD-MOD(-GETALX,XMOD)
            ELSE
               GETALX=MOD(GETALX,XMOD)
            ENDIF
         ENDIF
         IF (YMOD.GT.0) THEN
            IF (GETALY.LT.0) THEN
               GETALY=YMOD-MOD(-GETALY,YMOD)
            ELSE
               GETALY=MOD(GETALY,YMOD)
            ENDIF
         ENDIF
      ELSE IF (NDATA.GT.0) THEN
         IF (XMOD.GT.0) THEN
            IF (GETALX.LT.DATAX(NDATA)-XMOD2) GETALX=GETALX+XMOD
            IF (GETALX.GT.DATAX(NDATA)+XMOD2) GETALX=GETALX-XMOD
         ENDIF
         IF (YMOD.GT.0) THEN
            IF (GETALY.LT.DATAY(NDATA)-YMOD2) GETALY=GETALY+YMOD
            IF (GETALY.GT.DATAY(NDATA)+YMOD2) GETALY=GETALY-YMOD
         ENDIF
      ENDIF
C
C- TRANSFORM DATA
C
      IF (ABSX) GETALX=ABS(GETALX)
      IF (ABSY) GETALY=ABS(GETALY)
      IF (ABSR) GETALR=ABS(GETALR)
C
C- WRITE DATA IF CSL
C
      IF (CSL) WRITE(45,'(A)') LINE(1:LENSTR(LINE))
C
C STORE DATA IN ARRAYS
C
      IF (NDATA.EQ.IMAX) THEN
         WRITE(*,*) 'WARNING: Too many data points selected:'
         WRITE(*,*) 'SCATTER proceeding without reading complete input'
         CLOSE(1)
         RETURN
      ENDIF
      NDATA=NDATA+1
      DATAX(NDATA)=GETALX
      DATAY(NDATA)=GETALY
      DATAR(NDATA)=GETALR
      DATASDX(NDATA)=GETALSX
      DATASDY(NDATA)=GETALSY
      DATADOT(NDATA)=NINT(GETALDOT)
C
C- NEXT DATA-LINE
C
      GOTO 20
C
C- HANDLE INTERNAL READ ERROR
C
 996  CONTINUE
      IWAR1=IWAR1+1
      IF (IWAR1.GE.NWAR1) THEN
         IF (IWAR1.EQ.1) THEN
            WRITE(*,634) NLIN
         ELSE
            WRITE(*,635) IWAR1,NLIN
         ENDIF
 634     FORMAT ('Error in number at line',i6)
 635     FORMAT (i6,' errors in number at line',i6)
         NWAR1=IWAR1*10
      ENDIF
      GOTO 20
998   CONTINUE
      WRITE (6,*) 'ERROR:file not found : ''',
     +      FILENAME(1:LENSTR(FILENAME)),''''
      CALL ERROR
      END

      SUBROUTINE FOURIER(DATA,NN)
      IMPLICIT      NONE 
      INTEGER       NN,I
      REAL          DATA(NN)
      REAL          DATA2(65536)

      DO I=1,NN
         DATA2(2*I-1)=DATA(I)
         DATA2(2*I)=0.0
      ENDDO
      CALL FOUR1 (DATA2,NN,1)
      DO I=1,NN
         DATA(I)=SQRT(DATA2(2*I-1)**2+DATA2(2*I)**2)
      ENDDO

      RETURN
      END
