LOCAL INCLUDE 'DFTPL.INC'
C                                       Local include for DFTPL
      INCLUDE 'INCS:ZPBUFSZ.INC'
      INCLUDE 'INCS:PUVD.INC'
      HOLLERITH XNAMEI(3), XCLAIN(2), XOPTYP(1), XSTOK(1), XSOUR(4),
     *   XCALC(1), XOUTXT(12)
      REAL      USERID, XSIN, XDISIN, UVRANG(2), TIMER(8), SHIFT(2),
     *   BPARM(10), XQUAL, XBAND, XFREQ, XFQID, XSUBA, XBIF, XEIF,
     *   XBCHAN, XECHAN, XANT(50), XBASL(50), XDOCAL, XGUSE, XDOPOL,
     *   XPDVER, XBLVER, XFLAG, XDOBND, XBPVER, XSMOTH(3), DOCIRC,
     *   PRTLEV, XLABEL, XDOTV, XGRCH, BADD(10)
      DOUBLE PRECISION FOFF(MAXIF), DXC, DYC, DZC, RAS, DECS
      REAL      BUFF1(UVBFSS), TIMR(10000), DFT(10000,3), TBEG, TFIN,
     *   ERROR(10000,3), XYSCL(2,3), XYOFF(2,3), AREA(2), OFREQ, FRPIX,
     *   TAVG, XNUL, FINC(MAXIF), VRANGE(2,4)
      CHARACTER NAMEIN*12, CLAIN*6, OUTEXT*48, PLABL(3)*3, OPTYPE*4
      INTEGER   SEQIN, DISKIN, LUNI, INDI, LABEL, VER, NBASL, BCNT,
     *   TESTEM(2), JBUFSZ, GRCHN, TVCHN, TVCORN(4), NPARMS, IPLOT,
     *   FREQID, KNCS, KNCF, KNCIF, LTYPE, XVAR, NPOL, NXANT, IXANT(50),
     *   NXBASL, IXBASL(50)
      LOGICAL   UVREV, SCALEM(2), NOUVR, DOGRID, DOTV, PACKED, DESEL
      COMMON /INPARM/ USERID, XNAMEI, XCLAIN, XSIN, XDISIN, XOPTYP,
     *   UVRANG, TIMER, SHIFT, XSTOK, BPARM, XSOUR, XQUAL, XCALC, XBAND,
     *   XFREQ, XFQID, XSUBA, XBIF, XEIF, XBCHAN, XECHAN, XANT, XBASL,
     *   XDOCAL, XGUSE, XDOPOL, XPDVER, XBLVER, XFLAG, XDOBND, XBPVER,
     *   XSMOTH, DOCIRC, PRTLEV, XOUTXT, XLABEL, XDOTV, XGRCH, BADD
      COMMON /BUFRS/ BUFF1, JBUFSZ
      COMMON /FTPCOM/ FOFF, DXC, DYC, DZC, RAS, DECS, FINC, TIMR, DFT,
     *   ERROR, TBEG, TFIN, TAVG, XYSCL, XYOFF, OFREQ, FRPIX, AREA,
     *   XNUL, UVREV, SCALEM, NOUVR, DOGRID, NBASL, BCNT, SEQIN, DISKIN,
     *   LUNI, INDI, LABEL, VER, TESTEM, GRCHN, TVCHN, TVCORN, DOTV,
     *   NPARMS, IPLOT, FREQID, PACKED, KNCS, KNCF, KNCIF, LTYPE, XVAR,
     *   NPOL, VRANGE, NXANT, IXANT, NXBASL, IXBASL, DESEL
      COMMON /CHRCOM/ NAMEIN, CLAIN, OUTEXT, PLABL, OPTYPE
C                                                          End DFTPL.
LOCAL END
      PROGRAM DFTPL
C-----------------------------------------------------------------------
C! Plots summed uv data for a position in the sky as a function of time.
C# UV Plot-appl
C-----------------------------------------------------------------------
C;  Copyright (C) 1995, 1998, 2000-2002, 2008-2009, 2012, 2014-2018,
C;  Copyright (C) 2021-2025
C;  Associated Universities, Inc. Washington DC, USA.
C;
C;  This program is free software; you can redistribute it and/or
C;  modify it under the terms of the GNU General Public License as
C;  published by the Free Software Foundation; either version 2 of
C;  the License, or (at your option) any later version.
C;
C;  This program is distributed in the hope that it will be useful,
C;  but WITHOUT ANY WARRANTY; without even the implied warranty of
C;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C;  GNU General Public License for more details.
C;
C;  You should have received a copy of the GNU General Public
C;  License along with this program; if not, write to the Free
C;  Software Foundation, Inc., 675 Massachusetts Ave, Cambridge,
C;  MA 02139, USA.
C;
C;  Correspondence concerning AIPS should be addressed as follows:
C;         Internet email: aipsmail@nrao.edu.
C;         Postal address: AIPS Project Office
C;                         National Radio Astronomy Observatory
C;                         520 Edgemont Road
C;                         Charlottesville, VA 22903-2475 USA
C-----------------------------------------------------------------------
C   DFTPL creates a 'PL' extension file for display of the DFT of the
C   visibilities for an arbitrary position in the sky. Plots resulting
C   flux as a function of time. The data may be binned with arbitrary
C   averages in time.
C
C   NOTE 1: DFTPL wants the first key of the sort order of the UV data
C           base to be TIME.
C
C   NOTE 2: At present, DFTPL will only plot up to 10000 bins. For 5 s
C           averages this means roughly 17 minutes of plotting. For 1
C           min averages, more than 3 hrs, etc.
C
C   Inputs:
C     USERID                       UV data file owner # ignored
C     INNAME         NAMEIN        Name of input UV data.
C     INCLASS        CLAIN         Class of input UV data.
C     INSEQ          SEQIN         Seq. of input UV data.
C     INDISK         DISKIN        Disk number of input VU data.
C     UVRANGE....Range of UV projected spacings to include (Klambda)
C     TIMER......Selection parameters:
C        1 = Start IAT day (day 0 = first day in data base)
C        2 = Start IAT hour
C        3 = Start IAT minute
C        4 = Start IAT second
C        5 = Stop IAT day (day 0 = first day in data base)
C        6 = Stop IAT hour
C        7 = Stop IAT minute
C        8 = Stop IAT second
C        9 = Offset in right ascension (asec)
C       10 = Offset in declination (asec)
C     BPARM......Control parameters:
C        1 = 1 then plot RR data only
C            2      plot LL data only
C            3      plot RL data only
C            4      plot LR data only
C            5      plot IPOL
C            6      plot VPOL
C            7      plot QPOL
C            8      plot UPOL
C        2 = averaging interval in sec
C        3 = Do not autoscale if > zero, use following values:
C        4 = Minimum of X-axis,
C        5 = Maximum of X-axis,
C        6 = Minimum of Y-axis.
C        7 = Maximum of Y-axis,
C        8 = X to Y ratio
C        9 = 1 => write time, flux density, and error to message file
C                 but don't plot error bars
C            0 => do not write to message file or plot error bars
C           -1 => write stuff to message file AND plot error bars
C   DOCIRCLE   DOGRID      Draw ticks all the way across ?
C      DOTV     R      > 0 => TV, else plot file
C      GRCHAN   R      graphics channel to use
C
C   Written by T. Bastian, Univ. of Colorado, Aug. 1986
C   Used UVPLT as task template.
C-----------------------------------------------------------------------
      CHARACTER PRGM*6
      INTEGER  IERR, IRET, IPL
      INCLUDE 'DFTPL.INC'
      INCLUDE 'INCS:DSEL.INC'
      INCLUDE 'INCS:DGPH.INC'
      INCLUDE 'INCS:DLOC.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DUVH.INC'
      DATA PRGM /'DFTPL '/
C-----------------------------------------------------------------------
C                                       Get input parameters and
C                                       create output file if nec.
      CALL FTPIN (PRGM, IRET)
      IF (IRET.NE.0) GO TO 995
C                                       Do DFT's
      CALL ACDFT (IRET)
      IF (IRET.NE.0) GO TO 995
C                                       Print 'em up
      IF ((PRTLEV.GT.0.0) .OR. (OUTEXT.NE.' ')) THEN
         CALL PRTFT (IRET)
         IF (IRET.NE.0) GO TO 995
         END IF
C                                       Plot 'em up
      DO 20 IPL = 1,NPOL
         CALL PLTFT (IPL, IRET)
         IF (IRET.NE.0) GO TO 30
 20      CONTINUE
C                                       Clear catlg on error
 30   IF ((IRET.NE.0) .AND. (NCFILE.GE.1)) THEN
         CALL DELEXT ('PL', FVOL(1), FCNO(1), 'READ', CATBLK, BUFF1,
     *      VER, IERR)
         CALL ZCLOSE (LUNI, INDI, IERR)
         NCFILE = NCFILE - 1
         END IF
C                                       Close down
 995  CALL DIE (IRET, BUFF1)
C
 999  STOP
      END
      SUBROUTINE FTPIN (PRGM, JERR)
C-----------------------------------------------------------------------
C   FTPIN gets input parameters for DFTPL .
C   Inputs:
C      PRGM    C*6    Program name
C   Output:
C      JERR    I      Error code: 0 => ok, else quit
C-----------------------------------------------------------------------
      CHARACTER PRGM*6
      INTEGER   JERR
C
      INCLUDE 'DFTPL.INC'
      CHARACTER BNDCOD(MAXIF)*8, CSTOK(11)*4
      INTEGER   OLDCNO, IUSER, I, IERR, IROUND, FQVER, NIF, CHBUFF(512),
     *   ISBAND(MAXIF), LUNCH
      REAL      CATR(256), RPARM(20), ST
      LOGICAL   T, ISFPA
      DOUBLE PRECISION RA0, DEC0, CATD(128)
      INCLUDE 'INCS:DSEL.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:PSTD.INC'
      EQUIVALENCE (CATBLK, CATR, CATD)
      DATA T /.TRUE./
      DATA CSTOK /'RR', 'LL', 'I', 'V', 'Q', 'U', 'VV', 'HH', 'HALF',
     *   'IQU', 'FPA'/
C-----------------------------------------------------------------------
C                                       Init IO et al.
      CALL ZDCHIN (T, BUFF1)
      CALL VHDRIN
      CALL SELINI
      JBUFSZ = UVBFSS * 2
C                                       Initialize /CFILES/
      NSCR = 0
      NCFILE = 0
      JERR = 0
      VER = 10000
C                                       Get input parameters.
      NPARMS = 184
      CALL GTPARM (PRGM, NPARMS, RQUICK, USERID, BUFF1, IERR)
      IF (IERR.NE.0) THEN
         JERR = 8
         RQUICK = .TRUE.
         IF (IERR.EQ.1) GO TO 999
         WRITE (MSGTXT,1000) IERR, 'GETTING USER ADVERB VALUES'
         CALL MSGWRT (8)
         END IF
C                                       Restart AIPS
      IF (RQUICK) CALL RELPOP (JERR, BUFF1, IERR)
      IF (JERR.NE.0) GO TO 999
      JERR = 5
C                                       Crunch input parameters.
      DO 5 I = 1,10
         IBAD(I) = IROUND(BADD(I))
 5       CONTINUE
      XVAR = BPARM(1) + 0.1
      IF ((XVAR.LE.0) .OR. (XVAR.GT.6)) XVAR = 1
      DOGRID = DOCIRC.GT.0.0
      USERID = NLUSER
      IUSER = NLUSER
      SEQIN = IROUND (XSIN)
      DISKIN = IROUND (XDISIN)
      TBEG = TIMER(1) + (TIMER(2)+(TIMER(3)+TIMER(4)/60.)/60.)/24.
      TFIN = TIMER(5) + (TIMER(6)+(TIMER(7)+TIMER(8)/60.)/60.)/24.
      IF (TFIN.LE.TBEG) TFIN = 1.E6
      IF (TBEG.LE.0.0) TBEG = -1.E6
      DOTV = XDOTV.GT.0.0
      GRCHN = IROUND (XGRCH)
      TVCHN = 1
      CALL FILL (4, 0, TVCORN)
      LABEL = IROUND (XLABEL)
      LTYPE = MOD (ABS(LABEL), 100)
      IF ((LTYPE.EQ.0) .OR. (LTYPE.GT.10)) LTYPE = 3
      IF (LTYPE.GT.7) LTYPE = 7
      IF ((LTYPE.GE.4) .AND. (LTYPE.LE.6)) LTYPE = 3
      IF (LABEL.LT.0) THEN
         LABEL = (LABEL/100)*100 + LTYPE
      ELSE
         LABEL = (LABEL/100)*100 - LTYPE
         END IF
      XLABEL = LABEL
      IPLOT = 1
      IF (ABS(BPARM(9)).GT.1.5) IPLOT = 2
      IF (ABS(BPARM(9)).GT.2.5) IPLOT = 3
      IF ((BPARM(10).LT.0.2) .OR. (BPARM(10).GT.10.0)) BPARM(10) = 1.
C                                       Convert characters
      CALL H2CHR (12, 1, XNAMEI, NAMEIN)
      CALL H2CHR (6, 1, XCLAIN, CLAIN)
      CALL H2CHR (4, 1, XSTOK, STOKES)
      CALL H2CHR (4, 1, XCALC, SELCOD)
      CALL H2CHR (16, 1, XSOUR, SOURCS(1))
      CALL H2CHR (48, 1, XOUTXT, OUTEXT)
      CALL H2CHR (4, 1, XOPTYP, OPTYPE)
      SELQUA = IROUND (XQUAL)
      ISFPA = STOKES.EQ.'FPA'
      IF (ISFPA) STOKES = 'IQU'
C                                       Antennas
      CALL SETANT (50, XANT, XBASL, NXANT, NXBASL, IXANT, IXBASL, DESEL)
      IF ((NXANT.LE.0) .AND. (NXBASL.GT.0)) THEN
         CALL COPY (NXBASL, IXBASL, IXANT)
         NXANT = NXBASL
         NXBASL = 0
         END IF
C                                       Info for UVGET:
C                                       Put selection criteria into
C                                       correct common.
      UNAME = NAMEIN
      UCLAS = CLAIN
      UDISK = DISKIN
      USEQ = SEQIN
      DOCAL = XDOCAL.GT.0.0
      DOWTCL = DOCAL .AND. (XDOCAL.LE.99.0)
      DOACOR = .FALSE.
      CALL RCOPY (8, TIMER, TIMRNG)
      DOPOL = IROUND(XDOPOL)
      IF (XDOPOL.GT.0.0) DOPOL = MAX (1, DOPOL)
      PDVER = IROUND (XPDVER)
      DOAPPL = .FALSE.
      SUBARR = IROUND (XSUBA)
      IF (SUBARR.LT.0) SUBARR = 0
      FGVER = IROUND (XFLAG)
      DOBAND = IROUND (XDOBND)
      BPVER = IROUND (XBPVER)
      CALL RCOPY (3, XSMOTH, SMOOTH)
      CLVER = IROUND (XGUSE)
      CLUSE = IROUND (XGUSE)
      BLVER = IROUND (XBLVER)
      BCHAN = XBCHAN
      ECHAN = XECHAN
      BIF = XBIF
      EIF = XEIF
C                                       Test UV range
      NOUVR = .FALSE.
      IF ((UVRANG(1).GE.UVRANG(2)) .OR. (UVRANG(1).LT.0.0)) THEN
         NOUVR = .TRUE.
         UVRANG(1) = 0.0
         UVRANG(2) = 1.E10
         END IF
      UVRNG(1) = UVRANG(1)
      UVRNG(2) = UVRANG(2)
      UVRANG(1) = UVRANG(1) * 1.0E3
      UVRANG(2) = UVRANG(2) * 1.0E3
C                                       Autoscale ?
      SCALEM(1) = (BPARM(3).LE.0.0) .OR. (BPARM(4).EQ.BPARM(5))
      SCALEM(2) = (BPARM(3).LE.0.0) .OR. (BPARM(6).EQ.BPARM(7))
      TESTEM(1) = 1
      IF (BPARM(4).GT.BPARM(5)) TESTEM(1) = -1
      IF ((BPARM(3).EQ.0.0) .OR. (BPARM(4).EQ.BPARM(5))) TESTEM(1) = 0
      TESTEM(2) = 1
      IF (BPARM(6).GT.BPARM(7)) TESTEM(2) = -1
      IF ((BPARM(3).EQ.0.0) .OR. (BPARM(6).EQ.BPARM(7))) TESTEM(2) = 0
C                                       X/Y ratio ?
      AREA(1) = 1000.
      AREA(2) = 1000.
      IF (BPARM(8).EQ.0.0) BPARM(8) = 1.0
      IF (BPARM(8).GT.1.0) AREA(2) = AREA(2) / BPARM(8)
      IF (BPARM(8).LT.1.0) AREA(1) = AREA(1) * BPARM(8)
C                                       Get CATBLK from UVGET
      CALL UVGET ('INIT', RPARM, BUFF1, IERR)
      IF (IERR.LT.0) THEN
         MSGTXT = 'INITIAL UVGET RETURNS NO DATA FOUND'
         GO TO 980
      ELSE IF (IERR.GT.0) THEN
         WRITE (MSGTXT,1000) IERR, 'INITIAL UVGET CALL'
         GO TO 980
         END IF
C                                       save adverbs
      XSIN = IUSEQ
      XDISIN = IUDISK
      CALL CHR2H (12, UNAME, 1, XNAMEI)
      CALL CHR2H (6, UCLAS, 1, XCLAIN)
      OLDCNO = IUCNO
      XBCHAN = BCHAN
      XECHAN = ECHAN
      XBIF = BIF
      XEIF = EIF
      XSUBA = SUBARR
      CALL UVGET ('CLOS', RPARM, BUFF1, IERR)
      IF (NCFILE.LE.0) THEN
         NCFILE = 1
         FVOL(NCFILE) = IUDISK
         FCNO(NCFILE) = IUCNO
         FRW(NCFILE) = 0
         END IF
      CALL COPY (256, CATUV, CATBLK)
C                                       x axis needs
      IF (XVAR.NE.1) CALL GETANT (IUDISK, IUCNO, MAX (1, SUBARR),
     *   CATBLK, BUFF1, IERR)
C                                       UVPGET was called for output
      IF ((ILOCSU.GE.0) .OR. ((RA.EQ.0.0D0) .AND. (DEC.EQ.0.0D0))) THEN
         IERR = 8
         MSGTXT = 'YOU MUST SELECT ONLY ONE SOURCE'
         GO TO 980
         END IF
C                                       Source offsets
      RA0 = RA
      DEC0 = DEC
      IF (COS(DG2RAD*DEC0).NE.0.0D0) RA = RA0 + SHIFT(1) / 3600.D0
     *   / COS(DG2RAD * DEC0)
      DEC = DEC + SHIFT(2) / 3600.D0
      RAS = RA
      DECS = DEC
      DXC = SIN (DG2RAD * (RA-RA0)) * COS (DEC * DG2RAD)
      DYC = COS (DEC0 * DG2RAD) * SIN (DEC * DG2RAD) -
     *   SIN (DEC0 * DG2RAD) * COS (DEC * DG2RAD) *
     *   COS ((RA - RA0) * DG2RAD)
      DZC = SIN (DG2RAD * DEC0) * SIN (DG2RAD * DEC) +
     *   COS (DG2RAD * DEC0) * COS (DG2RAD * DEC) *
     *   COS (DG2RAD * (RA - RA0)) - 1.0D0
      DXC = TWOPI * DXC
      DYC = TWOPI * DYC
      DZC = TWOPI * DZC
C                                       Sort order OK ?
      IF (ISORT(:1).NE.'T') THEN
         MSGTXT = 'FIRST KEY OF SORT ORDER MUST BE TIME !!'
         CALL MSGWRT (6)
         JERR = 1
         GO TO 999
         END IF
C                                       Frequency and bandwidth
      IF (JLOCIF.LT.0) THEN
         FOFF(1) = 0.0D0
         FINC(1) = CATR(KRCIC+JLOCF)
      ELSE
         FQVER = 1
         LUNCH = 87
         CALL CHNDAT ('READ',  CHBUFF, DISKIN, OLDCNO, FQVER, CATBLK,
     *      LUNCH, NIF, FOFF, ISBAND, FINC, BNDCOD, FREQID, IERR)
         IF (IERR.NE.0) THEN
            WRITE (MSGTXT,1050) IERR
            CALL MSGWRT (7)
            JERR = 1
            GO TO 999
            END IF
         END IF
      OFREQ = CATD(KDCRV+JLOCF)
      FRPIX = CATR(KRCRP+JLOCF)
C                                       Update catalog header.
      FRW(NCFILE) = 0
      JERR = 0
C                                       Check correlator display
      IF (ISFPA) STOKES = 'FPA'
      DO 20 I = 1,11
         IF (STOKES.EQ.CSTOK(I)) THEN
            BPARM(1) = I
            IF (I.LT.9) THEN
               NPOL = 1
               PLABL(1) = CSTOK(I)
            ELSE IF (I.EQ.9) THEN
               ST = CATD(KDCRV+JLOCS) + (1.0-CATR(KRCRP+JLOCS)) *
     *            CATR(KRCIC+JLOCS)
               IF (ST.LT.-4.5) THEN
                  PLABL(1) = 'VV'
                  PLABL(2) = 'HH'
               ELSE
                  PLABL(1) = 'RR'
                  PLABL(2) = 'LL'
                  END IF
               NPOL = 2
            ELSE IF (I.EQ.10) THEN
               NPOL = 3
               PLABL(1) = 'I'
               PLABL(2) = 'Q'
               PLABL(3) = 'U'
            ELSE
               STOKES = 'IQU'
               NPOL = 3
               PLABL(1) = 'P/I'
               PLABL(2) = 'P'
               PLABL(3) = 'PA'
               END IF
            GO TO 999
            END IF
 20      CONTINUE
C                                       Stokes unavailable
      WRITE (MSGTXT,1900) STOKES
      JERR = 1
C
 980  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('FTPIN: ERROR',I3,' ON ',A)
 1050 FORMAT ('ERROR',I5,' READING FREQUENCIES WITH CHNDAT')
 1900 FORMAT ('REQUESTED STOKES PARAMETER ''',A,''' NOT ALLOWED')
      END
      SUBROUTINE ACDFT (IRET)
C-----------------------------------------------------------------------
C   ACDFT accumlates the flux density for each averaging interval as
C   well as an estimate of the error. Also sets scaling for later use.
C   Output:
C      IRET   I    Return code, 0 => OK, otherwise abort.
C-----------------------------------------------------------------------
      INTEGER   IRET
C
      INCLUDE 'DFTPL.INC'
      INTEGER   FLAG, NUMVIS, XUMVIS, IA1, IA2
      REAL      XY(2,3), Z(2), VIS(UVBFSS), RPARM(20), BASEN
      DOUBLE PRECISION T1, T2
      LOGICAL   REQBAS
      INCLUDE 'INCS:DSEL.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DFIL.INC'
C-----------------------------------------------------------------------
C                                       Set up binning
      XNUL = FBLANK
      CALL RFILL (10000, XNUL, DFT)
      CALL RFILL (10000, XNUL, TIMR)
      CALL RFILL (10000, 0.0, ERROR)
C                                       Get start/stop times
      CALL TBTIME (TBEG, TFIN, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'FINDING START AND STOP TIMES'
         GO TO 990
         END IF
C                                       set bin count, T averaging
      BCNT = 1
      IF (BPARM(2).LE.0.001) BPARM(2) = 864. * (TFIN - TBEG)
      TAVG = BPARM(2) / 86400.
      T1 = TBEG
      T2 = T1 + TAVG
C                                       Init vis file for read.
      CALL UVGET ('INIT', RPARM, VIS, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'INIT UV IO'
         GO TO 990
         END IF
      NUMVIS = 0
      XUMVIS = 0
      KNCS = INCS
      KNCF = INCF
      KNCIF = INCIF
C                                       Loop
C                                       Read vis. record.
 100  CALL UVGET ('READ', RPARM, VIS, IRET)
      IF (IRET.GT.0) THEN
         WRITE (MSGTXT,1000) IRET, 'READING UV DATA'
         GO TO 990
      ELSE IF (IRET.EQ.0) THEN
C                                       antenna/baseline
         IF (ILOCB.GE.0) THEN
            BASEN = RPARM(1+ILOCB)
            IA1 = BASEN / 256. + 0.1
            IA2 = BASEN - IA1*256. + 0.1
         ELSE
            IA1 = RPARM(1+ILOCA1) + 0.1
            IA2 = RPARM(1+ILOCA2) + 0.1
            END IF
         IF (.NOT.REQBAS (IA1, IA2, DESEL, IXANT, NXANT, IXBASL,
     *      NXBASL)) GO TO 100
C                                       Is this a valid point ?
 125     CALL WANTED (RPARM, VIS, T1, T2, FLAG)
C                                       Bad point, try again
         IF (FLAG.EQ.1) GO TO 100
C                                       End of time search
         IF (FLAG.EQ.3) GO TO 200
C                                       Next time interval
         IF (FLAG.EQ.2) THEN
            CALL DODFT (RPARM, VIS, T1, T2, FLAG, IRET)
            T1 = T2
            T2 = T1 + TAVG
            GO TO 125
            END IF
C                                       Good point
         CALL DODFT (RPARM, VIS, T1, T2, FLAG, IRET)
         XUMVIS = XUMVIS + 1
         GO TO 100
         END IF
C                                       Any valid points
 200  IF (XUMVIS.LE.1) THEN
         IRET = 4
         WRITE (MSGTXT,1200) XUMVIS
         GO TO 990
         END IF
C                                       Get plot ranges and scales
      BCNT = BCNT - 1
      CALL XYSCAL (XY, Z, IRET)
      IF (IRET.GT.0) THEN
         WRITE (MSGTXT,1110) IRET
         GO TO 990
         END IF
C                                       close UV data
      CALL UVGET ('CLOS', RPARM, VIS, IRET)
      GO TO 999
C                                       Error
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('ACDFT: ERROR',I3,' ON ',A)
 1110 FORMAT ('ACDFT: XYSCL ERROR',I3)
 1200 FORMAT ('FOUND',I5,' POINTS: NOT ENOUGH TO SELF-SCALE')
      END
      SUBROUTINE PRTFT (IRET)
C-----------------------------------------------------------------------
C   Print the dfts
c   Output
c      IRET   I   Error code
C-----------------------------------------------------------------------
      INTEGER   IRET
C
      INCLUDE 'DFTPL.INC'
      INTEGER   I, LUN, FIND, IP, J, JTRIM, ITT(4)
      REAL      XM(3), XT, YT
      LOGICAL   PFLAG
      CHARACTER PREFIX(3)*5, OUTLIN*132, XLAB(6)*10, JY(3)*7, TSIGN*1,
     *   ER(3)*7
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DDCH.INC'
      DATA LUN /3/
      DATA XLAB /'Time', 'Elevation', 'Hour angle', 'LST',
     *   'Par angle', 'Azimuth'/
      DATA JY /3*'Janskys'/
      DATA ER /3*'JyError'/
C-----------------------------------------------------------------------
      DO 10 IP = 1,NPOL
         XT = MAX (ABS(VRANGE(2,IP+1)), ABS(VRANGE(1,IP+1)))
         YT = XT
         CALL METSCA (XT, PREFIX(IP), PFLAG)
         XM(IP) = XT / YT
 10      CONTINUE
      IF (OUTEXT.NE.' ') THEN
         CALL ZTXOPN ('WRIT', LUN, FIND, OUTEXT, .TRUE., IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'OPENING OUTPUT TEXT FILE'
            GO TO 990
            END IF
         WRITE (OUTLIN,2000) XLAB(XVAR), (PLABL(IP), IP = 1,NPOL),
     *      (PLABL(IP), IP = 1,NPOL)
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', LUN, FIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 980
         WRITE (OUTLIN,2010) (PREFIX(IP), IP = 1,NPOL),
     *      (PREFIX(IP), IP = 1,NPOL)
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', LUN, FIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 980
         IF (BPARM(1).LT.11) THEN
            WRITE (OUTLIN,2020) (JY(IP), IP = 1,NPOL),
     *         (ER(IP), IP = 1,NPOL)
         ELSE
            WRITE (OUTLIN,2021)
            END IF
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', LUN, FIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 980
         DO 20 I = 1,BCNT
            IF (XVAR.EQ.1) THEN
               CALL T2DHMS (TIMR(I), TSIGN, ITT)
               WRITE (OUTLIN,2030) I, ITT, (DFT(I,IP)*XM(IP),
     *            IP = 1,NPOL), (ERROR(I,IP)*XM(IP), IP = 1,NPOL)
            ELSE
               WRITE (OUTLIN,2031) I, TIMR(I), (DFT(I,IP)*XM(IP),
     *            IP = 1,NPOL), (ERROR(I,IP)*XM(IP), IP = 1,NPOL)
               END IF
            DO 15 IP = 1,NPOL
               IF (DFT(I,IP).EQ.FBLANK) THEN
                  J = 17 + (IP-1) * 10
                  OUTLIN(J:J+9) = '     Inde '
                  END IF
               IF (ERROR(I,IP).EQ.FBLANK) THEN
                  J = 17 + 10*NPOL + (IP-1)*10
                  OUTLIN(J:J+9) = '     Inde '
                  END IF
 15            CONTINUE
            J = JTRIM (OUTLIN)
            CALL ZTXIO ('WRIT', LUN, FIND, OUTLIN(:J), IRET)
            IF (IRET.NE.0) GO TO 980
 20         CONTINUE
         CALL ZTXCLS (LUN, FIND, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'CLOSING TEXT FILE'
            GO TO 990
         END IF
      ELSE IF (NPOL.LT.3) THEN
         WRITE (MSGTXT,2000) XLAB(XVAR), (PLABL(IP), IP = 1,NPOL),
     *      (PLABL(IP), IP = 1,NPOL)
         CALL MSGWRT (3)
         WRITE (MSGTXT,2010) (PREFIX(IP), IP = 1,NPOL),
     *      (PREFIX(IP), IP = 1,NPOL)
         CALL MSGWRT (3)
         IF (BPARM(1).LT.11) THEN
            WRITE (MSGTXT,2020) (JY(IP), IP = 1,NPOL),
     *         (ER(IP), IP = 1,NPOL)
         ELSE
            WRITE (MSGTXT,2021)
            END IF
         CALL MSGWRT (3)
         DO 30 I = 1,BCNT
            IF (XVAR.EQ.1) THEN
               CALL T2DHMS (TIMR(I), TSIGN, ITT)
               WRITE (MSGTXT,2030) I, ITT, (DFT(I,IP)*XM(IP),
     *            IP = 1,NPOL), (ERROR(I,IP)*XM(IP), IP = 1,NPOL)
            ELSE
               WRITE (MSGTXT,2031) I, TIMR(I), (DFT(I,IP)*XM(IP),
     *            IP = 1,NPOL), (ERROR(I,IP)*XM(IP), IP = 1,NPOL)
               END IF
            DO 25 IP = 1,NPOL
               IF (DFT(I,IP).EQ.FBLANK) THEN
                  J = 17 + (IP-1) * 10
                  MSGTXT(J:J+9) = '     Inde '
                  END IF
               IF (ERROR(I,IP).EQ.FBLANK) THEN
                  J = 17 + 10*NPOL + (IP-1)*10
                  MSGTXT(J:J+9) = '     Inde '
                  END IF
 25            CONTINUE
            CALL MSGWRT (3)
 30         CONTINUE
      ELSE
         WRITE (MSGTXT,2300) XLAB(XVAR), (PLABL(IP), IP = 1,NPOL),
     *      (PLABL(IP), IP = 1,NPOL)
         CALL MSGWRT (3)
         WRITE (MSGTXT,2310) (PREFIX(IP), IP = 1,NPOL),
     *      (PREFIX(IP), IP = 1,NPOL)
         CALL MSGWRT (3)
         IF (BPARM(1).LT.11) THEN
            WRITE (MSGTXT,2320) (JY(IP), IP = 1,NPOL),
     *         (ER(IP), IP = 1,NPOL)
         ELSE
            WRITE (MSGTXT,2321)
            END IF
         CALL MSGWRT (3)
         DO 40 I = 1,BCNT
            IF (XVAR.EQ.1) THEN
               CALL T2DHMS (TIMR(I), TSIGN, ITT)
               WRITE (MSGTXT,2330) I, ITT, (DFT(I,IP)*XM(IP),
     *            IP = 1,NPOL), (ERROR(I,IP)*XM(IP), IP = 1,NPOL)
            ELSE
               WRITE (MSGTXT,2331) I, TIMR(I), (DFT(I,IP)*XM(IP),
     *            IP = 1,NPOL), (ERROR(I,IP)*XM(IP), IP = 1,NPOL)
               END IF
            DO 35 IP = 1,NPOL
               IF (DFT(I,IP).EQ.FBLANK) THEN
                  J = 17 + (IP-1) * 8
                  MSGTXT(J:J+7) = '    Inde'
                  END IF
               IF (ERROR(I,IP).EQ.FBLANK) THEN
                  J = 18 + 7*NPOL + (IP-1)*8
                  MSGTXT(J:J+7) = '    Inde'
                  END IF
 35            CONTINUE
            CALL MSGWRT (3)
 40         CONTINUE
         END IF
      GO TO 999
C
 980  WRITE (MSGTXT,1000) IRET, 'WRITING OUTPUT TEXT FILE'
C
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('PRTFT ERROR',I4,' ON ',A)
 2000 FORMAT (6X,A,5X,6(A,7X))
 2010 FORMAT (16X,4X,6(A,5X))
 2020 FORMAT (18X,6(A,3X))
 2021 FORMAT (16X,10X,'   Janskys','   Degrees',5X,'Error',2X,
     *   'Jy Error','   Deg Err')
 2030 FORMAT (I5,I2,'/',2(I2.2,':'),I2.2,6F10.3)
 2031 FORMAT (I5,F8.2,3X,6F10.3)
C
 2300 FORMAT (6X,A,3X,6(A,5X))
 2310 FORMAT (17X,2X,6(A,3X))
 2320 FORMAT (17X,6(A,1X))
 2321 FORMAT (16X,8X,' Janskys',' Degrees','   Error',' JyError',
     *   ' Deg Err')
 2330 FORMAT (I5,I2,'/',2(I2.2,':'),I2.2,6F8.3)
 2331 FORMAT (I5,F8.2,3X,6F8.3)
      END
      SUBROUTINE XYSCAL (XY, Z, IRET)
C-----------------------------------------------------------------------
C   XYSCAL converts to FPA if reqested, finds max/min over data, and
C   finds the scaling parameters needed to fit X and Y into a 1000x1000
C   plotting area .
C   Outputs:
C      XY      R(2,3)   Min, max of up to 3 parameters
C      Z       R(2)     X axis min max
C      XYOFF   R(2,3)   when added to XY changes minimum to zero .
C      XYSCL   R(2,3)   scale XY so that maximum is 1000.
C      IRET    I        Error return code , non-zero if error .
C-----------------------------------------------------------------------
      REAL      XY(2,3), Z(2)
      INTEGER   IRET
c
      INTEGER   I, IROUND, J, IP
      REAL      RI, RQ, RU, EI, EQ, EU, RP, EP, TEMP
      INCLUDE 'DFTPL.INC'
      INCLUDE 'INCS:DSEL.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:PSTD.INC'
C-----------------------------------------------------------------------
      IRET = 0
C                                       convert to FPA
      IF (BPARM(1).EQ.11) THEN
         DO 20 I = 1,BCNT
            RI = DFT(I,1)
            RQ = DFT(I,2)
            RU = DFT(I,3)
            EI = ERROR(I,1)
            EQ = ERROR(I,2)
            EU = ERROR(I,3)
            IF ((RI.EQ.FBLANK) .OR. (RQ.EQ.FBLANK) .OR. (RU.EQ.FBLANK)
     *         .OR. (EI.EQ.FBLANK) .OR. (EQ.EQ.FBLANK) .OR.
     *         (EU.EQ.FBLANK) .OR. (RI.EQ.0.0)) THEN
               DFT(I,1) = FBLANK
               DFT(I,2) = FBLANK
               DFT(I,3) = FBLANK
               ERROR(I,1) = FBLANK
               ERROR(I,2) = FBLANK
               ERROR(I,3) = FBLANK
            ELSE
               RP = SQRT (RQ*RQ + RU*RU)
               DFT(I,2) = RP
               DFT(I,1) = RP / RI
               DFT(I,3) = 0.5 * RAD2DG * ATAN2 (RU, RQ)
               EP = SQRT ((RQ * EQ)**2 + (RU * EU)**2) / RP
               ERROR(I,2) = EP
               ERROR(I,1) = SQRT (EP**2 + (RP*EI/RI)**2) / RI
               ERROR(I,3) = (1.0/(1.0+(RU/RQ)**2)) *
     *            SQRT ((EU/RQ)**2 + (RU/RQ/RQ*EQ)**2) * 0.5 * RAD2DG
               END IF
 20         CONTINUE
         END IF
C                                       MAX/MIN
      XY(1,1) = 1.E10
      XY(2,1) = -1.E10
      XY(1,2) = 1.E10
      XY(2,2) = -1.E10
      XY(1,3) = 1.E10
      XY(2,3) = -1.E10
      CALL RCOPY (2, XY, Z)
      I = IROUND (BPARM(9))
      IF (I.EQ.2) THEN
         DO 30 I = 1,BCNT
            IF (TIMR(I).NE.FBLANK) THEN
               Z(1) = MIN (Z(1), TIMR(I))
               Z(2) = MAX (Z(2), TIMR(I))
               DO 25 IP = 1,NPOL
                  IF (DFT(I,IP).NE.FBLANK) THEN
                     RI = DFT(I,IP) - ERROR(I,IP)
                     XY(1,IP) = MIN (XY(1,IP), RI)
                     XY(2,IP) = MAX (XY(2,IP), RI)
                     RI = DFT(I,IP) + ERROR(I,IP)
                     XY(1,IP) = MIN (XY(1,IP), RI)
                     XY(2,IP) = MAX (XY(2,IP), RI)
                     END IF
 25               CONTINUE
               END IF
 30         CONTINUE
      ELSE
         DO 40 I = 1,BCNT
            IF (TIMR(I).NE.FBLANK) THEN
               Z(1) = MIN (Z(1), TIMR(I))
               Z(2) = MAX (Z(2), TIMR(I))
               DO 35 IP = 1,NPOL
                  IF (DFT(I,IP).NE.FBLANK) THEN
                     RI = DFT(I,IP)
                     XY(1,IP) = MIN (XY(1,IP), RI)
                     XY(2,IP) = MAX (XY(2,IP), RI)
                     END IF
 35               CONTINUE
               END IF
 40         CONTINUE
         END IF
      CALL RCOPY (2, Z, VRANGE(1,1))
      CALL RCOPY (6, XY, VRANGE(1,2))
C                                       Are they in requested range
      J = IROUND (BPARM(3))
      IF (J.GT.0) THEN
         IF (BPARM(4).LT.BPARM(5)) THEN
            Z(1) = BPARM(4)
            Z(2) = BPARM(5)
            END IF
         IF (BPARM(6).LT.BPARM(7)) THEN
            DO 45 IP = 1,NPOL
               XY(1,IP) = BPARM(6)
               XY(2,IP) = BPARM(7)
 45            CONTINUE
            END IF
      ELSE IF (J.LT.0) THEN
         IF (BPARM(4).LT.BPARM(5)) THEN
            Z(1) = MAX (Z(1), BPARM(4))
            Z(2) = MIN (Z(2), BPARM(5))
            END IF
         IF (BPARM(6).LT.BPARM(7)) THEN
            DO 50 IP = 1,NPOL
               XY(1,IP) = MAX (XY(1,IP), BPARM(6))
               XY(2,IP) = MIN (XY(2,IP), BPARM(7))
 50            CONTINUE
            END IF
         END IF
C                                       Convert to scaling factors
C                                       provide room at edges too.
      TEMP = 0.01 * (Z(2) - Z(1))
      Z(1) = Z(1) - TEMP
      Z(2) = Z(2) + TEMP
      XYOFF(1,1) = Z(1)
      XYSCL(1,1)  = AREA(1) / (Z(2) - Z(1))
      DO 100 IP = 1,NPOL
         XYOFF(1,IP) = XYOFF(1,1)
         XYSCL(1,IP) = XYSCL(1,1)
         TEMP = 0.01 * (XY(2,IP) - XY(1,IP))
         XY(1,IP) = XY(1,IP) - TEMP
         XY(2,IP) = XY(2,IP) + TEMP
         XYOFF(2,IP) = XY(1,IP)
         XYSCL(2,IP) = AREA(2) / (XY(2,IP) - XY(1,IP))
 100     CONTINUE
C
 999  RETURN
      END
      SUBROUTINE WANTED (RPBUF, VIS, T1, T2, FLAG)
C-----------------------------------------------------------------------
C   WANTED determines whether the current visibility sample is valid
C   and selected via the selection parameters.
C   Inputs:
C      RPBUF   R(*)   Random parameters
C      VIS     R(*)   Visibilities
C      T1      D      Start desired time range
C      T2      D      End desired time range
C   Outputs:
C      FLAG    I      0 => data selected as good
C                     1    data NO GOOD
C                     2    time exceeds T2
C                     3    time exceeds TFIN
C-----------------------------------------------------------------------
      REAL      RPBUF(*), VIS(*)
      DOUBLE PRECISION T1, T2
      INTEGER   FLAG
C
      REAL      TEMP
      INTEGER   LAD, IIF, ICH, IROUND
      LOGICAL   GOOD, ANY
      INCLUDE 'DFTPL.INC'
      INCLUDE 'INCS:DSEL.INC'
      INCLUDE 'INCS:DUVH.INC'
C-----------------------------------------------------------------------
      FLAG = 1
C                                       Check FREQID
      IF (ILOCFQ.GE.0) THEN
         IIF = IROUND (RPBUF(1+ILOCFQ))
         IF ((FREQID.GT.0) .AND. (IIF.GT.0) .AND. (IIF.NE.FREQID))
     *      GO TO 999
         END IF
C                                       Check UV range
      IF (.NOT.NOUVR) THEN
         TEMP = SQRT (RPBUF(1+ILOCU)**2 + RPBUF(1+ILOCV)**2)
         IF ((TEMP.LT.UVRANG(1)) .OR. (TEMP.GT.UVRANG(2))) GO TO 999
         END IF
C                                       Are data flagged?
      ANY = .FALSE.
      DO 20 IIF = BIF,EIF
         DO 10 ICH = BCHAN,ECHAN
            LAD = 1 + (IIF-BIF)*KNCIF + (ICH-BCHAN)*KNCF
            GOOD = VIS(LAD+2).GT.0.0
            ANY = ANY .OR. GOOD
 10         CONTINUE
 20      CONTINUE
      IF (.NOT.ANY) GO TO 999
C                                       Test time range
      TEMP = RPBUF(1+ILOCT)
      IF (TEMP.LT.T1) GO TO 999
      FLAG = 2
      IF (TEMP.GE.T2) GO TO 999
      FLAG = 3
      IF (TEMP.GT.TFIN) GO TO 999
      FLAG = 0
C
 999  RETURN
      END
      SUBROUTINE PLTFT (IPL, IRET)
C-----------------------------------------------------------------------
C   PLTFT actually plots the data.
C   Input
C      IPL    I    Data polarization
C   Output:
C      IRET   I    Return code, 0 => OK, otherwise abort.
C                     1 => failed to add to catalog
C                     2 => failed to create
C                     3 => graph file write error
C                     4 => UV file IO error
C-----------------------------------------------------------------------
      INTEGER   IPL, IRET
C
      CHARACTER TEXT*80, PFILE*48, CHTYPE(6)*20, AUNITS(6)*20,
     *   NAMCL*18, TIME*8, DATE*12, TS*1, CHR*1, CHD*1, FPATYP(3)*8,
     *   CTEMP*4
      INTEGER   BUFFER(256), IERR, ITYPE, IPSIZE, I, INCHAR, LUNPL,
     *   FINDPL, ITIM(8), INP, IBIN, NGOOD, NNOFIT, IT(3), ID(3),
     *   HMR(2), HMD(2)
      REAL      BLC(2), TRC(2), CHOUT(4), XYRATO, DX, DY, TR, TI, XY(2),
     *   XXFREQ, SECR, SECD
      LOGICAL   GOOD, DOHST
      INCLUDE 'DFTPL.INC'
      INCLUDE 'INCS:DSEL.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DLOC.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:DGPH.INC'
      DATA LUNPL /26/
      DATA AUNITS /'IAT hours', 'EL degrees', 'HA hours', 'LST hours',
     *   'PA degrees', 'AZ degrees'/
      DATA CHTYPE /'Time', 'Elevation', 'Hour angle', 'LST',
     *   'Parallactic Angle', 'Azimuth'/
      DATA FPATYP /'Ratio','Janskys','Degrees'/
C-----------------------------------------------------------------------
      NGOOD = 0
      NNOFIT = 0
      IRET = 1
      IF (.NOT.DOTV) THEN
         CALL MADDEX ('PL', DISKIN, FCNO(1), CATUV, BUFF1, .TRUE.,
     *      'UPDT', VER, IRET)
         IF (IRET.NE.0) THEN
            NCFILE = NCFILE - 1
            GO TO 999
            END IF
         END IF
C                                       Fill in last of actual parms
      BPARM(5) = AREA(1)/XYSCL(1,IPL) + XYOFF(1,IPL)
      BPARM(7) = AREA(2)/XYSCL(2,IPL) + XYOFF(2,IPL)
      BPARM(4) = XYOFF(1,IPL)
      BPARM(6) = XYOFF(2,IPL)
      DOHST = IPLOT.EQ.3
      CALL RFILL (8, 0.0, TIMER)
      TIMER(1) = TBEG
      TIMER(5) = TFIN
      XFLAG = FGVER
      CTEMP = PLABL(IPL)
      CALL CHR2H (4, CTEMP, 1, XSTOK)
C                                       Create plot file
      CALL ZPHFIL ('PL', DISKIN, FCNO(1), VER, PFILE, IERR)
      IF (IERR.NE.0) GO TO 999
      IPSIZE = 0
      ITYPE = 23
      CALL GINIT (DISKIN, FCNO(1), PFILE, IPSIZE, ITYPE, NPARMS, USERID,
     *   DOTV, TVCHN, GRCHN, TVCORN, CATUV, BUFFER, LUNPL, FINDPL,
     *   IERR)
      IRET = 2
      IF (IERR.NE.0) GO TO 999
C                                       Graph drawing parameters.
      BLC(1) = 0.0
      BLC(2) = 0.0
      TRC(1) = AREA(1)
      TRC(2) = AREA(2)
      XYRATO = BPARM(8)
      IRET = 3
      CALL FILL (5, 1, ITIM)
C                                       Set up location common
      LOCNUM = 1
      ROT(LOCNUM) = 0.0
      CORTYP(LOCNUM) = 0
      LABTYP(LOCNUM) = 0
      AXTYP(LOCNUM) = 0
      DO 30 I = 1,2
         TR = AREA(I) / XYSCL(I,IPL)
         RPLOC(I,LOCNUM) = BLC(I)
         RPVAL(I,LOCNUM) = XYOFF(I,IPL)
         AXINC(I,LOCNUM) = TR / (TRC(I) - BLC(I))
         IF (I.EQ.2) THEN
            CTYP(I,LOCNUM) = 'Janskys'
            IF (OPTYPE.EQ.'PHAS') CTYP(I,LOCNUM) = 'Degrees'
            IF (BPARM(1).EQ.11) CTYP(I,LOCNUM) = FPATYP(IPL)
            TR = MAX (ABS(TR), ABS(XYOFF(2,IPL)), ABS(TR+XYOFF(2,IPL)))
            TI = TR
            CALL METSCL (LABEL, TR, CPREF(I,LOCNUM), GOOD)
            RPVAL(I,LOCNUM) = RPVAL(I,LOCNUM) * TR / TI
            AXINC(I,LOCNUM) = AXINC(I,LOCNUM) * TR / TI
         ELSE
            CPREF(I,LOCNUM) = ' '
            CTYP(I,LOCNUM) = AUNITS(XVAR)
            IF ((XVAR.EQ.1) .OR. (XVAR.EQ.3) .OR. (XVAR.EQ.4)) THEN
                LABTYP(LOCNUM) = 7
                IF (XVAR.GT.1) LABTYP(LOCNUM) = 5 + XVAR
                RPVAL(I,LOCNUM) = RPVAL(I,LOCNUM) * 360.
                AXINC(I,LOCNUM) = AXINC(I,LOCNUM) * 360.
                END IF
            END IF
 30      CONTINUE
C                                       number characters around
      CALL RFILL (4, 0.5, CHOUT)
      CALL CHNTIC (BLC, TRC, INP)
      IF (LTYPE.EQ.2) CHOUT(1) = 2.5
      IF (LTYPE.GT.2) CHOUT(1) = INP + 4.0
      IF (LTYPE.GT.1) CHOUT(2) = 2.0
      IF (LTYPE.GT.2) CHOUT(2) = CHOUT(2) + 1.333
      IF ((LTYPE.GT.1) .AND. (LTYPE.LT.7)) THEN
         CHOUT(4) = 3.333
         IF (LABEL.GT.1) CHOUT(4) = CHOUT(4) + 1.333
         IF (.NOT.NOUVR) CHOUT(4) = CHOUT(4) + 1.333
         IF ((TBEG.GE.-1.E5) .OR. (TFIN.LE.1.0E5)) CHOUT(4) =
     *      CHOUT(4) + 1.333
         END IF
C                                       Init for line drawing.
      CALL GINITL (BLC, TRC, XYRATO, CHOUT, ITIM, BUFFER, IERR)
      IF (IERR.NE.0) GO TO 975
C                                       Draw border
      CALL GLTYPE (1, BUFFER, IERR)
      IF (IERR.NE.0) GO TO 970
      CALL GPOS (BLC(1), TRC(2), BUFFER, IERR)
      IF (IERR.NE.0) GO TO 970
      CALL GVEC (BLC(1), BLC(2), BUFFER, IERR)
      IF (IERR.NE.0) GO TO 970
      CALL GVEC (TRC(1), BLC(2), BUFFER, IERR)
      IF (IERR.NE.0) GO TO 970
      CALL GVEC (TRC(1), TRC(2), BUFFER, IERR)
      IF (IERR.NE.0) GO TO 970
      CALL GVEC (BLC(1), TRC(2), BUFFER, IERR)
      IF (IERR.NE.0) GO TO 970
C                                       Top labels: version number
      IF ((LTYPE.GT.1) .AND. (LTYPE.LT.7)) THEN
         DX = 0.0
         DY = CHOUT(4) - 1.5
         IF (LABEL.GT.1) THEN
            CALL GPOS (BLC(1), TRC(2), BUFFER, IERR)
            IF (IERR.NE.0) GO TO 970
            CALL ZDATE (ID)
            CALL ZTIME (IT)
            CALL TIMDAT (IT, ID, TIME, DATE)
            WRITE (TEXT,1030) VER, DATE, TIME
            CALL REFRMT (TEXT, '_', INCHAR)
            CALL GCHAR (INCHAR, 0, DX, DY, TEXT, BUFFER, IERR)
            IF (IERR.NE.0) GO TO 970
            DY = DY - 1.333
            END IF
C                                       Top labels: type & name
         CALL GPOS (BLC(1), TRC(2), BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
         TEXT = 'DFT vs ' // CHTYPE(XVAR) // ' for '
         NAMCL = NAMEIN
         NAMCL(13:18) = CLAIN
         CALL NAMEST (NAMCL, SEQIN, TEXT(26:), INCHAR)
         CALL REFRMT (TEXT, '_', INCHAR)
         CALL GCHAR (INCHAR, 0, DX, DY, TEXT, BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
         DY = DY - 1.333
C                                       Time range, ra, dec
         IF ((TBEG.GE.-1.E5) .OR. (TFIN.LE.1.0E5)) THEN
            CALL GPOS (BLC(1), TRC(2), BUFFER, IERR)
            IF (IERR.NE.0) GO TO 970
            CALL COORDD (1, RAS, CHR, HMR, SECR)
            CALL COORDD (2, DECS, CHD, HMD, SECD)
            CALL T2DHMS (TBEG, TS, ITIM(1))
            CALL T2DHMS (TFIN, TS, ITIM(5))
            ITIM(1) = MIN (ITIM(1), 999)
            ITIM(5) = MIN (ITIM(5), 999)
            WRITE (TEXT,1035) (ITIM(I), I = 1,8), HMR, SECR, CHD, HMD,
     *         SECD
            IF (TEXT(46:46).EQ.' ') TEXT(46:46) = '0'
            IF (TEXT(64:64).EQ.' ') TEXT(64:64) = '0'
            CALL REFRMT (TEXT, '_', INCHAR)
            CALL GCHAR (INCHAR, 0, DX, DY, TEXT, BUFFER, IERR)
            IF (IERR.NE.0) GO TO 970
            DY = DY - 1.333
            END IF
C                                       UV range
         IF (.NOT.NOUVR) THEN
            CALL GPOS (BLC(1), TRC(2), BUFFER, IERR)
            IF (IERR.NE.0) GO TO 970
            WRITE (TEXT,1040) UVRANG
            CALL REFRMT (TEXT, '_', INCHAR)
            CALL GCHAR (INCHAR, 0, DX, DY, TEXT, BUFFER, IERR)
            IF (IERR.NE.0) GO TO 970
            DY = DY - 1.333
            END IF
C                                       Frequency, etc.
         XXFREQ = (OFREQ + FOFF(BIF) + ((ECHAN+BCHAN+1.)/2. - FRPIX) *
     *      FINC(BIF)) / 1.E9
         CALL GPOS (BLC(1), TRC(2), BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
         WRITE (TEXT,1045) OPTYPE, PLABL(IPL), BCHAN, ECHAN, BIF, EIF,
     *      XXFREQ
         IF (ECHAN.EQ.BCHAN) TEXT(32:39) = ' '
         IF (EIF.EQ.BIF) TEXT(47:51) = ' '
         CALL REFRMT (TEXT, '_', INCHAR)
         CALL GCHAR (INCHAR, 0, DX, DY, TEXT, BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
         END IF
C                                       Put on labels and ticks
      XYRATO = 1.0
      CALL CLAB1 (BLC, TRC, CHOUT, LABEL, XYRATO, DOGRID, BUFFER, IERR)
      IF (IERR.NE.0) GO TO 970
C                                       Plot binned data.
      IF (.NOT.DOHST) THEN
         CALL GLTYPE (4, BUFFER, IRET)
         IF (IRET.NE.0) GO TO 970
         DX = 3.0 * BPARM(10)
         DO 110 IBIN = 1,BCNT
C                                       Points ...
            IF (DFT(IBIN,IPL).NE.XNUL) THEN
               NGOOD = NGOOD + 1
               DY = ERROR(IBIN,IPL) * XYSCL(2,IPL)
               IF (IPLOT.EQ.1) DY = 3.0 * BPARM(10)
               XY(1) = (TIMR(IBIN) - XYOFF(1,IPL))*XYSCL(1,IPL)
               XY(2) = (DFT(IBIN,IPL) - XYOFF(2,IPL))*XYSCL(2,IPL)
               IF ((XY(2).GE.BLC(2)) .AND. (XY(2).LE.TRC(2))) THEN
                  CALL GPOS (XY(1)+DX, XY(2), BUFFER, IRET)
                  IF (IRET.NE.0) GO TO 970
                  CALL GVEC (XY(1)-DX, XY(2), BUFFER, IRET)
                  IF (IRET.NE.0) GO TO 970
                  CALL GPOS (XY(1), XY(2)+DY, BUFFER, IRET)
                  IF (IRET.NE.0) GO TO 970
                  CALL GVEC (XY(1), XY(2)-DY, BUFFER, IRET)
                  END IF
               END IF
 110        CONTINUE
C                                       Histogram mode ...
      ELSE
         DX = TAVG*XYSCL(1,IPL)/2.0
         CALL GLTYPE (2, BUFFER, IRET)
         IF (IRET.NE.0) GO TO 970
         DO 210 IBIN = 1,BCNT
            IF (DFT(IBIN,IPL).NE.XNUL) THEN
               NGOOD = NGOOD + 1
               XY(1) = (TIMR(IBIN) - XYOFF(1,IPL))*XYSCL(1,IPL)
               XY(2) = (DFT(IBIN,IPL) - XYOFF(2,IPL))*XYSCL(2,IPL)
               DY = 0.0
               IF (DFT(IBIN+1,IPL).NE.XNUL) DY =
     *            (DFT(IBIN+1,IPL)-DFT(IBIN,IPL))*XYSCL(2,IPL)
               IF (((XY(2)+DY).GT.AREA(2)) .OR.
     *            ((XY(2)+DY).LT.0.0)) DY = 0.0
               IF ((XY(2).GE.BLC(2)) .AND. (XY(2).LE.TRC(2))) THEN
                  CALL GPOS (XY(1)-DX, XY(2), BUFFER, IRET)
                  IF (IRET.NE.0) GO TO 970
                  CALL GVEC (XY(1)+DX, XY(2), BUFFER, IRET)
                  IF (IRET.NE.0) GO TO 970
                  CALL GVEC (XY(1)+DX, XY(2)+DY, BUFFER, IRET)
                  END IF
               END IF
 210        CONTINUE
         END IF
      GPHPAG = IPL.LT.NPOL
      CALL GFINIS (BUFFER, IERR)
      IF (IERR.NE.0) GO TO 975
         IRET = 0
         GO TO 990
C                                       Try to finish partial graph
 970  WRITE (MSGTXT,1970)
      CALL MSGWRT (6)
      CALL GFINIS (BUFFER, IERR)
      IF (IERR.EQ.0) GO TO 990
C                                       Destroy the plot file
 975  IF (.NOT.DOTV) THEN
         CALL ZCLOSE (LUNPL, FINDPL, IERR)
         CALL ZDESTR (DISKIN, PFILE, IERR)
         END IF
      GO TO 999
C                                       No catalog update
C                                       Messages
 990  WRITE (MSGTXT,1990) NGOOD
      CALL MSGWRT (2)
      WRITE (MSGTXT,1991) NNOFIT
      IF (NNOFIT.GE.1.0D0) CALL MSGWRT (2)
      IF (.NOT.DOTV) THEN
         CALL HIPLOT (DISKIN, FCNO(1), VER, BUFFER, IERR)
         WRITE (MSGTXT,1992) VER
         CALL MSGWRT (2)
         END IF
      IRET = 0
C
 999  RETURN
C-----------------------------------------------------------------------
 1030 FORMAT ('Plot file version',I4,'__created ',A12,A8)
 1035 FORMAT ('From',I3,'/',2(I2.2,':'),I2.2,' _to',I4,'/',2(I2.2,':'),
     *   I2.2,' __RA',I3.2,':',I2.2,':',F5.2,' _DEC ',A1,2(I2.2,':'),
     *   F4.1)
 1040 FORMAT ('UVrange ',2(1PE12.4),' wavelengths')
 1045 FORMAT (A,'__ Corr ',A,' _Channel',I6,' -',I6,' _IF',I3,' -',I3,
     *   ' _Freq =',F8.4,' GHz')
 1970 FORMAT ('PLTFT: ERROR DURING GRAPHING. WILL TRY TO FINISH',
     *   ' PARTIAL GRAPH')
 1990 FORMAT ('PLTFT: ',I10,' Points plotted')
 1991 FORMAT ('PLTFT: ',I10,' Points did not fit')
 1992 FORMAT ('PLTFT: Plot file version',I5,'  created.')
      END
      SUBROUTINE DODFT (RPBUF, VIS, T1, T2, FLAG, IRET)
C-----------------------------------------------------------------------
C   DODFT computes the DFT for a given set of visibilities with the
C   proper sky offset applied.
C   Inputs:
C     RPBUF   R(*)   one visibility record - random parameters
C     VIS     R(*)   one visibility record - data
C     T1      D      Start of interval
C     T2      D      End of interval
C     FLAG    I      If 0, continue summing DFT
C                    If 2, wrap it up, clear
C   Outputs:
C     IRET    I      0 => operation sucessful
C                    1 => trouble
C                    -1 => no data to average
C-----------------------------------------------------------------------
      REAL      RPBUF(*), VIS(*)
      INTEGER   FLAG, IRET
C
      REAL      TR, TI, WT, DELS, UU, VV, WW, SMN, TNR, TNI, TNU1(3,3),
     *   TNU2(3,3), TUMWT(3), TNA, XX, XV, XVARS(3)
      DOUBLE PRECISION T1, T2, AFREQ
      INTEGER   IIF, ICH, TAMP(3), LAD, IP, J
      LOGICAL   GOOD
      INCLUDE 'DFTPL.INC'
      INCLUDE 'INCS:DSEL.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:PSTD.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DDCH.INC'
      SAVE TNU1, TNU2, TUMWT, TAMP, XVARS
      DATA TNU1, TNU2, TUMWT, XVARS, TAMP /24*0.0, 3*0/
C-----------------------------------------------------------------------
      TR = 0.0
      TI = 0.0
      IRET = 0
      IF (FLAG.NE.0) GO TO 500
C                                       loop over IF and channel
      DO 100 IIF = BIF,EIF
         DO 90 ICH = BCHAN,ECHAN
            AFREQ = OFREQ + FOFF(IIF) + (ICH-FRPIX) * FINC(IIF)
C                                       Set U and V
            UU = RPBUF(ILOCU+1) * AFREQ / OFREQ
            VV = RPBUF(ILOCV+1) * AFREQ / OFREQ
            WW = RPBUF(ILOCW+1) * AFREQ / OFREQ
            DO 80 IP = 1,NPOL
C                                       Find visibilities and weights
               LAD = 1 + (ICH-BCHAN)*KNCF + (IIF-BIF)*KNCIF +
     *            (IP-1)*KNCS
               IF (VIS(LAD+2).GT.0.0) THEN
                  TR = VIS(LAD)
                  TI = VIS(LAD+1)
                  WT = VIS(LAD+2)
C                                       sum it up
                  XX = UU * DXC + VV * DYC + WW * DZC
                  TNR = TR * COS (XX) + TI * SIN (XX)
                  TNI = TI * COS (XX) - TR * SIN (XX)
                  TNA = SQRT (TNR*TNR + TNI*TNI)
                  TNU1(IP,1) = TNU1(IP,1) + WT * TNR
                  TNU2(IP,1) = TNU2(IP,1) + WT * TNR * TNR
                  TNU1(IP,2) = TNU1(IP,2) + WT * TNI
                  TNU2(IP,2) = TNU2(IP,2) + WT * TNI * TNI
                  TNU1(IP,3) = TNU1(IP,3) + WT * TNA
                  TNU2(IP,3) = TNU2(IP,3) + WT * TNA * TNA
                  TUMWT(IP) = TUMWT(IP) + WT
                  TAMP(IP) = TAMP(IP) + 1
                  IF (XVAR.GT.1) THEN
                     TR = RPBUF(ILOCT+1)
                     CALL GETXV (TR, XV)
                     XVARS(IP) = XVARS(IP) + WT * XV
                     END IF
                  END IF
 80            CONTINUE
 90         CONTINUE
 100     CONTINUE
      GO TO 999
C                                      Finish up this interval
 500  GOOD = .FALSE.
      J = 1
      IF (OPTYPE.EQ.'IMAG') J = 2
      IF (OPTYPE.EQ.'SAMP') J = 3
      IF (OPTYPE.EQ.'AMP') J = 4
      IF (OPTYPE.EQ.'PHAS') J = 5
      IF (J.EQ.1) OPTYPE = 'REAL'
      DO 510 IP = 1,NPOL
         IF (TUMWT(IP).GT.0.0) THEN
            GOOD = .TRUE.
            IF (J.LE.3) THEN
               SMN = TNU1(IP,J) / TUMWT(IP)
               DELS = TNU2(IP,J) / TUMWT(IP) - SMN*SMN
               DELS = SQRT (MAX (0.0, DELS))
               DFT(BCNT,IP) = SMN
               ERROR(BCNT,IP) = DELS / SQRT (MAX (1.0, TAMP(IP)-1.))
            ELSE
               TNR = TNU1(IP,1) / TUMWT(IP)
               TNI = TNU1(IP,2) / TUMWT(IP)
               TNA = SQRT (TNR*TNR + TNI*TNI)
               TR = TNU2(IP,1) / TUMWT(IP) - TNR*TNR
               TR = SQRT (MAX (0.0, TR))
               TI = TNU2(IP,2) / TUMWT(IP) - TNI*TNI
               TI = SQRT (MAX (0.0, TI))
               IF (TNA.LE.0.0) THEN
                  DFT(BCNT,IP) = FBLANK
                  ERROR(BCNT,IP) = FBLANK
               ELSE IF (J.EQ.4) THEN
                  DFT(BCNT,IP) = TNA
                  ERROR(BCNT,IP) = SQRT ((TNR*TR)**2 + (TNI*TI)**2)/TNA
               ELSE
                  DFT(BCNT,IP) = ATAN2 (TNI, TNR) * RAD2DG
                  ERROR(BCNT,IP) = SQRT ((TNI*TR)**2 + (TNR*TI)**2) /
     *                  TNA**2 * RAD2DG
                  END IF
               END IF
            TIMR(BCNT) = (T1+T2)/2.
            IF (XVAR.GT.1) TIMR(BCNT) = XVARS(IP) / TUMWT(IP)
         ELSE
            DFT(BCNT,IP) = FBLANK
            ERROR(BCNT,IP) = FBLANK
            END IF
 510     CONTINUE
      IF (GOOD) THEN
         IRET = 0
         BCNT = BCNT + 1
      ELSE
         IRET = -1
         END IF
      CALL RFILL (9, 0.0, TNU1)
      CALL RFILL (9, 0.0, TNU2)
      CALL RFILL (3, 0.0, TUMWT)
      CALL RFILL (3, 0.0, XVARS)
      CALL FILL (3, 0, TAMP)
C
 999  RETURN
      END
      SUBROUTINE GETXV (T, XV)
C-----------------------------------------------------------------------
C   returns the X axis variable when not time
C   Input
C      T    R   Time
C   Output
C      XV   R   X value
C-----------------------------------------------------------------------
      REAL      T, XV
C
      INCLUDE 'DFTPL.INC'
      INTEGER   IA
      REAL      HA, EL, AZ, PA
      DOUBLE PRECISION R, D, TT
      INCLUDE 'INCS:PSTD.INC'
C-----------------------------------------------------------------------
      R = RAS * DG2RAD
      D = DECS * DG2RAD
      TT = T
C                                       parallactic angle
      IF (XVAR.EQ.5) THEN
         CALL PARACO (T, R, D, PA)
         XV = PA * RAD2DG
C                                       el, ax, ha, lst
      ELSE
         IA = 1
         CALL COOELV (IA, TT, R, D, HA, EL, AZ)
         IF (XVAR.EQ.2) THEN
            XV = EL * RAD2DG
         ELSE IF (XVAR.EQ.3) THEN
            XV = HA * RAD2DG / 360.0
         ELSE IF (XVAR.EQ.4) THEN
            XV = (HA + R) * RAD2DG / 360.0
         ELSE
            XV = AZ * RAD2DG
            IF (XV.GT.180.) XV = XV - 360.
            END IF
         END IF
C
 999  RETURN
      END
