LOCAL INCLUDE 'SHAHO.INC'
C                                       Local include for SHAHO
      INCLUDE 'INCS:PUVD.INC'
      INCLUDE 'INCS:ZPBUFSZ.INC'
      INTEGER   MXSOU
      PARAMETER (MXSOU = XSTBSZ)
C
      INTEGER   SEQ, DISK, LUN2, FIND2, FGVER, NFLAG, NID, ID(MXSOU),
     *   NUMAN(513), CNOIN, WFLAG, KUAL, IBUFF(UVBFSS)
      LOGICAL   MULTI, ISREF(MAXANT)
      HOLLERITH XNAME(3), XCLASS(2), XXSOUR(4,30)
      CHARACTER NAME*12, CLASS*6, XSOUR(30)*16, REASON*24, STOKES*4
      REAL      XSEQIN, XVIN, XANT(50), XFGVER, APARM(10), BUFF(UVBFSS)
      DOUBLE PRECISION JD0
      EQUIVALENCE (BUFF, IBUFF)
      INCLUDE 'INCS:DCAT.INC'
C
      COMMON /FLAGS/ NFLAG, NID, ID, NUMAN, WFLAG, KUAL, ISREF
      COMMON /BUFRS/ BUFF
      COMMON /INPARM/ XNAME, XCLASS, XSEQIN, XVIN, XXSOUR, XANT, XFGVER,
     *   APARM
      COMMON /CHRCOM/ NAME, CLASS, XSOUR, REASON, STOKES
      COMMON /FQCRAP/ JD0, SEQ, DISK, CNOIN, LUN2, FIND2, FGVER, MULTI
LOCAL END
      PROGRAM SHAHO
C-----------------------------------------------------------------------
C! Flag selected holography data for shadowing
C# UV Calibration Editing
C-----------------------------------------------------------------------
C;  Copyright (C) 2021-2022
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   Task SHAHO flags selected portions of a uv data base.
C   Data either flagged directly or an entry is made in the flagging
C   table.
C   Inputs:
C      AIPS Adverb  Prg. Name      Description
C      INNAME       NAME        File name of data base to be flagged
C      INCLASS      CLASS       Input file class.
C      INSEQ        SEQ         Input file sequence number.
C      INDISK       DISK        Disk volumn on which file resides.
C      SOURCES      XSOUR(4,30) Names of sources specified.
C      TIMERANG     TIMER(8)    Time range
C      FLAGVER      FGVER       Flag file version.
C-----------------------------------------------------------------------
      CHARACTER PRGM*6
      INTEGER   IRET
      INCLUDE 'SHAHO.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:DANS.INC'
      DATA PRGM /'SHAHO '/
C-----------------------------------------------------------------------
C                                       Get inputs.
      CALL UVFGIN (PRGM, IRET)
      IF (IRET.GT.0) GO TO 990
C                                       Write history
      CALL UVFGHS
C                                       Close down
 990  CALL DIE (IRET, BUFF)
C
 999  STOP
      END
      SUBROUTINE UVFGIN (PRGM, IRET)
C-----------------------------------------------------------------------
C   UVFGIN does the startup bookeeping and reads the flagging table
C   from the specified text file if necessary.
C   Input:
C   PRGM       C*6  Task name.
C   Output:
C     IRET         I    Return error code, 0=> OK, otherwise failed.
C   Output to common /FLAGS/:
C     NFLAG        I   Number of flagging criteria in common.
C-----------------------------------------------------------------------
      CHARACTER PRGM*6
      INTEGER   IRET
C                                       Max. no. of time intervals on
C                                       any given baseline for elev.
C                                       flagging.
      INTEGER   MXTIM
      PARAMETER (MXTIM = 10)
      INCLUDE 'INCS:PUVD.INC'
      INTEGER   NPARM, I, IERR, NSOUR, LUN, LUNAN, XA1, XA2, NBASE,
     *   MAXBAS, KBCH, KECH, KBIF, KEIF, NOCHAN, NOIF, IFGRNO, LUNFQ,
     *   SUBA, FQD, IFGVER, FGBUFF(512), IERANT
      REAL      STARTD, STOPD, SHMIN, CTMIN, FLAGT1, FLAGT2
      LOGICAL   WSBLNK, FGOPEN, T, F
      INCLUDE 'SHAHO.INC'
      INTEGER   FGKOLS(MAXFGC), FGNUMV(MAXFGC)
      CHARACTER UTYPE*2
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:DANS.INC'
      INCLUDE 'INCS:PSTD.INC'
      DATA LUN, LUNAN, LUNFQ /27, 30, 40/
      DATA MAXBAS /MXBASE/
      DATA T, F /.TRUE.,.FALSE./
C-----------------------------------------------------------------------
      IRET = 0
C                                       Init I/O
      CALL ZDCHIN (T)
      CALL VHDRIN
      LUN2 = 17
C                                       Initialize /CFILES/
      NSCR = 0
      NCFILE = 0
      NFLAG = 0
      WFLAG = 0
C                                       Get input parameters.
      NPARM = 189
      IRET = 0
      CALL GTPARM (PRGM, NPARM, RQUICK, XNAME, IBUFF, IERR)
      IF (IERR.NE.0) THEN
         WRITE (MSGTXT,1000) IERR
         RQUICK = F
         IRET = 8
         GO TO 990
         END IF
C                                       Decode input.
      SEQ = XSEQIN + 0.1
      DISK = XVIN + 0.1
C                                       Characters
      CALL H2CHR (12, 1, XNAME, NAME)
      CALL H2CHR (6, 1, XCLASS, CLASS)
      REASON = 'Shadowing holography'
C
      WSBLNK = T
      DO 20 I = 1,30
         CALL H2CHR (16, 1, XXSOUR(1,I), XSOUR(I))
         IF (XSOUR(I).NE.' ') WSBLNK = F
 20      CONTINUE
      IF (WSBLNK) XSOUR(1) = 'HOLORASTER'
      STOKES = '1111'
      CALL LFILL (MAXANT, .FALSE., ISREF)
      DO 25 I = 1,50
         XA1 = XANT(I) + 0.1
         IF ((XA1.GT.0) .AND. (XA1.LE.MAXANT)) ISREF(XA1) = .TRUE.
 25      CONTINUE
C                                       Open file and get CATBLK.
C                                       open file non-excl to allow
C                                       a second open as well:
      UTYPE = 'UV'
      CALL MAPOPN ('HDWR', DISK, NAME, CLASS, SEQ, UTYPE, NLUSER, LUN2,
     *   FIND2, CNOIN, CATBLK, IBUFF, IERR)
      IF (IERR.GT.1) THEN
         WRITE (MSGTXT,1010) IERR
         RQUICK = F
         IRET = 8
         GO TO 990
         END IF
C                                       Mark in /CFILES/
      NCFILE = NCFILE + 1
      FVOL(NCFILE) = DISK
      FCNO(NCFILE) = CNOIN
      FRW(NCFILE) = 1
C                                       Restart AIPS.
      IF (RQUICK) CALL RELPOP (IRET, IBUFF, IERR)
      IF (IRET.NE.0) GO TO 990
      IRET = 8
C                                       Get info from CATBLK.
      CALL UVPGET (IRET)
      IF (IRET.NE.0) GO TO 999
C                                       Check if multi source file
      CALL MULSDB (CATBLK, MULTI)
C                                       Write table
      CALL FNDEXT ('FG', CATBLK, IFGVER)
      FGVER = XFGVER + 0.1
      IF (FGVER.LE.0) FGVER = MAX (1, IFGVER)
C                                       Get number(s) of antennas.
C                                       Since GETNAN will return
C                                       a reasonable default -
C                                       ignore error code.
      CALL GETNAN (DISK, CNOIN, CATBLK, LUNAN, IBUFF, NUMAN, IERANT)
C                                       Also get antenna names &
C                                       numbers
      SUBA = 1
      IF (IERANT.EQ.0) THEN
         CALL GETANT (DISK, CNOIN, SUBA, CATBLK, IBUFF, IERANT)
         IF (IERANT.NE.0) THEN
            WRITE (MSGTXT,1030) IERANT
            CALL MSGWRT (6)
            IRET = 7
            GO TO 999
            END IF
         END IF
C                                       If multi-source get numbers.
C                                       Set max. no sources named.
      NSOUR = 30
C                                       shadowing
      IF (APARM(5).LE.0.0) APARM(5) = 25.
C                                       Set max. no. sources sel.
      NID = 1
      ID(1) = 0
      IF (MULTI) THEN
         NID = MXSOU
         KUAL = -1
         CALL SOURNU (XSOUR, KUAL, NSOUR, DISK, CNOIN, NID, IBUFF, ID,
     *      IRET)
         IF (IRET.LT.0) THEN
            MSGTXT = 'SOURCE(S) NOT FOUND IN SU TABLE'
            CALL MSGWRT (7)
            IRET = 5
            END IF
         IF (IRET.NE.0) GO TO 999
         IF (NID.EQ.0) NID = 1
         END IF
C                                       IF, channel limits
      KBCH = 1
      NOCHAN = CATBLK(KINAX+JLOCF)
      KECH = NOCHAN
      IF (JLOCIF.GE.0) THEN
         NOIF = CATBLK(KINAX+JLOCIF)
         KBIF = 1
         KEIF = CATBLK(KINAX+JLOCIF)
      ELSE
         NOIF = 1
         KBIF = 1
         KEIF = 1
         END IF
C                                       Convert to baseline numbers.
C                                       Flagging on shadowing
      FQD = -1
      SHMIN = APARM(5) * CATD(KDCRV+JLOCF) / VELITE
      CTMIN = APARM(6) * CATD(KDCRV+JLOCF) / VELITE
      STARTD = 0.
      STOPD = 9999.
      CALL FLAGSH (LUN, FGBUFF, IFGRNO, FGKOLS, FGNUMV, SUBA,
     *   STARTD, STOPD, FQD, FGOPEN, SHMIN, CTMIN, IRET)
      IF (IRET.GT.0) GO TO 999
C                                       Close FG table
      IF (FGOPEN) THEN
         CALL FLAGUP ('CLOS', LUN, DISK, CNOIN, FGVER, FGBUFF,
     *      IFGRNO, FGKOLS, FGNUMV, ID, NID, SUBA, 1,
     *      NBASE, XA1, XA2, FLAGT1, FLAGT2, KBIF, KEIF, KBCH,
     *      KECH, STOKES, REASON, I, IRET)
         IF (WFLAG.LE.0) THEN
            WRITE (MSGTXT,1211) FGVER
            CALL MSGWRT (7)
         ELSE
            WRITE (MSGTXT,1210) WFLAG, FGVER
            CALL MSGWRT (4)
            END IF
C                                       Nothing was added to the FG
C                                       table
      ELSE
         WRITE (MSGTXT,1215) FGVER
         CALL MSGWRT (7)
         END IF
      GO TO 999
C                                       Error
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('ERROR:',I7,'GETTING INPUT PARAMETERS')
 1010 FORMAT ('ERROR:',I7,' FINDING UV FILE')
 1030 FORMAT ('ERROR:',I3,' READING ANTENNA TABLE')
 1210 FORMAT ('Wrote ',I8,' flags to flag table version',I3)
 1211 FORMAT ('WARNING: DID NOT WRITE/CHANGE ANY RECORDS IN FG VERSION',
     *   I4)
 1215 FORMAT ('NOTHING WAS ADDED TO FG TABLE ',I3)
      END
      SUBROUTINE UVFGHS
C-----------------------------------------------------------------------
C   UVFGHS writes the flagging information in the history file
C-----------------------------------------------------------------------
      CHARACTER HILINE*72, CTIME*8, CDATE*12
      INTEGER   IRET, LUNH, DATE(3), TIME(3)
      LOGICAL   T
      INCLUDE 'SHAHO.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DHIS.INC'
      DATA T /.TRUE./
      DATA LUNH /27/
C-----------------------------------------------------------------------
C                                       Open history file
      CALL HIINIT (2)
      CALL HIOPEN (LUNH, DISK, FCNO(1), IBUFF, IRET)
      IF (IRET.NE.0) GO TO 999
C                                       Write time and date on old file
      CALL ZDATE (DATE)
      CALL ZTIME (TIME)
      CALL TIMDAT (TIME, DATE, CTIME, CDATE)
      WRITE (HILINE,1000) TSKNAM, RLSNAM, CDATE, CTIME
      CALL HIADD (LUNH, HILINE, IBUFF, IRET)
      IF (IRET.NE.0) GO TO 100
      WRITE (HILINE,1012) TSKNAM, APARM(5), APARM(6)
      CALL HIADD (LUNH, HILINE, IBUFF, IRET)
      IF (IRET.NE.0) GO TO 100
      WRITE (HILINE,1030) TSKNAM, FGVER
      CALL HIADD (LUNH, HILINE, IBUFF, IRET)
      IF (IRET.NE.0) GO TO 100
      WRITE (HILINE,1031) TSKNAM, WFLAG
      CALL HIADD (LUNH, HILINE, IBUFF, IRET)
      IF (IRET.NE.0) GO TO 100
C
 100  CALL HICLOS (LUNH, T, IBUFF, IRET)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT (A6,'RELEASE =''',A7,' ''  /********* Start ',A12,2X,A8)
 1012 FORMAT (A6,'MINBASLN=',F6.1,' ,',F6.1,'  / min baseline',
     *   ' shadow, crosstalk')
 1030 FORMAT (A6,'OUTFGVER=',I5,'  / output FG table version')
 1031 FORMAT (A6,'NFLAG =',I9,'   / number flag commands written')
      END
      SUBROUTINE FLAGSH (FGLUN, FGBUFF, IFGRNO, FGKOLS, FGNUMV, SUBA,
     *   STARTD, STOPD, FQID, FGOPEN, SHMIN, CTMIN, IRET)
C-----------------------------------------------------------------------
C   Updates the flag table (FG) to flag all shadowed data
C   Inputs:
C      FGLUN    I        Logical unit number to use
C      SUBA     I        Subarray number.
C      STARTD   R        Start of the data (days)
C      STOPD    R        Stop  of the data (days)
C      FQID     I        Freqid number
C      SHMIN    R        Min baseline in lambda at ref freq shadowing
C      CTMIN    R        Min baseline in lambda for cross talk
C   Input from common:
C      STOKES   C*4      Stokes parameter desired
C      DISK     I        Disk to use.
C      CNOIN    I        Catalog slot number
C      FGVER    I        FG file version
C      XANTS    R(50)    List of antennas
C   Input/Output:
C      FGBUFF   I(512)   I/O buffer and related storage, also defines
C                        file if open.
C      IFGRNO   I        Next scan number, start of the file if 'READ',
C                        the last+1 if WRITE
C      FGKOLS   I(8)     The column pointer array in order, SOURCE,
C                        SUBARRAY, ANTS, TIMERANG, IFS, CHANS, PFLAGS,
C                        REASON
C      FGNUMV   I(*)     Element count in each column.
C   Output:
C      FGOPEN   L        FG table was open
C      IRET     I        Error code, 0=>OK else TABIO error.
C                        Note: -1 => read, but record deselected.
C-----------------------------------------------------------------------
      INTEGER   FGLUN, FGBUFF(*), IFGRNO, FGKOLS(*), FGNUMV(*), SUBA,
     *   FQID, IRET
      REAL      STARTD, STOPD, SHMIN, CTMIN
      LOGICAL   FGOPEN
C
      CHARACTER FILE*48
      CHARACTER LREAS1*24, LREAS2*24, OPCODE*4
      INTEGER   SOUID, OLDSOU(2), IA1, IA2, IROUND, SID, XCOUNT, IVER,
     *   VO, BO, LENBU, NMCOR, ISUBA, LUNSS, LUNUV, LANT, JSUB, JSUB1,
     *   JSUB2, LFQID, NFL, NB, LA1, LA2, VCOUNT, CATSAV(256)
      LOGICAL   T, F
      REAL      TIME, TIMOLD, BLTEMP, TIMST, TIMEN, TINT, TDIF,
     *   RPARM(20)
      DOUBLE PRECISION DRA, DDEC
      INCLUDE 'SHAHO.INC'
      INCLUDE 'INCS:PUVD.INC'
      INTEGER   MAXB
      PARAMETER (MAXB = MAXANT*MAXANT)
      REAL      TBEG(MAXANT), TEND(MAXANT), TBB(MAXB), TBE(MAXB)
      LOGICAL   ANTBAD(MAXANT), BASBAD(MAXB), PLANET
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:DSOU.INC'
      INCLUDE 'INCS:PSTD.INC'
      INCLUDE 'INCS:DANS.INC'
      INCLUDE 'INCS:DANT.INC'
      DATA T, F /.TRUE.,.FALSE./
      DATA LUNSS /25/
      DATA LUNUV, BO, VO /16, 1, 0/
C-----------------------------------------------------------------------
      OPCODE = 'FLAG'
      TINT = 0.09/24.0/3.6E3
      TDIF = TINT
      FGOPEN = .FALSE.
      LREAS1 = 'antenna shadowing'
      LREAS2 = 'possible cross-talk'
      IF (REASON.NE.' ') LREAS1 = REASON
      CALL FNDEXT ('AN', CATBLK, ISUBA)
      IF ((SUBA.GT.0) .AND. (SUBA.LE.ISUBA)) THEN
         JSUB1 = SUBA
         JSUB2 = SUBA
      ELSE
         JSUB1 = 1
         JSUB2 = ISUBA
         END IF
C                                       Open for Read.
      LENBU = 450
      LENBU = 0
      LFQID = 1
      IVER = 1
      CALL CATDIR ('CSTA', DISK, FCNO(1), NAME, CLASS, SEQ, 'UV',
     *   NLUSER, 'CLWR', BUFF, IRET)
      CALL ZPHFIL ('UV', DISK, FCNO(1), IVER, FILE, IRET)
C      CALL ZOPEN (LUNUV, FIND, DISK, FILE, T, F, T, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1010) IRET
         GO TO 990
         END IF
      DO 200 JSUB = JSUB1,JSUB2
         WRITE (MSGTXT,1000) JSUB
         CALL MSGWRT (2)
         CALL SEDSEL (NAME, CLASS, SEQ, DISK, JSUB)
C                                       get antenna info this subarray
         CALL GETANT (DISK, CNOIN, JSUB, CATBLK, IBUFF, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1015) IRET, JSUB
            GO TO 990
            END IF
         CALL JULDAY (RDATE, JD0)
C                                       protect header
         CALL COPY (256, CATBLK, CATSAV)
         CALL UVGET ('INIT', RPARM, BUFF, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1001) IRET, JSUB, 'OPEN FOR READ'
            CALL MSGWRT (6)
            GO TO 200
            END IF
         CALL COPY (256, CATSAV, CATBLK)
         CALL CATDIR ('CSTA', DISK, FCNO(1), NAME, CLASS, SEQ, 'UV',
     *      NLUSER, 'CLRD', BUFF, IRET)
         XCOUNT = 0
         VCOUNT = 0
         NMCOR = LREC - NRPARM
         NB = NSTNS * NSTNS
C                                       initialize the begin of flag
C                                       intervals
         CALL RFILL (MAXANT, -1000.0, TBEG)
         CALL RFILL (MAXB, -1000.0, TBB)
         CALL LFILL (NSTNS, .FALSE., ANTBAD)
         CALL LFILL (MAXB, .FALSE., BASBAD)
         TIMOLD = -1.E6
         OLDSOU(1) = -1
C                                       Start looping thru data.
C                                       Read buffer.
 50      XCOUNT = XCOUNT + 1
         CALL UVGET ('READ', RPARM, BUFF, IRET)
         IF (IRET.GT.0) THEN
            WRITE (MSGTXT,1001) IRET, JSUB, 'READING DATA'
            GO TO 990
         ELSE IF (IRET.EQ.0) THEN
            VCOUNT = VCOUNT + 1
            IF (MOD(VCOUNT,100000).EQ.0) THEN
               WRITE (MSGTXT,1055) VCOUNT
               CALL MSGWRT (2)
               END IF
C                                       Decode time.
            TIME = RPARM(1+ILOCT)
C                                       Determine FQ ID
            IF (ILOCFQ.GT.-1) LFQID = IROUND (RPARM(1+ILOCFQ))
C                                       Determine subarray
            IF (ILOCB.GE.0) THEN
               BLTEMP = RPARM(1+ILOCB)
               IA1 = BLTEMP / 256. + 0.1
               BLTEMP = BLTEMP - IA1 * 256
               IA2 = BLTEMP + 0.1
               ISUBA = 100.0 * (BLTEMP - IA2) + 1.5
            ELSE
               IA1 = RPARM(1+ILOCA1) + 0.1
               IA2 = RPARM(1+ILOCA2) + 0.1
               ISUBA = RPARM(1+ILOCSA) + 0.1
               END IF
C                                       check time range, etc
            IF ((TIME.GE.STARTD) .AND. (TIME.LE.STOPD+1.16D-4) .AND.
     *         ((ISUBA.LE.0) .OR. (ISUBA.EQ.JSUB)) .AND.
     *         ((FQID.LE.0) .OR. (LFQID.EQ.FQID))) THEN
C                                       get source
               SOUID = 0
               IF (ILOCSU.GT.-1) SOUID = RPARM(1+ILOCSU)
C                                       Clear pending time intervals
               IF (SOUID.NE.OLDSOU(1)) THEN
                  DO 60 LANT = 1,NSTNS
                     IF (TBEG(LANT).GT.-999.0) THEN
                        TIMST = TBEG(LANT)
                        TIMEN = TEND(LANT)
                        CALL FLAGUP (OPCODE, FGLUN, DISK, CNOIN, FGVER,
     *                     FGBUFF, IFGRNO, FGKOLS, FGNUMV, OLDSOU, 1,
     *                     JSUB, FQID, 1, LANT, 0, TIMST, TIMEN, 1, 0,
     *                     1, 0, STOKES, LREAS1, NFL, IRET)
                        IF (IRET.NE.0) GO TO 999
                        TBEG(LANT) = -1000.0
                        FGOPEN = .TRUE.
                        WFLAG = WFLAG + NFL
                        END IF
 60                  CONTINUE
                  DO 65 LANT = 1,NB
                     IF (TBB(LANT).GT.-999.0) THEN
                        TIMST = TBB(LANT)
                        TIMEN = TBE(LANT)
                        LA1 = (LANT-1) / NSTNS + 1
                        LA2 = LANT - NSTNS * (LA1-1)
                        CALL FLAGUP (OPCODE, FGLUN, DISK, CNOIN, FGVER,
     *                     FGBUFF, IFGRNO, FGKOLS, FGNUMV, OLDSOU, 1,
     *                     JSUB, FQID, 1, LA1, LA2, TIMST, TIMEN, 1, 0,
     *                     1, 0, STOKES, LREAS2, NFL, IRET)
                        IF (IRET.NE.0) GO TO 999
                        TBB(LANT) = -1000.0
                        FGOPEN = .TRUE.
                        WFLAG = WFLAG + NFL
                        END IF
 65                  CONTINUE
C                                       Check sources
                  IF (ID(1).GT.0) THEN
                     DO 70 SID = 1,NID
                        IF (SOUID.EQ.ID(SID)) GO TO 75
 70                     CONTINUE
                     GO TO 50
                     END IF
                  END IF
C                                       new time interval
C                                       stuff old into time arrays
 75            IF ((TIME-TIMOLD.GT.TDIF) .OR. (OLDSOU(1).NE.SOUID)) THEN
C                                       pick up the source coordinates
C                                       only when a new source appears
                  CALL FNDCOO (0, JD0, SOUID, DISK, CNOIN, CATBLK,
     *               LUNSS, TIME, DRA, DDEC, PLANET, IRET)
                  IF (IRET.GT.0) GO TO 999
                  OLDSOU(1) = SOUID
                  TIMOLD = TIME
C                                       is this point good or no?
                  CALL ISSHAD (RPARM, JSUB, SHMIN, CTMIN, DRA, DDEC,
     *               ISREF, ANTBAD, BASBAD)
                  DO 80 LANT = 1,NSTNS
C                                       interval bad
                     IF (ANTBAD(LANT)) THEN
                        IF (TBEG(LANT).LT.-999.0) TBEG(LANT) =
     *                     TIMOLD - TINT
                        TEND(LANT) = TIMOLD + TINT
                        ANTBAD(LANT) = .FALSE.
C                                       interval now good, was not
                     ELSE IF (TBEG(LANT).GT.-999.0) THEN
                        TIMST = TBEG(LANT)
                        TIMEN = TEND(LANT)
                        CALL FLAGUP (OPCODE, FGLUN, DISK, CNOIN, FGVER,
     *                     FGBUFF, IFGRNO, FGKOLS, FGNUMV, OLDSOU, 1,
     *                     JSUB, FQID, 1, LANT, 0, TIMST, TIMEN, 1, 0,
     *                     1, 0, STOKES, LREAS1, NFL, IRET)
                        IF (IRET.NE.0) GO TO 999
                        TBEG(LANT) = -1000.0
                        FGOPEN = .TRUE.
                        WFLAG = WFLAG + NFL
                        END IF
 80                  CONTINUE
                  DO 85 LANT = 1,NB
C                                       interval bad
                     IF (BASBAD(LANT)) THEN
                        IF (TBB(LANT).LT.-999.0) TBB(LANT) =
     *                     TIMOLD - TINT
                        TBE(LANT) = TIMOLD + TINT
                        BASBAD(LANT) = .FALSE.
C                                       interval now good, was not
                     ELSE IF (TBB(LANT).GT.-999.0) THEN
                        TIMST = TBB(LANT)
                        TIMEN = TBE(LANT)
                        LA1 = (LANT-1) / NSTNS + 1
                        LA2 = LANT - NSTNS * (LA1-1)
                        CALL FLAGUP (OPCODE, FGLUN, DISK, CNOIN, FGVER,
     *                     FGBUFF, IFGRNO, FGKOLS, FGNUMV, OLDSOU, 1,
     *                     JSUB, FQID, 1, LA1, LA2, TIMST, TIMEN, 1, 0,
     *                     1, 0, STOKES, LREAS2, NFL, IRET)
                        IF (IRET.NE.0) GO TO 999
                        TBB(LANT) = -1000.0
                        FGOPEN = .TRUE.
                        WFLAG = WFLAG + NFL
                        END IF
 85                  CONTINUE
                  END IF
               END IF
            GO TO 50
         ELSE
            CALL CATDIR ('CSTA', DISK, FCNO(1), NAME, CLASS, SEQ, 'UV',
     *         NLUSER, 'READ', BUFF, IRET)
            CALL UVGET ('CLOS', RPARM, BUFF, IRET)
            END IF
C                                       Clear pending time intervals
         DO 110 LANT = 1,NSTNS
            IF (TBEG(LANT).GT.-999.0) THEN
               TIMST = TBEG(LANT)
               TIMEN = TEND(LANT)
               CALL FLAGUP (OPCODE, FGLUN, DISK, CNOIN, FGVER, FGBUFF,
     *            IFGRNO, FGKOLS, FGNUMV, OLDSOU, 1, JSUB, FQID, 1,
     *            LANT, 0, TIMST, TIMEN, 1, 0, 1, 0, STOKES, LREAS1,
     *            NFL, IRET)
               IF (IRET.NE.0) GO TO 999
               TBEG(LANT) = -1000.0
               FGOPEN = .TRUE.
               WFLAG = WFLAG + NFL
               END IF
 110        CONTINUE
         DO 120 LANT = 1,NB
            IF (TBB(LANT).GT.-999.0) THEN
               TIMST = TBB(LANT)
               TIMEN = TBE(LANT)
               LA1 = (LANT-1) / NSTNS + 1
               LA2 = LANT - NSTNS * (LA1-1)
               CALL FLAGUP (OPCODE, FGLUN, DISK, CNOIN, FGVER, FGBUFF,
     *            IFGRNO, FGKOLS, FGNUMV, OLDSOU, 1, JSUB, FQID, 1, LA1,
     *            LA2, TIMST, TIMEN, 1, 0, 1, 0, STOKES, LREAS2, NFL,
     *            IRET)
               IF (IRET.NE.0) GO TO 999
               TBB(LANT) = -1000.0
               FGOPEN = .TRUE.
               WFLAG = WFLAG + NFL
               END IF
 120        CONTINUE
 200     CONTINUE
      CALL CATDIR ('CSTA', DISK, FCNO(1), NAME, CLASS, SEQ, 'UV',
     *   NLUSER, 'WRIT', BUFF, IRET)
      IRET = 0
      GO TO 999
C                                       Error.
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('Begin flagging due to shadowing in subarray',I3)
 1001 FORMAT ('ERROR',I4,' SUBARRAY',I2,' ON ',A)
 1010 FORMAT ('ERROR:',I7,' OPENING UV FILE TO READ')
 1015 FORMAT ('ERROR:',I4,' READING ANTENNA FILE',I4)
 1055 FORMAT ('FLAGSH: at vis record',I10)
      END
      SUBROUTINE SEDSEL (NAME, CLASS, SEQ, DISK, JSUB)
C-----------------------------------------------------------------------
C   puts parameters in DSEL.INC (many conflicts with local common)
C   Inputs:
C      NAME     C*12   File name
C      CLASS    C*6    File class
C      SEQ      I      File seq number
C      DISK     I      File disk number
C      JSUB     I      Subbary
C-----------------------------------------------------------------------
      CHARACTER NAME*12, CLASS*6
      INTEGER   SEQ, DISK, JSUB
C
      INCLUDE 'INCS:DSEL.INC'
C-----------------------------------------------------------------------
C                                       Info for UVGET:
      CALL SELINI
      UNAME = NAME
      UCLAS = CLASS
      UDISK = DISK
      USEQ = SEQ
      SUBARR = JSUB
C
 999  RETURN
      END
      SUBROUTINE ISSHAD (RPARM, ISUB, SHMIN, CTMIN, DRA, DDEC, ISREF,
     *   ANTBAD, BASBAD)
C-----------------------------------------------------------------------
C   Finds shadowed data.  If an antenna is shadowed by any other antenna
C   it is flagged.
C   Inputs:
C      RPARM    R(*)   Random parameters - uses time
C      ISUB     I      Subarray number
C      SHMIN    R      Min baseline allowed shadowing
C      CTMIN    R      Min baseline allowed cross talk
C      DRA      D      Apparent RA
C      DDEC     D      Apparent Dec
C   Outputs:
C      ANTBAD   L(*)   T => antenna shadowed
C      BASBAD   L(*)   T => baseline cross talk
C-----------------------------------------------------------------------
      REAL      RPARM(*), SHMIN, CTMIN
      DOUBLE PRECISION DRA, DDEC
      LOGICAL   ISREF(*), ANTBAD(*), BASBAD(*)
      INTEGER   ISUB
C
      INTEGER   IA1, IA2, LSUB, IBL
      REAL      AZ, EL, HA, LL, MM, H2
      DOUBLE PRECISION X(2), Y(2), Z(2), BX, BY, BZ, B1, B2, GH, UR, VR,
     *   WR, JDREF, GMST, GAST, RATE, HR, GSEC, HTR, ARRLON, XDEC, XRA,
     *   TIME, RR, UM, VM, WM, RM, HM
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:PSTD.INC'
      INCLUDE 'INCS:PUVD.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DANS.INC'
      INCLUDE 'INCS:DANT.INC'
      INCLUDE 'INCS:DSOU.INC'
      INCLUDE 'INCS:DMSG.INC'
      SAVE LSUB, JDREF
      DATA LSUB /-1/
      DATA GSEC /1.0027375D0/
C-----------------------------------------------------------------------
      IF (LSUB.NE.ISUB) THEN
         LSUB = ISUB
         CALL JULDAY (RDATE, JDREF)
         END IF
      HTR = PI / 12.D0
      CALL GSTROT (JDREF, GMST, GAST, RATE)
      GAST = GAST * (24.D0/360.D0)
      GAST = GAST + (((RPARM(1+ILOCT)-(LSUB-1)*5)*24.D0) * GSEC)
      GAST = MOD (GAST, 24.D0)
      CALL LFILL (NSTNS, .FALSE., ANTBAD)
C                                       adjust "source position"
      TIME = RPARM(1+ILOCT)
      IA1 = 1
      CALL SOUELV (IA1, TIME, HA, EL, AZ)
      LL = ASIN (RPARM(1+ILOCU))
      MM = ASIN (RPARM(1+ILOCV))
      EL = EL - MM
C                                       L > 0 lower RA
      AZ = AZ - LL
      CALL ELVSOU (IA1, TIME, EL, AZ, XRA, XDEC, H2)
C                                              Calculate array longitude
C                                              Array BX= ARRAYC(1)
C                                               Array BY= ARRAYC(2)
C                                              Array BZ= ARRAYC(3)
      ARRLON = 0.0D0
      IF ((ABS(ARRAYC(1)).GT.1.D2) .AND. (ABS(ARRAYC(2)).GT.1.D2) .AND.
     *      (ABS(ARRAYC(3)).GT.1.D2))
     *      ARRLON = ATAN2 (ARRAYC(2), ARRAYC(1))
      DO 100 IA1 = 1,NSTNS-1
         X(1) = STNX(IA1)
         Y(1) = STNY(IA1)
         Z(1) = STNZ(IA1)
         DO 90 IA2 = IA1+1,NSTNS
            IBL = (IA1-1) * NSTNS + IA2
            BASBAD(IBL) = .FALSE.
            X(2) = STNX(IA2)
            Y(2) = STNY(IA2)
            Z(2) = STNZ(IA2)
            IF (((X(1).GT.1.D2) .OR. (Y(1).GT.1.0D2) .OR.
     *         (Z(1).GT.1.0D2)) .AND. ((X(2).GT.1.0D2) .OR.
     *         (Y(2).GT.1.0D2) .OR. (Z(2).GT.1.0D2))) THEN
               CALL BASLIN (2, X, Y, Z, CATD(KDCRV+JLOCF), ARRLON,
     *            BX, BY, BZ, B1, B2, GH)
               HM = GAST*HTR - XRA - GH
               UM = B2 * SIN(HM)
               VM = B1 * COS(XDEC) - B2 * SIN(XDEC) * COS(HM)
               WM = B1 * SIN(XDEC) + B2 * COS(XDEC) * COS(HM)
               RM = SQRT (UM*UM + VM*VM)
               HR = GAST*HTR - DRA - GH
               UR = B2 * SIN(HR)
               VR = B1 * COS(DDEC) - B2 * SIN(DDEC) * COS(HR)
               WR = B1 * SIN(DDEC) + B2 * COS(DDEC) * COS(HR)
               RR = SQRT (UR*UR + VR*VR)
C                                       both reference
               IF ((ISREF(IA1)) .AND. (ISREF(IA2))) THEN
                  IF (RR.LT.SHMIN) THEN
                     IF (WR.GT.0.0) THEN
                        ANTBAD(IA2) = .TRUE.
                     ELSE
                        ANTBAD(IA1) = .TRUE.
                        END IF
                  ELSE IF (RR.LT.CTMIN) THEN
                     BASBAD(IBL) = .TRUE.
                     END IF
C                                       both moving
               ELSE IF ((.NOT.ISREF(IA1)) .AND. (.NOT.ISREF(IA2))) THEN
                  IF (RM.LT.SHMIN) THEN
                     IF (WM.GT.0.0) THEN
                        ANTBAD(IA2) = .TRUE.
                     ELSE
                        ANTBAD(IA1) = .TRUE.
                        END IF
                  ELSE IF (RM.LT.CTMIN) THEN
                     BASBAD(IBL) = .TRUE.
                     END IF
C                                       one of each
               ELSE IF ((RR.LT.CTMIN) .OR. (RM.LT.CTMIN)) THEN
                  IF (RM.LT.SHMIN) THEN
                     IF (WM.GT.0.0) THEN
                        IF (.NOT.ISREF(IA2)) ANTBAD(IA2) = .TRUE.
                     ELSE
                        IF (.NOT.ISREF(IA1)) ANTBAD(IA1) = .TRUE.
                        END IF
                     END IF
                  IF (RR.LT.SHMIN) THEN
                     IF (WR.GT.0.0) THEN
                        IF (ISREF(IA2)) ANTBAD(IA2) = .TRUE.
                     ELSE
                        IF (ISREF(IA1)) ANTBAD(IA1) = .TRUE.
                        END IF
                     END IF
                  IF ((.NOT.ANTBAD(IA1)) .AND. (.NOT.ANTBAD(IA2)))
     *               BASBAD(IBL) = .TRUE.
                  END IF
               END IF
 90         CONTINUE
 100     CONTINUE
C
 999  RETURN
      END
