LOCAL INCLUDE 'INPUT.INC'
C                                       Declarations for inputs
      INCLUDE 'INCS:PAOOF.INC'
      INCLUDE 'INCS:PUVD.INC'
      INTEGER   NPARMS
      PARAMETER (NPARMS=25)
      INTEGER   AVTYPE(NPARMS), AVDIM(2,NPARMS)
      CHARACTER AVNAME(NPARMS)*8
LOCAL END
LOCAL INCLUDE 'INPUTDATA.INC'
C                                       DATA statments defining input
C                                       parameters.
C                      1         2          3        4         5
      DATA AVNAME /'INNAME', 'INCLASS', 'INSEQ', 'INDISK', 'INEXT',
C            6         7          8         9           10
     *   'INVERS', 'DODELAY', 'FREQID', 'SUBARRAY', 'FLAGVER',
C            11          12         13     14      15          16
     *   'OUTFGVER', 'TIMERANG', 'BIF', 'EIF', 'ANTENNAS', 'SOLINT',
C            17        18        19       20        21         22
     *   'DETIME', 'DOHIST', 'DOTWO', 'EXPERT', 'CROWDED', 'DO3COL',
C            23        24        25
     *   'REASON', 'ANTUSE', 'BADDISK'/
C                    1       2       3       4       5
      DATA AVTYPE /OOACAR, OOACAR, OOAINT, OOAINT, OOACAR,
C          6       7       8       9       10
     *   OOAINT, OOARE, OOAINT, OOAINT, OOAINT,
C          11      12      13      14      15      16
     *   OOAINT, OOARE,  OOAINT, OOAINT, OOAINT, OOARE,
C          17      18      19      20      21      22
     *   OOARE,  OOARE,  OOALOG, OOALOG, OOAINT, OOARE,
C          23      24      25
     *   OOACAR, OOAINT, OOAINT/
C                   1     2     3     4     5
      DATA AVDIM /12,1,  6,1,  1,1,  1,1,  2,1,
C         6     7     8     9     10
     *   1,1,  1,1,  1,1,  1,1,  1,1,
C         11    12    13    14    15    16
     *   1,1,  8,1,  1,1,  1,1, 50,1,  1,1,
C         17    18    19    20    21    22
     *   1,1,  1,1,  1,1,  1,1,  1,1,  1,1,
C         23    24    25
     *  24,1, 50,1, 10,1/
LOCAL END
LOCAL INCLUDE 'GFORT'
      INTEGER   IDUM(10)
      LOGICAL   LDUM(10)
      REAL      RDUM(10)
      DOUBLE PRECISION DDUM(5)
      EQUIVALENCE (DDUM, RDUM, IDUM, LDUM)
      COMMON /EDITAG/ DDUM
LOCAL END
      PROGRAM EDITA
C-----------------------------------------------------------------------
C! UV editing with the TV displaying System temperature or gain tables
C# Task AP OOP UV EDITING TV-APPL CALIBRATION
C-----------------------------------------------------------------------
C;  Copyright (C) 1996-2000, 2004, 2007, 2010, 2012, 2015, 2018, 2020,
C;  Copyright (C) 2022-2023
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   TY table data used for uv editing
C-----------------------------------------------------------------------
      CHARACTER PRGM*6, UVDATA*32, TBEDIT*32, TBTYPE*2
      INTEGER  IRET, BUFF1(256)
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DHDR.INC'
      DATA PRGM /'EDITA'/
C-----------------------------------------------------------------------
C                                       Startup
      CALL EDITIN (PRGM, UVDATA, TBEDIT, TBTYPE, IRET)
C                                       CLEAN
      IF (IRET.EQ.0) CALL EDITIT (UVDATA, TBEDIT, TBTYPE, IRET)
C                                       Close down files, etc.
      CALL DIE (IRET, BUFF1)
C
 999  STOP
      END
      SUBROUTINE EDITIN (PRGN, UVDATA, TBEDIT, TBTYPE, IERR)
C-----------------------------------------------------------------------
C   EDITIN gets input parameters for EDITA, creates the EDIT object.
C   Inputs:
C      PRGN     C*6    Program name
C   Output:
C      UVDATA   C*32   Name of input uv data. - as master
C      TBEDIT   C*32   Name of table object to be used in editing
C      TBTYPE   C*2    Type of table in use
C      IERR     I      Error code: 0 => ok
C-----------------------------------------------------------------------
      INTEGER   IERR
      CHARACTER PRGN*6, UVDATA*(*), TBEDIT*(*), TBTYPE*2
C
      INCLUDE 'INCS:PUVD.INC'
      INTEGER   NKEY1, NKEY2
C                                       NKEY1 = # adverbs FOR UVDATA
      PARAMETER (NKEY1=5)
C                                       NKEY2 = # adverbs for TBEDIT
      PARAMETER (NKEY2=20)
      INTEGER   DIM(7), TYPE, I, BIF, EIF, NIF, SUBA, FGVERI, FGVERO,
     *   FGVERC, FGV, DDELAY, ANTS(50), DISK, CNO, BUFFER(512)
      LOGICAL   DODELY, MULTIB, DODISP
      CHARACTER INK1(NKEY1)*8, OUTK1(NKEY1)*32, INK2(NKEY2)*8,
     *   OUTK2(NKEY2)*32, CDUMMY*1, TBTEMP*32, FGNAME(3)*32, FGIN*32
      INCLUDE 'INCS:PSTD.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INPUT.INC'
      INCLUDE 'GFORT'
      INCLUDE 'INPUTDATA.INC'
C                                       Adverbs to copy to UVDATA object
      DATA INK1 /'INNAME', 'INCLASS', 'INSEQ', 'INDISK', 'DOHIST'/
C                                       Rename
      DATA OUTK1 /'NAME', 'CLASS', 'IMSEQ', 'DISK', 'DOHIST'/
C                                       Adverbs for TBEDIT object
      DATA INK2 /'INNAME', 'INCLASS', 'INSEQ', 'INDISK', 'INVERS',
     *   'FREQID', 'SUBARRAY', 'TIMERANG', 'BIF', 'EIF', 'ANTENNAS',
     *   'SOLINT', 'DETIME', 'INEXT', 'DOTWO', 'EXPERT',
     *   'CROWDED', 'DO3COL', 'REASON', 'ANTUSE'/
C                                       Rename
      DATA OUTK2 /'NAME', 'CLASS', 'IMSEQ', 'DISK', 'VER',
     *   'FRQSEL', 'SUBARR', 'TIMERANG', 'BIF', 'EIF', 'ANTENNAS',
     *   'EQU_TIME', 'GAP_TIME', 'TBLTYPE', 'COMPARE',
     *   'DOEXPERT', 'CROWDED', 'DO3COLOR', 'REASON', 'ANTS2USE'/
      DATA FGNAME /'IN_FGVER', 'OUT_FGVER', 'COP_FGVER'/
C-----------------------------------------------------------------------
C                                       Startup interactive
      CALL AV2INT (PRGN, NPARMS, AVNAME, AVTYPE, AVDIM, 'Input', IERR)
      IF (IERR.NE.0) GO TO 999
      RQUICK = .FALSE.
C                                       BADDISK
      CALL OGET ('Input', 'BADDISK', TYPE, DIM, IBAD, CDUMMY, IERR)
      IF (IERR.NE.0) GO TO 999
C                                       check table type
      CALL OGET ('Input', 'INEXT', TYPE, DIM, IDUM, TBTYPE, IERR)
      IF (IERR.NE.0) GO TO 999
      IF ((TBTYPE.NE.'TY') .AND. (TBTYPE.NE.'SN') .AND.
     *   (TBTYPE.NE.'CL') .AND. (TBTYPE.NE.'SY')) THEN
         MSGTXT = 'TABLE TYPE ''' // TBTYPE // ''' NOT SUPPORTED'
         CALL MSGWRT (8)
         IERR = 8
         GO TO 999
         END IF
      CALL OGET ('Input', 'DODELAY', TYPE, DIM, IDUM, CDUMMY, IERR)
      DDELAY = RDUM(1)
      IF (IERR.NE.0) GO TO 999
      IF (DDELAY.GT.2.5) THEN
         DODISP = .TRUE.
         MULTIB = .FALSE.
         DODELY = .FALSE.
      ELSE IF (DDELAY.GT.1.5) THEN
         DODISP = .FALSE.
         MULTIB = .TRUE.
         DODELY = .FALSE.
      ELSE
         DODISP = .FALSE.
         MULTIB = .FALSE.
         DODELY = DDELAY.GT.0.0
         END IF
      IF ((TBTYPE.NE.'SN') .AND. (TBTYPE.NE.'CL')) THEN
         DODISP = .FALSE.
         MULTIB = .FALSE.
         DODELY = .FALSE.
         END IF
C                                       SUBARRAY
      CALL OGET ('Input', 'SUBARRAY', TYPE, DIM, IDUM, CDUMMY, IERR)
      SUBA = IDUM(1)
      IF (IERR.NE.0) GO TO 999
      SUBA = MAX (1, SUBA)
      IDUM(1) = SUBA
      CALL OPUT ('Input', 'SUBARRAY', TYPE, DIM, IDUM, CDUMMY, IERR)
      IF (IERR.NE.0) GO TO 999
C                                       ANTENNAS
      CALL OGET ('Input', 'ANTENNAS', TYPE, DIM, ANTS, CDUMMY, IERR)
      IF (IERR.NE.0) GO TO 999
C                                       Create UV master object
      UVDATA = 'UVDATA master input object'
      CALL CREATE (UVDATA, 'UVDATA', IERR)
      IF (IERR.NE.0) GO TO 999
C                                       Copy adverbs to object
      CALL IN2OBJ ('Input', NKEY1, INK1, OUTK1, UVDATA, IERR)
      IF (IERR.NE.0) GO TO 999
C                                       Open UVDATA to be sure it's OK
      CALL OOPEN (UVDATA, 'READ', IERR)
      IF (IERR.NE.0) GO TO 999
C                                       get file parameters
      CALL FNAGET (UVDATA, 'DISK', TYPE, DIM, IDUM, CDUMMY, IERR)
      DISK = IDUM(1)
      IF (IERR.NE.0) GO TO 999
      CALL FNAGET (UVDATA, 'CNO', TYPE, DIM, IDUM, CDUMMY, IERR)
      CNO = IDUM(1)
      IF (IERR.NE.0) GO TO 999
      CALL ANTOUT (DISK, CNO, SUBA, ANTS, CATBLK, BUFFER, IERR)
      IF (IERR.EQ.0) THEN
         DIM(1) = 50
         DIM(2) = 1
         CALL OPUT ('Input', 'ANTENNAS', OOAINT, DIM, ANTS, CDUMMY,
     *      IERR)
         IF (IERR.NE.0) GO TO 999
         CALL OPUT (UVDATA, 'ANTENNAS', OOAINT, DIM, ANTS, CDUMMY, IERR)
         IF (IERR.NE.0) GO TO 999
         END IF
C                                       close
      CALL OCLOSE (UVDATA, IERR)
      IF (IERR.NE.0) GO TO 999
C                                       Find highest FG table.
      FGIN = 'Temporary FG table for EDITR'
      FGV = 1
      CALL UV2TAB (UVDATA, FGIN, 'FG', FGV, IERR)
      IF (IERR.NE.0) GO TO 999
      CALL TBLHIV (FGIN, FGV, IERR)
      IF (IERR.NE.0) GO TO 999
      CALL TABDES (FGIN, IERR)
      IF (IERR.NE.0) GO TO 999
C                                       Set FLAGVER
      CALL OGET ('Input', 'FLAGVER', TYPE, DIM, IDUM, CDUMMY, IERR)
      FGVERI = IDUM(1)
      IF (IERR.NE.0) GO TO 999
      CALL OGET ('Input', 'OUTFGVER', TYPE, DIM, IDUM, CDUMMY, IERR)
      FGVERO = IDUM(1)
      IF (IERR.NE.0) GO TO 999
      FGVERI = MIN (FGVERI, FGV)
      IF (FGVERI.EQ.0) FGVERI = FGV
      IF ((FGVERO.LE.0) .OR. (FGVERO.GT.FGV)) FGVERO = FGV + 1
      FGVERC = FGVERI
      IF (FGVERO.LE.FGV) FGVERC = - ABS (FGVERI)
      IDUM(1) = FGVERI
      CALL OPUT (UVDATA, FGNAME(1), TYPE, DIM, IDUM, CDUMMY, IERR)
      IF (IERR.NE.0) GO TO 999
      IDUM(1) = FGVERO
      CALL OPUT (UVDATA, FGNAME(2), TYPE, DIM, IDUM, CDUMMY, IERR)
      IF (IERR.NE.0) GO TO 999
      IDUM(1) = FGVERC
      CALL OPUT (UVDATA, FGNAME(3), TYPE, DIM, IDUM, CDUMMY, IERR)
      IF (IERR.NE.0) GO TO 999
C                                       Create TBEDIT object
      TBEDIT = TBTYPE // ' table to be used in editing'
      CALL CREATE (TBEDIT, 'TABLE', IERR)
      IF (IERR.NE.0) GO TO 999
C                                       Copy adverbs to object
      CALL IN2OBJ ('Input', NKEY2, INK2, OUTK2, TBEDIT, IERR)
      IF (IERR.NE.0) GO TO 999
C                                       Use input for editing
      IF ((TBTYPE.EQ.'TY') .OR. (TBTYPE.EQ.'SY')) THEN
C                                       Open TBEDIT to be sure it's OK.
         CALL OOPEN (TBEDIT, 'READ', IERR)
         IF (IERR.NE.0) GO TO 999
         CALL OGET (TBEDIT, 'KEY.NO_IF', TYPE, DIM, IDUM, CDUMMY, IERR)
         NIF = IDUM(1)
         IF ((IERR.NE.0) .OR. (NIF.LE.0)) NIF = 1
         CALL OCLOSE (TBEDIT, IERR)
         IF (IERR.NE.0) GO TO 999
C                                       make copy of input
      ELSE
         DIM(1) = 1
         DIM(2) = 1
         I = 0
         IDUM(1) = 0
         CALL OPUT (TBEDIT, 'VER', OOAINT, DIM, IDUM, CDUMMY, IERR)
         IF (IERR.NE.0) GO TO 999
         LDUM(1) = DODELY
         CALL OPUT (TBEDIT, 'DODELAY', OOALOG, DIM, IDUM, CDUMMY, IERR)
         IF (IERR.NE.0) GO TO 999
         LDUM(1) = MULTIB
         CALL OPUT (TBEDIT, 'MULTIBAND', OOALOG, DIM, IDUM, CDUMMY,
     *      IERR)
         IF (IERR.NE.0) GO TO 999
         LDUM(1) = DODISP
         CALL OPUT (TBEDIT, 'DISPERSION', OOALOG, DIM, IDUM, CDUMMY,
     *      IERR)
         IF (IERR.NE.0) GO TO 999
C                                       Create TBTEMP object
         TBTEMP = 'Temp input file to be copied'
         CALL CREATE (TBTEMP, 'TABLE', IERR)
         IF (IERR.NE.0) GO TO 999
C                                       Copy adverbs to object
         CALL IN2OBJ ('Input', NKEY2, INK2, OUTK2, TBTEMP, IERR)
         IF (IERR.NE.0) GO TO 999
C                                       Open TBTEMP to be sure it's OK.
         CALL OOPEN (TBTEMP, 'READ', IERR)
         IF (IERR.NE.0) GO TO 999
         CALL OGET (TBTEMP, 'KEY.NO_IF', TYPE, DIM, IDUM, CDUMMY, IERR)
         NIF = IDUM(1)
         IF ((IERR.NE.0) .OR. (NIF.LE.0)) NIF = 1
         CALL OCLOSE (TBTEMP, IERR)
         IF (IERR.NE.0) GO TO 999
C                                       copy input table to output
         CALL TBLCOP (TBTEMP, TBEDIT, IERR)
         IF (IERR.NE.0) THEN
            MSGTXT = 'EDITIN: TROUBLE COPYING INPUT TO OUTPUT TABLE'
            CALL MSGWRT (8)
            GO TO 999
            END IF
C                                       remove object (leave input
C                                       table untouched)
         CALL TABDES (TBTEMP, IERR)
         END IF
C                                       IF numbers
C                                       Default BIF, EIF
      CALL OGET ('Input', 'BIF', TYPE, DIM, IDUM, CDUMMY, IERR)
      BIF = IDUM(1)
      IF (IERR.NE.0) GO TO 999
      CALL OGET ('Input', 'EIF', TYPE, DIM, IDUM, CDUMMY, IERR)
      EIF = IDUM(1)
      IF (IERR.NE.0) GO TO 999
      BIF = MAX (1, BIF)
      BIF = MIN (BIF, NIF)
      IF (EIF.LT.BIF) EIF = NIF
      EIF = MIN (EIF, NIF)
C                                       Save in Inputs for history
      DIM(1) = 1
      IDUM(1) = BIF
      CALL OPUT ('Input', 'BIF', OOAINT, DIM, IDUM, CDUMMY, IERR)
      IF (IERR.NE.0) GO TO 999
      CALL OPUT (TBEDIT, 'BIF', OOAINT, DIM, IDUM, CDUMMY, IERR)
      IF (IERR.NE.0) GO TO 999
      IDUM(1) = EIF
      CALL OPUT ('Input', 'EIF', OOAINT, DIM, IDUM, CDUMMY, IERR)
      IF (IERR.NE.0) GO TO 999
      CALL OPUT (TBEDIT, 'EIF', OOAINT, DIM, IDUM, CDUMMY, IERR)
      IF (IERR.NE.0) GO TO 999
C
 999  RETURN
      END
      SUBROUTINE EDITIT (UVDATA, TBEDIT, TBTYPE, IERR)
C-----------------------------------------------------------------------
C   Does the editing
C   Inputs:
C      UVDATA   C*32   Name of input uv data. - as master
C      TBEDIT   C*32   Name of TY table data
C      TBTYPE   C*2    Type of table
C   Output:
C      IERR    I    Error code: 0 => ok
C-----------------------------------------------------------------------
      INTEGER   IERR
      CHARACTER UVDATA*(*), TBEDIT*(*), TBTYPE*2
C
      CHARACTER UVEDIT*32, STATUS*4, TVDEVC*32, CDUMMY*1
      INTEGER   JERR, DIM(7)
      LOGICAL   DOFLAG
      INCLUDE 'INCS:PAOOF.INC'
      INCLUDE 'GFORT'
      INCLUDE 'INCS:DMSG.INC'
      DATA DOFLAG /.TRUE./
C-----------------------------------------------------------------------
C                                       open TV object
      TVDEVC = 'EDITA task TV object'
      CALL TVDCRE (TVDEVC, IERR)
      IF (IERR.NE.0) GO TO 990
      CALL TVDOPN (TVDEVC, STATUS, IERR)
      IF (IERR.NE.0) GO TO 985
C                                       open edit object
      UVEDIT = 'EDITA task EDIT object'
      CALL EDICRE (UVEDIT, IERR)
      IF (IERR.NE.0) GO TO 980
      CALL EDIOPN (UVEDIT, STATUS, IERR)
      IF (IERR.NE.0) GO TO 975
C                                       Insert object info
      DIM(1) = LEN(UVDATA)
      DIM(2) = 1
      CALL EDIPUT (UVEDIT, 'UVMASTER', OOACAR, DIM, IDUM, UVDATA, IERR)
      IF (IERR.NE.0) GO TO 980
      DIM(1) = LEN(TBEDIT)
      CALL EDIPUT (UVEDIT, 'TBEDIT', OOACAR, DIM, IDUM, TBEDIT, IERR)
      IF (IERR.NE.0) GO TO 980
      DIM(1) = LEN(TVDEVC)
      CALL EDIPUT (UVEDIT, 'TVDEVICE', OOACAR, DIM, IDUM, TVDEVC, IERR)
      IF (IERR.NE.0) GO TO 980
      DIM(1) = 1
      LDUM(1) = DOFLAG
      CALL EDIPUT (UVEDIT, 'DOUVFLAG', OOALOG, DIM, IDUM, CDUMMY, IERR)
      IF (IERR.NE.0) GO TO 980
C                                       system temperatures
      IF (TBTYPE.EQ.'TY') THEN
C                                       do it
         CALL EDITTY ('INIT', UVEDIT, IERR)
C                                       Clean up - no apply
         IF (IERR.NE.0) THEN
            IF (IERR.LT.0) THEN
               CALL EDITTY ('ABOR', UVEDIT, JERR)
               IERR = 0
            ELSE
               CALL EDITTY ('KILL', UVEDIT, JERR)
               END IF
C                                       apply FG and clean up
         ELSE
            CALL EDITTY ('APPL', UVEDIT, IERR)
            END IF
         CALL TABCLO (TBEDIT, JERR)
         CALL TABDES (TBEDIT, JERR)
C                                       system temperatures
      ELSE IF (TBTYPE.EQ.'SY') THEN
C                                       do it
         CALL EDITSY ('INIT', UVEDIT, IERR)
C                                       Clean up - no apply
         IF (IERR.NE.0) THEN
            IF (IERR.LT.0) THEN
               CALL EDITSY ('ABOR', UVEDIT, JERR)
               IERR = 0
            ELSE
               CALL EDITSY ('KILL', UVEDIT, JERR)
               END IF
C                                       apply FG and clean up
         ELSE
            CALL EDITSY ('APPL', UVEDIT, IERR)
            END IF
         CALL TABCLO (TBEDIT, JERR)
         CALL TABDES (TBEDIT, JERR)
C                                       gain solutions
      ELSE
C                                       do it
         CALL EDITSN ('INIT', UVEDIT, IERR)
C                                       Clean up - no apply
         IF (IERR.NE.0) THEN
            IF (IERR.LT.0) THEN
               CALL EDITSN ('ABOR', UVEDIT, JERR)
               IERR = 0
            ELSE
               CALL EDITSN ('KILL', UVEDIT, JERR)
               END IF
C                                       apply FG and clean up
         ELSE
            CALL EDITSN ('APPL', UVEDIT, IERR)
            END IF
         CALL TABCLO (TBEDIT, JERR)
         CALL TABZAP (TBEDIT, JERR)
         END IF
C                                       Delete object
      CALL EDICLO (UVEDIT, JERR)
 975  CALL EDIDES (UVEDIT, JERR)
C                                       close and delete TV device
 980  CALL TVDCLO (TVDEVC, JERR)
 985  CALL TVDDES (TVDEVC, JERR)
C                                       error message
 990  IF (IERR.NE.0) THEN
         MSGTXT = 'ERROR EDITING ' // TBEDIT
         CALL MSGWRT (6)
         END IF
C
 999  RETURN
      END
