LOCAL INCLUDE 'ALBUS.INC'
C                                       Local include for ALBUS
      INCLUDE 'INCS:ZPBUFSZ.INC'
      INTEGER   STNMAX, HISMAX
      PARAMETER (STNMAX = 500)
      PARAMETER (HISMAX = 4*STNMAX)
C
      HOLLERITH XNAMEI(3), XCLAIN(2), DATOUT(12), XSOUR(4,30), XTECT(1),
     *   XSTATS(2,30), XAVER(1), XPGM(3)
      REAL      XSIN, XDISIN, XGAINV, XGAINU, XANT(50), DODATE, DETIME,
     *   DOBTW, XRAD, DOALL, PRTLEV
      INTEGER   SEQIN, DISKIN, CATOLD(256), CLVIN, CLVOUT, TEVOUT,
     *   CNOIN, JANT(50), JANTS, SCRTCH(512), RADIUS, THEANT, THESRC,
     *   NUMHIS, HISTRT, NUMSTN
      LOGICAL   NEWANT, DOADV
      DOUBLE PRECISION THELON, THELAT
      CHARACTER NAMEIN*12, CLAIN*6, DATDIR*48, SRCS(30)*12, ROOT*256,
     *   CURDIR*256, TECTYP*3, SRCTXT*256, DIRDAT*256, AGSTAT(STNMAX)*4,
     *   THENAM*16, ALBVER*4, PRGT*12, STATNS(30)*4, HISCRD(HISMAX)*64,
     *   AGSTAC(STNMAX)*3, STNTXT*256
      COMMON /INPARM/ XNAMEI, XCLAIN, XSIN, XDISIN, XSOUR, XANT, XGAINV,
     *   XGAINU, DATOUT, DODATE, XTECT, DETIME, DOBTW, XRAD, DOALL,
     *   XSTATS, PRTLEV, XAVER, XPGM
      COMMON /TPARMS/ CATOLD, THELON, THELAT, SCRTCH, SEQIN, DISKIN,
     *   CNOIN, CLVIN, CLVOUT, TEVOUT, JANT, JANTS, RADIUS, THEANT,
     *   THESRC, NUMHIS, NEWANT, HISTRT, NUMSTN, DOADV
      COMMON /CHARPM/ NAMEIN, CLAIN, DATDIR, SRCS, ROOT, CURDIR, SRCTXT,
     *   DIRDAT, AGSTAT, AGSTAC, HISCRD, THENAM, TECTYP, ALBVER, PRGT,
     *   STATNS, STNTXT
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DMSG.INC'
C                                       End local include for ALBUS
LOCAL END
LOCAL INCLUDE 'ALBUSD.INC'
      INTEGER   ANTMAX, SRCMAX
      PARAMETER (ANTMAX=50, SRCMAX=250)
C
      INTEGER   NSORC, NANTS, SRCNUM(SRCMAX), ANTNUM(ANTMAX)
      LOGICAL   ISPLAN(SRCMAX)
      DOUBLE PRECISION SRA(SRCMAX), SDEC(SRCMAX), ANTPOS(3,ANTMAX),
     *   ANTLL(3,ANTMAX)
      REAL      TSTART, TSTOP
      COMMON /DALBUS/ SRA, SDEC, ANTPOS, ANTLL, SRCNUM, ISPLAN, NSORC,
     *   NANTS, TSTART, TSTOP, ANTNUM
      CHARACTER SRCNAM(SRCMAX)*16, CSTART*20, CSTOP*20
      COMMON /CALBUS/ SRCNAM, CSTART, CSTOP
LOCAL END
LOCAL INCLUDE 'RIFRM.INC'
C                                       Local include for RIFRM
      INCLUDE 'INCS:ZPBUFSZ.INC'
      INCLUDE 'INCS:PUVD.INC'
      INTEGER   NTMAX, NSMAX
      PARAMETER (NTMAX=10000)
      PARAMETER (NSMAX=100)
C
      INTEGER   NTIMES, SRCBRK(2,NSMAX), NSRCS, BADIFR, GUDIFR
      LOGICAL   TENEW
      REAL      TIMES(NTMAX), DAZ(NTMAX), DEL(NTMAX), STEC(NTMAX),
     *   VTEC(NTMAX), RMS(NTMAX), TOTRUN, SUMRUN
      COMMON /RIFRMD/ TIMES, DAZ, DEL, STEC, VTEC, RMS, NTIMES, TENEW,
     *   SRCBRK, NSRCS, TOTRUN, SUMRUN, BADIFR, GUDIFR
LOCAL END
      PROGRAM ALBUS
C-----------------------------------------------------------------------
C! Run ALBUS package for DISP and IFR for data set
C# Utility UV UV-util VLA VLB
C-----------------------------------------------------------------------
C;  Copyright (C) 2024-2026
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   ALBUS invokes the ALBUS package to compute ionospheric Faraday
C   rotation and dispersive delay.
C   Inputs:
C      AIPS adverb  Prg. name.          Description.
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      GAINVER        CLVIN         Initial CL table
C      GAINUSE        CLVOUT        Output CL table
C      DATAOUT        DATDIR        Disk area for files
C      DODATE         DODATE        > 0 use dated subdirectory
C      TECRTYPE       TECTYP        'G03' or 4 or 5
C      DETIME         DETIME        Delay allowed in downloading sec
C      DOBTWEEN       DOBTW         # download areas, number parallel
C      RADIUS         XRAD          Radius km to search
C      DOALL          DOALL         >0 all sources in one pass
C-----------------------------------------------------------------------
      CHARACTER PRGM*6, ANTNAM*8
      INTEGER   IRET, IANT, ISRC, NS, KANT, HM(2)
      DOUBLE PRECISION XX, ELEV
      INCLUDE 'ALBUS.INC'
      INCLUDE 'ALBUSD.INC'
      INCLUDE 'RIFRM.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:PSTD.INC'
      INCLUDE 'INCS:DANS.INC'
      DATA PRGM /'ALBUS '/
C-----------------------------------------------------------------------
C                                       Get input parameters
      CALL ALBUSI (PRGM, IRET)
      IF (IRET.NE.0) GO TO 990
      BADIFR = 0
      GUDIFR = 0
      DOADV = .TRUE.
      NUMHIS = 0
C                                       Call routine to do ALBUS
      NS = NSORC
      IF (DOALL.GT.0.0) NS = 1
      IF ((NANTS.GT.0) .AND. (NUMSTN.GT.0)) THEN
         MSGTXT = 'STATIONS NOT ALLOWED FOR MULTIPLE ANTENNAS'
         CALL MSGWRT (7)
         NUMSTN = 0
         END IF
      DO 20 IANT = 1,MAX(1,NANTS)
         THELON = ANTLL(1,IANT)
         THELAT = ANTLL(2,IANT)
         ELEV = ANTLL(3,IANT)
         KANT = ANTNUM(IANT)
         ANTNAM = STNNAM(KANT)
         XX = ABS(THELON) * RAD2DG
         HM(1) = XX
         XX = (XX - HM(1)) * 60.0D0
         HM(2) = XX
         XX = (XX - HM(2)) * 60.0D0
         IF (THELON.LT.0.0D0) HM(1) = -HM(1)
         WRITE (MSGTXT,1000) KANT, ANTNAM, 'Longitude', HM, XX
         IF (NANTS.LE.0) MSGTXT(:6) = 'Array '
         CALL MSGWRT (8)
         XX = ABS(THELAT) * RAD2DG
         HM(1) = XX
         XX = (XX-HM(1)) * 60.0D0
         HM(2) = XX
         XX = (XX-HM(2)) * 60.0D0
         IF (THELAT.LT.0.0D0) HM(1) = -HM(1)
         WRITE (MSGTXT,1000) KANT, ANTNAM, 'Latitude ', HM, XX
         IF (NANTS.LE.0) MSGTXT(:6) = 'Array '
         CALL MSGWRT (8)
         WRITE (MSGTXT,1001) KANT, ANTNAM, 'Elevation', ELEV
         IF (NANTS.LE.0) MSGTXT(:6) = 'Array '
         CALL MSGWRT (8)
         NEWANT = .TRUE.
         HISTRT = NUMHIS+1
         DO 10 ISRC = 1,NS
            CALL ALBUSD (IANT, ISRC, IRET)
            IF (IRET.NE.0) GO TO 990
            NEWANT = .FALSE.
 10         CONTINUE
 20      CONTINUE
C                                       history
      CALL ALBUSH
      WRITE (MSGTXT,1020) BADIFR
      CALL MSGWRT (4)
      WRITE (MSGTXT,1021) GUDIFR
      CALL MSGWRT (4)
C                                       Close down files, etc.
 990  CALL DIE (IRET, SCRTCH)
C
 999  STOP
C-----------------------------------------------------------------------
 1000 FORMAT ('Ant',I3,2X,A,2X,A,I6.2,I3.2,F7.3)
 1001 FORMAT ('Ant',I3,2X,A,2X,A,F9.2)
 1020 FORMAT ('Found',I9,' bad IFR values')
 1021 FORMAT ('Found',I9,' reasonable IFR values')
      END
      SUBROUTINE ALBUSI (PRGN, JERR)
C-----------------------------------------------------------------------
C   ALBUSI gets input parameters for ALBUS and determines source and
C   antenna lists.
C   Inputs:
C      PRGN    C*6  Program name
C   Output:
C      JERR    I    Error code: 0 => ok
C                                5 => catalog troubles
C                                8 => can't start
C   Output in common:
C-----------------------------------------------------------------------
      INTEGER   JERR
      CHARACTER PRGN*6
C
      CHARACTER STAT*4, PTYPE*2, DOB*8, THEDAT*12, MONTH(12)*3
      INTEGER   IROUND, NPARM, IERR, I, J, JTRIM, IT(4), ID(3)
      LOGICAL   T, F
      INCLUDE 'ALBUS.INC'
      INCLUDE 'ALBUSD.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DUVH.INC'
      DATA T, F /.TRUE.,.FALSE./
      DATA MONTH /'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN', 'JUL',
     *   'AUG', 'SEP', 'OCT', 'NOV', 'DEC'/
C-----------------------------------------------------------------------
C                                       Init for AIPS, disks, ...
      CALL ZDCHIN (T)
      CALL VHDRIN
C                                       Initialize /CFILES/
      NSCR = 0
      NCFILE = 0
      JERR = 0
C                                       Get input parameters.
      NPARM = 264
      CALL GTPARM (PRGN, NPARM, RQUICK, XNAMEI, SCRTCH, IERR)
      IF (IERR.NE.0) THEN
         RQUICK = .TRUE.
         JERR = 8
         IF (IERR.EQ.1) GO TO 999
            WRITE (MSGTXT,1000) IERR, 'FINDING INPUT PARAMETERS'
            CALL MSGWRT (8)
         END IF
C                                       Do not restart AIPS
      IF (PRTLEV.LE.1.0) RQUICK = .FALSE.
      IF (RQUICK) CALL RELPOP (IERR, SCRTCH, JERR)
      IF (IERR.NE.0) GO TO 999
      JERR = 5
C                                       Crunch input parameters.
      CALL H2CHR (48, 1, DATOUT, DATDIR)
      CALL H2CHR (12, 1, XNAMEI, NAMEIN)
      CALL H2CHR (6, 1, XCLAIN, CLAIN)
      CALL H2CHR (3, 1, XTECT, TECTYP)
      IF ((TECTYP.NE.'G04') .AND. (TECTYP.NE.'G05') .AND.
     *   (TECTYP.NE.'G03') .AND. (TECTYP.NE.'G02') .AND.
     *   (TECTYP.NE.'G06') .AND. (TECTYP.NE.'G07') .AND.
     *   (TECTYP.NE.'G08') .AND. (TECTYP.NE.'G09') .AND.
     *   (TECTYP.NE.'G00')) TECTYP = 'G01'
      CALL H2CHR (4, 1, XAVER, ALBVER)
      IF (ALBVER.NE.'0.1') ALBVER = '1.0'
      IF (ALBVER.EQ.'0.1') DOALL = -1.0
      CALL H2CHR (12, 1, XPGM, PRGT)
      CALL CHLTOU (12, PRGT)
      SEQIN = IROUND (XSIN)
      DISKIN = IROUND (XDISIN)
      DO 10 I = 1,30
         CALL H2CHR (16, 1, XSOUR(1,I), SRCS(I))
 10      CONTINUE
      JANTS = 0
      DO 15 I = 1,50
         J = XANT(I) + 0.1
         IF (J.GT.0) THEN
            JANTS = JANTS + 1
            JANT(JANTS) = J
            END IF
 15      CONTINUE
      NUMSTN = 21
      DO 20 I = 1,30
         CALL H2CHR (4, 1, XSTATS(1,I), STATNS(I))
         CALL CHUTOL (4, STATNS(I))
         IF (STATNS(I).EQ.' ') NUMSTN = MIN (NUMSTN, I-1)
 20      CONTINUE
      IF (NUMSTN.GT.20) NUMSTN = 0
C                                       Create new file.
C                                       Get CATBLK from old file.
      CNOIN = 1
      PTYPE = 'UV'
      CALL CATDIR ('SRCH', DISKIN, CNOIN, NAMEIN, CLAIN, SEQIN,
     *   PTYPE, NLUSER, STAT, SCRTCH, IERR)
      IF (IERR.NE.0) THEN
         WRITE (MSGTXT,1030) IERR, NAMEIN, CLAIN, SEQIN, DISKIN,
     *      NLUSER
         GO TO 990
         END IF
      CALL CATIO ('READ', DISKIN, CNOIN, CATBLK, 'WRIT', SCRTCH, IERR)
      IF (IERR.NE.0) THEN
         WRITE (MSGTXT,1000) IERR, 'READING DATA HEADER'
         GO TO 990
         END IF
C                                       Save input CATBLK
      CALL COPY (256, CATBLK, CATOLD)
      CALL UVPGET (IERR)
      IF (IERR.NE.0) GO TO 999
      NCFILE = NCFILE + 1
      FVOL(NCFILE) = DISKIN
      FCNO(NCFILE) = CNOIN
      FRW(NCFILE) = 1
C                                       versions
      CALL FNDEXT ('CL', CATBLK, I)
      CLVIN = XGAINV + 0.1
      IF ((CLVIN.LE.0) .OR. (CLVIN.GT.I)) CLVIN = I
      CLVOUT = XGAINU + 0.1
      IF (CLVOUT.NE.CLVIN) CLVOUT = I + 1
      CALL FNDEXT ('TE', CATBLK, I)
      TEVOUT = I + 1
      IF (CLVOUT.EQ.CLVIN) TEVOUT = I
C                                       time range
      CALL UVTIME (DISKIN, CNOIN, CATBLK, TSTART, TSTOP, IERR)
      IF (IERR.NE.0) THEN
         WRITE (MSGTXT,1000) IERR, 'FINDING DATA TIME RANGE'
         GO TO 990
         END IF
      CALL H2CHR (8, 1, CATH(KHDOB), DOB)
      CALL DATEST (DOB, ID)
      TSTART = TSTART - 5./(60.*24.)
      TSTART = MAX (TSTART, 0.0)
      CALL TODHMS (TSTART, IT)
      WRITE (CSTART,1010) ID, IT(2), IT(3), IT(4)
      TSTOP = TSTOP + 5./(60.*24.)
      CALL TODHMS (TSTOP, IT)
      ID(3) = ID(3) + IT(1)
      WRITE (CSTOP,1010) ID, IT(2), IT(3), IT(4)
C                                       source, antenna data
      CALL ANTGET (IERR)
      IF (IERR.NE.0) GO TO 999
      CALL SRCGET (IERR)
      IF (IERR.NE.0) GO TO 999
C                                       ALBUS directory
      I = JTRIM (DATDIR)
      IF (I.LE.0) THEN
         DATDIR = 'HOME:'
         I = 5
         END IF
      IF (DATDIR(I:I).EQ.':') THEN
         I = I - 1
         CALL ZTRLOG (I, DATDIR(:I), 256, ROOT, J, IERR)
         IF (IERR.NE.0) THEN
            WRITE (MSGTXT,1000) IERR, 'TRANSLATING OUTFILE'
            GO TO 990
            END IF
      ELSE
         ROOT = DATDIR
         END IF
      I = JTRIM (ROOT)
      IF (ROOT(I:I).NE.'/') ROOT(I+1:) = '/'
      IF (DODATE.GT.0.0) THEN
         CALL ZDATE (ID)
         CALL ZTIME (IT)
         ID(1) = MOD (ID(1), 100)
         WRITE (THEDAT,1040) ID(3), MONTH(ID(2)), ID(1), IT(1), IT(2)
         I = JTRIM (ROOT)
         ROOT(I+1:) = THEDAT
         END IF
      CALL ZTRLOG (3, 'PWD', 256, CURDIR, J, IERR)
      IF (IERR.NE.0) THEN
         WRITE (MSGTXT,1000) IERR, 'TRANSLATING PWD'
         CALL MSGWRT (8)
         END IF
      I = JTRIM (CURDIR)
      IF (CURDIR(I:I).NE.'/') CURDIR(I+1:) = '/'
      JERR = 0
      GO TO 999
C
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('ALBUSI: ERROR',I3,' ON ',A)
 1010 FORMAT (I4.4,'/',I2.2,'/',I2.2,I3.2,':',I2.2,':',I2.2)
 1030 FORMAT ('ERROR',I3,' FINDING ',A12,'.',A6,'.',I4,' DISK=',
     *   I3,' USID=',I5)
 1040 FORMAT (I2.2,A,3I2.2,'/')
      END
      SUBROUTINE ANTGET (IRET)
C-----------------------------------------------------------------------
C   Determines antenna average location or list of VLB antennas
C   Output
C      IRET   I   Error code
C-----------------------------------------------------------------------
      INTEGER   IRET
C
      INCLUDE 'ALBUS.INC'
      INCLUDE 'ALBUSD.INC'
      INTEGER   I, J, ANBUFF(512), ISUBA
      INCLUDE 'INCS:PUVD.INC'
      INCLUDE 'INCS:DANS.INC'
      INCLUDE 'INCS:DANT.INC'
C-----------------------------------------------------------------------
      CALL GETANT (DISKIN, CNOIN, ISUBA, CATBLK, ANBUFF, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'READING ANTENNA FILE'
         GO TO 990
         END IF
      IF (ANAME.EQ.'VLBA') THEN
         IF (JANTS.EQ.0) THEN
            NANTS = NSTNS
            IF (NANTS.GT.ANTMAX) THEN
               MSGTXT = 'TOO MANY ANTENNAS'
               GO TO 980
               END IF
            DO 20 I = 1,NANTS
               ANTNUM(I) = I
               ANTPOS(1,I) = STNX(I)
               ANTPOS(2,I) = STNY(I)
               ANTPOS(3,I) = STNZ(I)
               ANTLL(1,I) = STNLON(I)
               ANTLL(2,I) = STNLAT(I)
               ANTLL(3,I) = STELEV(I)
 20         CONTINUE
         ELSE
            NANTS = 0
            DO 30 I = 1,NSTNS
               DO 25 J = 1,JANTS
                  IF (JANT(J).EQ.TELNO(I)) THEN
                     NANTS = NANTS + 1
                     ANTNUM(NANTS) = TELNO(I)
                     ANTPOS(1,NANTS) = STNX(I)
                     ANTPOS(2,NANTS) = STNY(I)
                     ANTPOS(3,NANTS) = STNZ(I)
                     ANTLL(1,NANTS) = STNLON(I)
                     ANTLL(2,NANTS) = STNLAT(I)
                     ANTLL(3,NANTS) = STELEV(I)
                     GO TO 30
                     END IF
 25               CONTINUE
 30            CONTINUE
            END IF
      ELSE
         JANTS = 0
         ANTPOS(1,1) = 0.0D0
         ANTPOS(2,1) = 0.0D0
         ANTPOS(3,1) = 0.0D0
         ANTLL(1,1) = 0.0D0
         ANTLL(2,1) = 0.0D0
         ANTLL(3,1) = 0.0D0
         J = 0
         NANTS = 0
         ANTNUM(1) = 1
         STNNAM(1) = ANAME
         DO 40 I = 1,NSTNS
            IF ((ABS(STNX(I)).GT.1.D3) .OR. (ABS(STNY(I)).GT.1.D3)) THEN
               J = J + 1
               ANTPOS(1,1) = ANTPOS(1,1) + STNX(I)
               ANTPOS(2,1) = ANTPOS(2,1) + STNY(I)
               ANTPOS(3,1) = ANTPOS(3,1) + STNZ(I)
               ANTLL(1,1) = ANTLL(1,1) + STNLON(I)
               ANTLL(2,1) = ANTLL(2,1) + STNLAT(I)
               ANTLL(3,1) = ANTLL(3,1) + STELEV(I)
               END IF
 40         CONTINUE
         IF (J.LE.0) THEN
            MSGTXT = 'NO VALID ANTENNAS FOUND'
            GO TO 980
            END IF
         ANTPOS(1,1) = ANTPOS(1,1) / J
         ANTPOS(2,1) = ANTPOS(2,1) / J
         ANTPOS(3,1) = ANTPOS(3,1) / J
         ANTLL(1,1) = ANTLL(1,1) / J
         ANTLL(2,1) = ANTLL(2,1) / J
         ANTLL(3,1) = ANTLL(3,1) / J
         END IF
      GO TO 999
C
 980  IRET = 10
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('ANTGET ERROR',I4,' ON ',A)
      END
      SUBROUTINE SRCGET (IRET)
C-----------------------------------------------------------------------
C   Determines source list
C   Output
C      IRET   I   Error code
C-----------------------------------------------------------------------
      INTEGER   IRET
C
      INCLUDE 'ALBUS.INC'
      INCLUDE 'ALBUSD.INC'
      INCLUDE 'INCS:PUVD.INC'
      INCLUDE 'INCS:DPOV.INC'
      INTEGER   I, J, NS, TABUFF(512), VER, LUN, LUNTMP, NUMIF, ISURNO,
     *   SUKOLS(MAXSUC), SUNUMV(MAXSUC), FREQID, NREC, IDSOU, QUAL, K,
     *   TABVER, IPORNO, POKOLS(MAXPOC), PONUMV(MAXPOC), NP, PLS(20),
     *   JTRIM
      CHARACTER VELTYP*8, VELDEF*8, SOUNAM*16, CALCOD*8, OBSDAT*8
      REAL      FLUX(4,MAXIF)
      DOUBLE PRECISION FREQO(MAXIF), BANDW, RAEPO, DECEPO, EPOCH, RAAPP,
     *   DECAPP, RAOBS, DECOBS, LSRVEL(MAXIF), LRESTF(MAXIF), PMRA,
     *   PMDEC, SOUDST, TIME
C-----------------------------------------------------------------------
C                                       how many sources specified
      NS = 0
      DO 10 I = 1,30
         IF (SRCS(I).EQ.' ') GO TO 20
         NS = NS + 1
 10      CONTINUE
C                                       open source table
 20   LUN = LUNTMP (1)
      VER = 1
      CALL SOUINI ('READ', TABUFF, DISKIN, CNOIN, VER, CATBLK, LUN,
     *   NUMIF, VELTYP, VELDEF, FREQID, ISURNO, SUKOLS, SUNUMV, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'OPENING SOURCE TABLE'
         GO TO 990
         END IF
C                                       read source table
      NREC = TABUFF(5)
      NSORC = 0
      DO 50 I = 1,NREC
         ISURNO = I
         CALL TABSOU ('READ', TABUFF, ISURNO, SUKOLS, SUNUMV, IDSOU,
     *      SOUNAM, QUAL, CALCOD, FLUX, FREQO, BANDW, RAEPO, DECEPO,
     *      EPOCH, RAAPP, DECAPP, RAOBS, DECOBS, LSRVEL, LRESTF, PMRA,
     *      PMDEC, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'READING SOURCE TABLE'
            GO TO 990
            END IF
C                                       in list?
         IF (NS.GT.0) THEN
            DO 30 J = 1,NS
               IF (SOUNAM.EQ.SRCS(J)) GO TO 40
 30            CONTINUE
            GO TO 50
            END IF
 40      IF (NSORC.GE.SRCMAX) THEN
            WRITE (MSGTXT,1040) SRCMAX
            CALL MSGWRT (8)
            GO TO 55
            END IF
         NSORC = NSORC + 1
         SRCNUM(NSORC) = IDSOU
         SRA(NSORC) = RAAPP
         SDEC(NSORC) = DECAPP
         K = JTRIM (SOUNAM)
         DO 45 J = 1,K
            IF (SOUNAM(J:J).EQ.' ') SOUNAM(J:J) = '_'
 45         CONTINUE
         SRCNAM(NSORC) = SOUNAM
 50      CONTINUE
C                                       close source table
 55   CALL TABSOU ('CLOS', TABUFF, ISURNO, SUKOLS, SUNUMV, IDSOU,
     *   SOUNAM, QUAL, CALCOD, FLUX, FREQO, BANDW, RAEPO, DECEPO,
     *   EPOCH, RAAPP, DECAPP, RAOBS, DECOBS, LSRVEL, LRESTF, PMRA,
     *   PMDEC, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'CLOSING SOURCE TABLE'
         GO TO 990
         END IF
      IF (NSORC.LE.0) THEN
         IRET = 10
         MSGTXT = 'NO SOURCES FOUND'
         GO TO 990
         END IF
C                                       planets??
      CALL LFILL (NSORC, .FALSE., ISPLAN)
      CALL FNDEXT ('PO', CATBLK, I)
      IF (I.GT.0) THEN
         CALL POINI ('READ', TABUFF, DISKIN, CNOIN, VER, CATBLK, LUN,
     *      IPORNO, POKOLS, PONUMV, OBSDAT, TABVER, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'OPENING THE PO TABLE'
            GO TO 990
            END IF
         NP = 0
         NREC = TABUFF(5)
         DO 70 I = 1,NREC
            IPORNO = I
            CALL TABPO ('READ', TABUFF, IPORNO, POKOLS, PONUMV, TIME,
     *         IDSOU, RAAPP, DECAPP, SOUDST, IRET)
            IF (IRET.NE.0) THEN
               WRITE (MSGTXT,1000) IRET, 'READING PO TABLE'
               GO TO 990
               END IF
            DO 60 J = 1,NP
               IF (IDSOU.EQ.PLS(J)) GO TO 70
 60            CONTINUE
            NP = NP + 1
            PLS(NP) = IDSOU
 70         CONTINUE
         CALL TABPO ('CLOS', TABUFF, IPORNO, POKOLS, PONUMV, TIME,
     *      IDSOU, RAAPP, DECAPP, SOUDST, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'CLOSING PO TABLE'
            GO TO 990
            END IF
C                                       put in list
         DO 80 I = 1,NP
            DO 75 J = 1,NSORC
               IF (PLS(I).EQ.SRCNUM(J)) THEN
                  ISPLAN(J) = .TRUE.
                  IF (DOALL.GT.0.0) THEN
                     MSGTXT = 'DOALL SET TO 0 BECAUSE OF A PLANET'
                     CALL MSGWRT (7)
                     DOALL = 0.0
                     END IF
                  END IF
 75            CONTINUE
 80         CONTINUE
         END IF
      GO TO 999
C
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('SRCGET ERROR',I4,' ON ',A)
 1040 FORMAT ('SRCGET SOURCE LIST TERMINATED AFTER',I4,' SOURCES')
      END
      SUBROUTINE ALBUSD (IANT, ISRC, IRET)
C-----------------------------------------------------------------------
C   ALBUSD writes the python and shell scripts to text files.  It then
C   executes the ALBUS program in a container.  It then reads the ALBUS
C   output file and causes the CL and TE tables to be updated.
C   Inputs:
C      IANT   I   Antenna number
C      ISRC   I   Source number in source lists
C   Output
C      IRET   I   Error code
C-----------------------------------------------------------------------
      INTEGER   IANT, ISRC, IRET
C
      INCLUDE 'ALBUS.INC'
      INCLUDE 'ALBUSD.INC'
      INCLUDE 'RIFRM.INC'
      INCLUDE 'INCS:DANS.INC'
      INTEGER   TLUN, TIND, I, J, JTRIM, HM(2), KANT, K, DHM(2)
      REAL      SEC, DSEC
      LOGICAL   FIRST, DODIR, DOAPP
      CHARACTER FNAME*256, OUTLIN*512, ENAME*256, CHM*1, COMMND*256,
     *   SYSOUT*64, OUTCOM*512, ANTC*3, DIROLD*256, SCR*500
      SAVE FIRST, DIROLD, DOAPP
      DATA FIRST, DOAPP /2*.TRUE./
      DATA TLUN /3/
      DATA DIROLD /' '/
C-----------------------------------------------------------------------
      IF (FIRST) SUMRUN = 0.0
      IF ((ABS(ANTPOS(1,IANT)).LT.1.D3) .OR.
     *   (ABS(ANTPOS(2,IANT)).LT.1.D3) .OR.
     *   (ABS(ANTPOS(3,IANT)).LT.1.D3)) THEN
         WRITE (MSGTXT,1001) IANT
         IRET = 0
         GO TO 990
         END IF
      THENAM = SRCNAM(ISRC)
      THESRC = SRCNUM(ISRC)
C                                       make output dir
      IF ((DODATE.GT.0.0) .AND. (DODATE.LT.2.0)) THEN
         J = JTRIM (ROOT)
         COMMND = 'mkdir ' // ROOT(:J)
         J = J + 6
         I = 0
         SYSOUT = ' '
         CALL ZSHCMD (J, COMMND, I, SYSOUT, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'EXECUTING MKDIR FOR DODATE>0'
            GO TO 990
            END IF
         DODATE = 3.0
         END IF
C                                       store adverbs
      IF (DOADV) THEN
         CALL ADVERB (IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'WRITING ADVERB FILE'
            GO TO 990
            END IF
         DOADV = .FALSE.
         END IF
C                                       DOALL - write source list
      IF (DOALL.GT.0.0) THEN
         J = JTRIM (ROOT)
         SRCTXT = ROOT(:J) // 'source_list.txt'
         MSGSUP = 32000
         CALL ZTXZAP (TLUN, SRCTXT, IRET)
         IRET = 0
         MSGSUP = 0
         CALL ZTXOPN ('WRIT', TLUN, TIND, SRCTXT, .FALSE., IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'CREATING SOURCE LIST FILE'
            GO TO 990
            END IF
         DO 20 I = 1,NSORC
            CALL COORDD (1, SRA(I), CHM, HM, SEC)
            CALL COORDD (2, SDEC(I), CHM, DHM, DSEC)
            J = JTRIM (SRCNAM(I))
            WRITE (OUTLIN,1020) HM, SEC, CHM, DHM, DSEC,
     *         SRCNAM(I)(:J)
            J = JTRIM (OUTLIN)
            CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
            IF (IRET.NE.0) THEN
               WRITE (MSGTXT,1000) IRET, 'WRITING SOURCE LIST FILE'
               GO TO 990
               END IF
 20         CONTINUE
         CALL ZTXCLS (TLUN, TIND, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'CLOSING SOURCE LIST FILE'
            GO TO 990
            END IF
         THENAM = 'Allsource'
         THESRC = 0
         END IF
C                                       DOALL - write station list
      IF (NUMSTN.GT.0.0) THEN
         J = JTRIM (ROOT)
         STNTXT = ROOT(:J) // 'list_station.txt'
         MSGSUP = 32000
         CALL ZTXZAP (TLUN, STNTXT, IRET)
         IRET = 0
         MSGSUP = 0
         CALL ZTXOPN ('WRIT', TLUN, TIND, STNTXT, .FALSE., IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'CREATING STATION LIST FILE'
            GO TO 990
            END IF
         WRITE (OUTLIN,1030) (STATNS(I), I=1,NUMSTN)
         WRITE (SCR,1031) (STATNS(I), I=1,NUMSTN)
         J = JTRIM (SCR)
         SCR(J-1:) = ']'
         J = JTRIM (OUTLIN)
         OUTLIN(J:) = ' '
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'WRITING STATION LIST FILE'
            GO TO 990
            END IF
         CALL ZTXCLS (TLUN, TIND, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'CLOSING STATION LIST FILE'
            GO TO 990
            END IF
         END IF
C                                       processing message
      J = JTRIM (SRCNAM(ISRC))
      KANT = ANTNUM(IANT)
      IF (DOALL.GT.0.0) THEN
         IF (NANTS.EQ.0) THEN
            MSGTXT = 'Processing all sources all antennas'
            ANTC = ' '
         ELSE
            WRITE (MSGTXT,1004) KANT, STNNAM(KANT)
            WRITE (ANTC,1007) KANT
            END IF
      ELSE IF (NANTS.EQ.0) THEN
         WRITE (MSGTXT,1005) SRCNUM(ISRC), SRCNAM(ISRC)(:J)
         ANTC = ' '
      ELSE
         WRITE (MSGTXT,1006) SRCNUM(ISRC), SRCNAM(ISRC)(:J), KANT,
     *      STNNAM(KANT)
         WRITE (ANTC,1007) KANT
         END IF
      CALL MSGWRT (4)
      IF ((CLVIN.EQ.CLVOUT) .AND. (TEVOUT.GT.0)) FIRST = .FALSE.
C                                       output file name
C                                       remove old versions if any
      J = JTRIM (ROOT)
      IF (DOBTW.LE.0.0) THEN
         FNAME = ROOT(:J) // 'albus_report_parallel_RI_' // TECTYP //
     *      '_' // THENAM
      ELSE
         FNAME = ROOT(:J) // 'albus_report_serial_RI_' // TECTYP //
     *      '_' // THENAM
         END IF
      MSGSUP = 32000
      CALL ZTXZAP (TLUN, FNAME, IRET)
      IF (NANTS.LT.1) THEN
         WRITE (FNAME,1010) ROOT(:J), THESRC
      ELSE
         WRITE (FNAME,1011) ROOT(:J), THESRC, KANT
         END IF
      CALL ZTXZAP (TLUN, FNAME, IRET)
      IRET = 0
      MSGSUP = 0
C                                       python file open
      CALL ZTXOPN ('WRIT', TLUN, TIND, FNAME, .FALSE., IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'CREATING PYTHON OUTPUT FILE'
         GO TO 990
         END IF
      OUTLIN = 'import os'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      OUTLIN = 'import time'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      OUTLIN = 'import MS_Iono_functions as iono'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      OUTLIN = 'import math'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      OUTLIN = 'import numpy as np'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      OUTLIN = 'import Albus_RINEX'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
C                                       station file proc
      IF (NUMSTN.GT.0) THEN
         OUTLIN = 'def read_stations_from_csv(filepath):'
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 980
         OUTLIN = '  try:'
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 980
         OUTLIN = '    with open(filepath, ''r'') as f:'
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 980
         OUTLIN = '      # Read the first line, strip whitespace, and'
     *      // ' split by the comma ('','')'
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 980
         OUTLIN = '      first_line = f.readline().strip()'
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 980
         OUTLIN = '      if first_line:'
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 980
         OUTLIN = '        gps_station_list = [station.strip() for'
     *      // ' station in first_line.split('','')]'
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 980
         OUTLIN = '        return gps_station_list'
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 980
         OUTLIN = '      else:'
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 980
         OUTLIN = '        return[]'
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 980
         OUTLIN = '  except FileNotFoundError:'
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 980
         OUTLIN = '    print(f"Error: File not found at {filepath}")'
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 980
         OUTLIN = '    return[]'
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 980
         END IF
      OUTLIN = 'if __name__ == "__main__":'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      OUTLIN = '  os.system(''date'')'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      OUTLIN = '  process_start = time.time()'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      OUTLIN = '  startime = time.strftime("%a, %d %b %Y %H:%M:%S",' //
     *   ' time.localtime())'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      OUTLIN = '  print("program start at %s" % startime)'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      WRITE (OUTLIN,2000) (ANTPOS(I,IANT), I = 1,3)
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      IF (DOALL.LE.0.0) THEN
         CALL COORDD (1, SRA(ISRC), CHM, HM, SEC)
         WRITE (OUTLIN,2010) 'RA', ' ', HM, SEC
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 980
         CALL COORDD (2, SDEC(ISRC), CHM, HM, SEC)
         WRITE (OUTLIN,2010) 'DEC', CHM, HM, SEC
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 980
         END IF
      OUTLIN = '  START_TIME="' // CSTART // '"'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      OUTLIN = '  END_TIME="' // CSTOP // '"'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      J = JTRIM (ROOT)
      OUTlIN = '  OUTPUT_DIR="' // ROOT(:J) // '"'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      J = JTRIM (ROOT)
      IF (DOBTW.LE.0.0) THEN
         IF (NANTS.LE.0) THEN
            WRITE (MSGTXT,2005) SRCNUM(ISRC), 0
         ELSE
            WRITE (MSGTXT,2005) SRCNUM(ISRC), KANT
            END IF
      ELSE
         IF (NANTS.LE.0) THEN
            WRITE (MSGTXT,2005) 0
         ELSE
            WRITE (MSGTXT,2005) KANT
            END IF
         END IF
      K = JTRIM(MSGTXT)
      DIRDAT = ROOT(:J) // MSGTXT(:K)
      DODIR = DIRDAT.NE.DIROLD
      DIROLD = DIRDAT
      OUTlIN = '  DATA_DIR="' // DIRDAT(:K+J) // '"'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      OUTLIN = '  RED_TYPE = ''RI_' // TECTYP // ''''
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      OUTLIN = '  TIME_STEP = 300'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      IF (PRTLEV.GT.2.0) THEN
         OUTLIN = '  iono.set_debug_option(True)'
      ELSE
         OUTLIN = '  iono.set_debug_option(False)'
         END IF
      J = JTRIM (OUTLIN)
c      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      IF ((XRAD.GT.50.) .AND. (XRAD.LT.1000.1)) THEN
         RADIUS = XRAD + 0.5
         WRITE (OUTLIN,2015) RADIUS
      ELSE IF (STNNAM(KANT).EQ.'OV') THEN
         OUTLIN = '  MAX_DIST = 150E3'
         RADIUS = 150
      ELSE
         OUTLIN = '  MAX_DIST = 300E3'
         RADIUS = 300
         END IF
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      IF (ABS(DOBTW).GE.10.0) THEN
         OUTLIN = '  NUM_PROCESSORS = 1'
      ELSE
         OUTLIN = '  NUM_PROCESSORS = 36'
         END IF
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      IF (DOBTW.GT.0.0) THEN
         OUTLIN = '  DO_SER = 1'
      ELSE
         OUTLIN = '  DO_SER = 0'
         END IF
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      IF ((DETIME.LT.100.) .OR. (DETIME.GT.600.)) DETIME = 250.
      K = DETIME
      WRITE (OUTLIN,2020) K
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      J = JTRIM (THENAM)
      OUTLIN = '  OBJECT="' // THENAM(:J) // '"'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      IF (DOALL.GT.0.0) THEN
         J = JTRIM (SRCTXT)
         OUTLIN = '  positions_file = "' // SRCTXT(:J) // '"'
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 980
         OUTLIN = '  positions_ascii = np.loadtxt(positions_file, ' //
     *      'delimiter='','', dtype=str)'
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 980
         OUTLIN = '  print(''positions ascii'', positions_ascii)'
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 980
         END IF
      IF (NUMSTN.GT.0) THEN
         OUTLIN = '  GPS_FILE_PATH = ''list_station.txt'''
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 980
         OUTLIN = '  GPS_STATION_LIST = read_stations_from_csv' //
     *      '(GPS_FILE_PATH)'
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 980
      END IF
      J = JTRIM (SCR)
      IF ((NUMSTN.GT.0) .AND. (DOALL.GT.0.0)) THEN
         OUTCOM = '  iono.process_ionosphere_multi_dir(' //
     *      'time_step=TIME_STEP,telescope_pos=stn,end_time=END_TIME,'
     *      // 'start_time=START_TIME,max_dist=MAX_DIST,' //
     *      'processing_option=RED_TYPE,num_processors=NUM_PROCESSORS,'
     *      // 'gps_data_directory=DATA_DIR,do_serial=DO_SER,'
     *      // 'output_data_directory=OUTPUT_DIR,' //
     *      'positions_file=positions_ascii,object=OBJECT,'
     *      // 'station_list=' // SCR(:J) // ')'
C     *      // 'station_list=GPS_STATION_LIST)'
      ELSE IF (NUMSTN.GT.0) THEN
         OUTCOM = '  iono.process_ionosphere(' //
     *      'time_step=TIME_STEP,telescope_pos=stn,end_time=END_TIME,'
     *      // 'start_time=START_TIME,max_dist=MAX_DIST,' //
     *      'processing_option=RED_TYPE,num_processors=NUM_PROCESSORS,'
     *      // 'gps_data_directory=DATA_DIR,do_serial=DO_SER,'
     *      // 'output_data_directory=OUTPUT_DIR,' //
     *     'object=OBJECT,Ra=RA,Dec=DEC,'
     *      // 'station_list=' // SCR(:J) // ')'
c     *      // 'GPS_STATION_LIST=' // SCR(:J) // ')'
C    *      'gps_station_list=GPS_STATION_LIST)'
      ELSE IF (DOALL.GT.0.0) THEN
         OUTCOM = '  iono.process_ionosphere_multi_dir(' //
     *      'time_step=TIME_STEP,telescope_pos=stn,end_time=END_TIME,'
     *      // 'start_time=START_TIME,max_dist=MAX_DIST,' //
     *      'processing_option=RED_TYPE,num_processors=NUM_PROCESSORS,'
     *      // 'gps_data_directory=DATA_DIR,do_serial=DO_SER,'
     *      // 'output_data_directory=OUTPUT_DIR,' //
     *      'positions_file=positions_ascii,object=OBJECT)'
      ELSE IF (ISPLAN(ISRC)) THEN
         J = JTRIM (SRCNAM(ISRC))
         OUTCOM = '  iono.process_ionosphere(time_step=TIME_STEP,' //
     *      'object=OBJECT,telescope_pos=stn,start_time=START_TIME,'//
     *      'end_time=END_TIME,max_dist=MAX_DIST,' //
     *      'special_body="' // SRCNAM(ISRC)(:J) // '",' //
     *      'processing_option=RED_TYPE,num_processors=NUM_PROCESSORS,'
     *      // 'gps_data_directory=DATA_DIR,do_serial=DO_SER,'
     *      // 'output_data_directory=OUTPUT_DIR)'
      ELSE
         OUTCOM = '  iono.process_ionosphere(time_step=TIME_STEP,' //
     *      'object=OBJECT,Ra=RA,Dec=DEC,telescope_pos=stn,start_time'//
     *      '=START_TIME,end_time=END_TIME,max_dist=MAX_DIST,' //
     *      'processing_option=RED_TYPE,num_processors=NUM_PROCESSORS,'
     *      // 'gps_data_directory=DATA_DIR,do_serial=DO_SER,'
     *      // 'output_data_directory=OUTPUT_DIR)'
         END IF
      J = JTRIM (OUTCOM)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTCOM(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      OUTLIN = '  os.system(''date'')'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      OUTLIN = '  endtime = time.strftime("%a, %d %b %Y %H:%M:%S"' //
     *   ', time.localtime())'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      OUTLIN = '  print("program end at %s" % endtime)'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      OUTLIN = '  print ('' '')'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      OUTLIN = '  process_end = time.time()'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      OUTLIN = '  duration = (process_end - process_start)/60.0'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      OUTLIN = '  print("program total run time: %7.2f minutes"' //
     *   ' % duration);'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
      OUTLIN = ' '
      J = 4
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 980
C                                       quit
      CALL ZTXCLS (TLUN, TIND, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'CLOSING PYTHON FILE'
         GO TO 990
         END IF
C                                       executable file
      J = JTRIM (ROOT)
      ENAME = ROOT(:J) // 'doit'
      MSGSUP = 32000
      CALL ZTXZAP (TLUN, ENAME, IRET)
      IRET = 0
      MSGSUP = 0
      CALL ZTXOPN ('WRIT', TLUN, TIND, ENAME, .FALSE., IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'CREATING EXECUTABLE FILE'
         GO TO 990
         END IF
      OUTLIN = 'export APPTAINER_BIND="' // ROOT(:J) // '"'
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 985
      IF (DOAPP) THEN
         OUTLIN = 'echo $APPTAINER_BIND'
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 985
         DOAPP = .FALSE.
         END IF
      OUTLIN = 'chmod +x ' // FNAME
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 985
      OUTLIN = 'cat ' // FNAME
      IF (PRTLEV.GT.1.0) THEN
         J = JTRIM (ROOT)
         K = JTRIM (OUTLIN)
         OUTLIN(K+1:) = ' >> ' // ROOT(:J) // 'msg.txt 2>&1'
         END IF
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 985
      IF (DODIR) THEN
         J = JTRIM (DIRDAT)
         OUTLIN = '"/bin/rm" -rf ' // DIRDAT(:J) // '/'
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 985
         END IF
      IF (PRGT.EQ.'SINGULARITY') THEN
         IF (ALBVER.EQ.'0.1') THEN
            OUTLIN = 'singularity exec $LOAD/contain_albus_0.1.sif '
     *         // 'python ' // FNAME
         ELSE
            OUTLIN = 'singularity exec $LOAD/contain_albus.sif python '
     *         // FNAME
            END IF
      ELSE
         IF (ALBVER.EQ.'0.1') THEN
            OUTLIN = 'apptainer exec $LOAD/contain_albus_0.1.sif python'
     *         // ' ' // FNAME
         ELSE
            OUTLIN = 'apptainer exec $LOAD/contain_albus.sif python ' //
     *         FNAME
            END IF
         END IF
      IF (PRTLEV.GT.1.0) THEN
         J = JTRIM (ROOT)
         K = JTRIM (OUTLIN)
         OUTLIN(K+1:) = ' >> ' // ROOT(:J) // 'msg.txt 2>&1'
         END IF
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 985
      IF (ANTC.NE.' ') THEN
         J = JTRIM (ROOT)
         K = JTRIM (THENAM)
         IF (DOBTW.LE.0.0) THEN
            OUTLIN = ROOT(:J) // 'albus_report_parallel_RI_' // TECTYP
     *         // '_' // THENAM(:K)
            FNAME = ROOT(:J) // 'albus_report_parallel_RI_' // TECTYP
     *         // '_' // THENAM(:K) // ANTC
         ELSE
            OUTLIN = ROOT(:J) // 'albus_report_serial_RI_' // TECTYP
     *         // '_' // THENAM(:K)
            FNAME = ROOT(:J) // 'albus_report_serial_RI_' // TECTYP
     *         // '_' // THENAM(:K) // ANTC
            END IF
         J = JTRIM (OUTLIN)
         OUTCOM = '"/bin/mv" ' // OUTLIN(:J+1) // FNAME
         J = JTRIM (OUTCOM)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTCOM(:J), IRET)
         IF (IRET.NE.0) GO TO 985
         END IF
      CALL ZTXCLS (TLUN, TIND, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'CLOSING PYTHON FILE'
         GO TO 990
         END IF
      COMMND = 'chmod +x ' // ENAME
      J = JTRIM (COMMND)
      MSGTXT = 'Doing command;'
      CALL MSGWRT (2)
      MSGTXT = COMMND(:MIN(80,J))
      CALL MSGWRT (2)
      I = 0
      SYSOUT = ' '
      CALL ZSHCMD (J, COMMND, I, SYSOUT, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'EXECUTING chmod +x doit'
         GO TO 990
         END IF
      COMMND = ENAME
      J = JTRIM (COMMND)
      MSGTXT = 'Doing command;'
      CALL MSGWRT (2)
      MSGTXT = COMMND(:MIN(80,J))
      CALL MSGWRT (2)
      I = 0
      SYSOUT = ' '
      CALL ZSHCMD (J, COMMND, I, SYSOUT, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'EXECUTING PYTHON SCRIPT'
         GO TO 990
         END IF
C                                       CL TE file update
      THEANT = 0
      IF (NANTS.GT.0) THEANT = KANT
      J = JTRIM (ROOT)
      K = JTRIM (THENAM)
C                                       ????
      IF (DOBTW.LE.0.0) THEN
         FNAME = ROOT(:J) // 'albus_report_parallel_RI_' // TECTYP //
     *      '_' // THENAM(:K) // ANTC
      ELSE
         FNAME = ROOT(:J) // 'albus_report_serial_RI_' // TECTYP //
     *      '_' // THENAM(:K) // ANTC
         END IF
      IF (FIRST) THEN
         TENEW = .TRUE.
         CALL RIFRMA (DISKIN, CNOIN, THESRC, THEANT, TEVOUT, CLVIN,
     *      CLVOUT, FNAME, TECTYP, IRET)
         FIRST = .FALSE.
         TENEW = .FALSE.
      ELSE
         CALL RIFRMO (DISKIN, CNOIN, THESRC, THEANT, TEVOUT, CLVOUT,
     *      FNAME, TECTYP, IRET)
         END IF
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'UPDATING CL AND TE TABLES'
         GO TO 990
         END IF
      GO TO 999
C
 980  WRITE (MSGTXT,1000) IRET, 'WRITING PYTHON FILE'
      GO TO 990
C
 985  WRITE (MSGTXT,1000) IRET, 'WRITING EXECUTABLE FILE'
C
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('ALBUSD ERROR',I4,' ON ',A)
 1001 FORMAT ('SKIPPING ANTENNA',I3,' POSITION NEAR 0')
 1004 FORMAT ('Processing all sources, antenna',I3,1X,A)
 1005 FORMAT ('Processing source',I3,1X,A,'    all antennas')
 1006 FORMAT ('Processing source',I3,1X,A,' antenna',I3,1X,A)
 1007 FORMAT ('_',I2.2)
 1010 FORMAT (A,'ALBSRC',I3.3,'dat.py')
 1011 FORMAT (A,'ALBSRC',I3.3,'ANT',I2.2,'dat.py')
 1020 FORMAT (2(I2.2,':'),F8.5,',',A,2(I2.2,':'),F8.5,',',A,',')
 1030 FORMAT (20(A4,','))
 1031 FORMAT ('[',20('''',A4,''','))
 2000 FORMAT ('  stn=np.array([[',F12.3,',',F12.3,',',F12.3,
     *   ']])')
 2005 FORMAT ('ALBUSdata',2I2.2)
 2010 FORMAT ('  ',A,' = "',A,I2.2,':',I2.2,':',F8.5,'"')
 2015 FORMAT ('  MAX_DIST = ',I4,'E3')
 2020 FORMAT ('  Albus_RINEX.DEFAULT_TIMEOUT=',I5)
      END
      SUBROUTINE ADVERB (IRET)
C-----------------------------------------------------------------------
C   Writes out text file with adverb values
C   Output
C      IRET   I   error code
C-----------------------------------------------------------------------
      INTEGER   IRET
C
      INCLUDE 'ALBUS.INC'
      INCLUDE 'ALBUSD.INC'
      CHARACTER OUTLIN*80
      INTEGER   TLUN, TIND, JTRIM, J, I
      INCLUDE 'INCS:DMSG.INC'
      DATA TLUN /11/
C-----------------------------------------------------------------------
      J = JTRIM (ROOT)
      SRCTXT = ROOT(:J) // 'albus.inputs.txt'
      MSGSUP = 32000
      CALL ZTXZAP (TLUN, SRCTXT, IRET)
      IRET = 0
      MSGSUP = 0
      CALL ZTXOPN ('WRIT', TLUN, TIND, SRCTXT, .FALSE., IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'CREATING ADVERB LIST FILE'
         GO TO 980
         END IF
      J = JTRIM (NAMEIN)
      OUTLIN = 'INNAME = ''' // NAMEIN(:J) // ''''
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 900
      J = JTRIM (CLAIN)
      OUTLIN = 'INCLASS = ''' // CLAIN(:J) // ''''
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 900
      WRITE (OUTLIN,2000) 'INSEQ', SEQIN
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 900
      WRITE (OUTLIN,2000) 'INDISK', DISKIN
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 900
      DO 20 I = 1,NSORC
         J = JTRIM (SRCNAM(I))
         WRITE (OUTLIN,2010) 'SOURCES', I, SRCNAM(I)(:J)
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 900
 20      CONTINUE
      DO 30 I = 1,NANTS
         WRITE (OUTLIN,2011) 'ANTENNAS', I, ANTNUM(I)
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 900
 30      CONTINUE
      WRITE (OUTLIN,2000) 'GAINVER', CLVIN
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 900
      WRITE (OUTLIN,2000) 'GAINUSE', CLVOUT
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 900
      J = JTRIM (DATDIR)
      OUTLIN = 'DATAOUT = ''' // DATDIR(:J) // ''''
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 900
      WRITE (OUTLIN,2001) 'DODATE', DODATE
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 900
      OUTLIN = 'TECRTYPE = ''' // TECTYP // ''''
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 900
      WRITE (OUTLIN,2001) 'DETIME', DETIME
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 900
      WRITE (OUTLIN,2001) 'DOBTWEEN', DOBTW
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 900
      WRITE (OUTLIN,2001) 'RADIUS', XRAD
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 900
      WRITE (OUTLIN,2001) 'DOALL', DOALL
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.NE.0) GO TO 900
      DO 40 I = 1,MAX(1,NUMSTN)
         WRITE (OUTLIN,2012) 'STATIONS', I, STATNS(I)
         J = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
         IF (IRET.NE.0) GO TO 900
 40      CONTINUE
      WRITE (OUTLIN,2020) 'AVERSION', ALBVER
      J = JTRIM (OUTLIN)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:J), IRET)
      IF (IRET.EQ.0) GO TO 990
C
 900  WRITE (MSGTXT,1000) IRET, 'WRITING INPUTS LIST FILE'
 980  CALL MSGWRT (8)
C
 990  CALL ZTXCLS (TLUN, TIND, I)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('ADVERB: ERROR',I4,' ON ',A)
 2000 FORMAT (A,' =',I6)
 2001 FORMAT (A,' =',F7.1)
 2010 FORMAT (A,'(',I3.3,') = ',A)
 2011 FORMAT (A,'(',I3.3,') =',I4)
 2012 FORMAT (A,'(',I2.2,') = ''',A4,'''')
 2020 FORMAT (A,' = ''',A4,'''')
      END
      SUBROUTINE STATID (IRET)
C-----------------------------------------------------------------------
C   Adds station ID to text file with adverb values
C   Output
C      IRET   I   error code
C-----------------------------------------------------------------------
      INTEGER   IRET
C
      INCLUDE 'ALBUS.INC'
      INCLUDE 'ALBUSD.INC'
      CHARACTER OUTLIN*80, TEST*4
      LOGICAL   DONEG
      INTEGER   TLUN, TIND, JTRIM, J, I, LUN, FIND, KBP, KBPLIM, NS, K
      DOUBLE PRECISION XX, LONG, LAT, ST, CT, YY, ZZ
      REAL      AGDIST(STNMAX), MDIST, AGP(2,STNMAX)
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:PUVD.INC'
      INCLUDE 'INCS:DANS.INC'
      INCLUDE 'INCS:PSTD.INC'
      DATA LUN, TLUN /3, 11/
C-----------------------------------------------------------------------
      CALL RFILL (STNMAX, 9999.0, AGDIST)
C                                       count stations used
      NS = 0
      DO 10 I = 1,STNMAX
         IF (AGSTAT(I).EQ.' ') GO TO 15
         NS = I
 10      CONTINUE
C
C                                       open files
 15   J = JTRIM (ROOT)
      OUTLIN = ROOT(:J) // 'albus.inputs.txt'
      CALL ZTXOPN ('WRIT', TLUN, TIND, OUTLIN, .TRUE., IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'ADDING TO ADVERB LIST FILE'
         GO TO 980
         END IF
      OUTLIN = 'AIPSIONS:ALBUS.stations'
      CALL ZTXOPN ('READ', LUN, FIND, OUTLIN, .FALSE., IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'OPENING ALBUS STATIONS LIST FILE'
         GO TO 980
         END IF
C                                       header
      IF (THEANT.GT.0) THEN
         IF (THESRC.GT.0) THEN
            J = JTRIM (THENAM)
            WRITE (MSGTXT,1015) THENAM(:J), THEANT, STNNAM(THEANT)
         ELSE
            WRITE (MSGTXT,1016) THEANT, STNNAM(THEANT)
            END IF
         IF (NUMHIS.LT.HISMAX) THEN
            NUMHIS = NUMHIS + 1
            HISCRD(NUMHIS) = MSGTXT(:64)
            END IF
      ELSE
         MSGTXT =  'Finding stations for whole array for source ' //
     *      THENAM
         END IF
      CALL MSGWRT (3)
      J = JTRIM (MSGTXT)
      CALL ZTXIO ('WRIT', TLUN, TIND, MSGTXT(:J), IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET,
     *      'WRITING ALBUS STATIONS TO ADVERB FILE'
         GO TO 980
         END IF
      IF (NEWANT) THEN
         J = 0
 20      K = J + 1
         J = MIN (K+7, NS)
         WRITE (MSGTXT,1020) (AGSTAT(I), I = K,J)
         IF (NUMHIS.LT.HISMAX) THEN
            NUMHIS = NUMHIS + 1
            HISCRD(NUMHIS) = MSGTXT(:64)
            END IF
         IF (J.LT.NS) GO TO 20
         END IF
C                                       read precursor part
 25   CALL ZTXIO ('READ', LUN, FIND, OUTLIN, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'READING ALBUS STATIONS LIST START'
         GO TO 980
         END IF
      IF (OUTLIN(:8).NE.'+SITE/ID') GO TO 25
C                                       read data part
 30   CALL ZTXIO ('READ', LUN, FIND, OUTLIN, IRET)
      IF (IRET.EQ.2) THEN
         IRET = 0
         GO TO 900
      ELSE IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'READING ALBUS STATIONS LIST DATA'
         GO TO 980
         END IF
      IF (OUTLIN(:1).EQ.'#') GO TO 30
      KBPLIM = JTRIM (OUTLIN)
      IF (KBPLIM.LT.70) GO TO 30
      IF (OUTLIN(:8).EQ.'-SITE/ID') GO TO 900
      TEST = OUTLIN(2:5)
      DO 35 I = 1,NS
         IF (TEST.EQ.AGSTAT(I)) GO TO 50
 35      CONTINUE
      GO TO 30
C                                       Got one!
 50   IF (OUTLIN(58:58).EQ.'-') THEN
         DONEG = .TRUE.
         OUTLIN(58:58) = ' '
      ELSE
         DONEG = .FALSE.
         END IF
      KBP = 44
      CALL GETNUM (OUTLIN, KBPLIM, KBP, XX)
      IF (XX.EQ.DBLANK) GO TO 30
      LONG = XX
      CALL GETNUM (OUTLIN, KBPLIM, KBP, XX)
      IF (XX.EQ.DBLANK) GO TO 30
      LONG = LONG + XX/60.0D0
      CALL GETNUM (OUTLIN, KBPLIM, KBP, XX)
      IF (XX.EQ.DBLANK) GO TO 30
      LONG = LONG + XX/3600.0D0
      CALL GETNUM (OUTLIN, KBPLIM, KBP, XX)
      IF (XX.EQ.DBLANK) GO TO 30
      LAT = ABS(XX)
      CALL GETNUM (OUTLIN, KBPLIM, KBP, XX)
      IF (XX.EQ.DBLANK) GO TO 30
      LAT = LAT + ABS(XX)/60.0D0
      CALL GETNUM (OUTLIN, KBPLIM, KBP, XX)
      IF (XX.EQ.DBLANK) GO TO 30
      LAT = LAT + ABS(XX)/3600.0D0
      LONG = LONG * DG2RAD
      LAT = LAT * DG2RAD
      IF (DONEG) LAT = -LAT
      XX = 1.0D0 - COS(LAT-THELAT) +
     *   COS(LAT) * COS(THELAT) * (1.D0 - COS(LONG-THELON))
      XX = SQRT (MAX (0.0D0, XX/2.D0))
      XX = 2.D0 * 6378.D0 * XX
      YY = SIN((THELAT-LAT)/2.0D0)**2 +
     *   COS(THELAT)*COS(LAT)*(SIN((LONG-THELON)/2.D0)**2)
      YY = 2.0D0 * ATAN2 (SQRT(YY), SQRT(1.D0-YY)) * 6378.D0
      ZZ = SIN(LAT)*SIN(THELAT) + COS(LAT)*COS(THELAT)*COS(LONG-THELON)
      ZZ = ACOS(ZZ)
      ZZ = 40075 * ZZ / TWOPI
      AGDIST(I) = (XX + YY + ZZ) / 3.0D0
C
      XX = SIN(LAT)*SIN(THELAT) + COS(LAT)*COS(THELAT)*COS(LONG-THELON)
      XX = MAX (-1.0D0, MIN (1.0D0, XX))
      XX = ACOS (XX)
      ST = SIN(THELON-LONG) * COS (THELAT) / SIN (XX)
      ST = MAX (-1.0D0, MIN (1.0D0, ST))
      CT = (SIN(THELAT)*COS(LAT)-COS(THELAT)*SIN(LAT)*COS(THELON-LONG))
     *    / SIN(XX)
      ST = RAD2DG * ATAN2 (ST, CT) + 180.0
      IF (ST.GT.180.) ST = ST - 360.
      AGP(1,I) = 6378.0D0 * XX
      AGP(2,I) = ST
      KBPLIM= MIN (79, KBPLIM)
      MSGTXT = OUTLIN(2:7) // OUTLIN(22:43) // OUTLIN(44:KBPLIM)
      IF (.NOT.NEWANT) THEN
         DO 60 J = HISTRT,NUMHIS
            IF (MSGTXT(:4).EQ.HISCRD(J)(:4)) GO TO 30
 60         CONTINUE
         END IF
      IF (NUMHIS.LT.HISMAX) THEN
         NUMHIS = NUMHIS + 1
         HISCRD(NUMHIS) = MSGTXT(:64)
         END IF
      CALL MSGWRT(3)
      CALL ZTXIO ('WRIT', TLUN, TIND, OUTLIN(:KBPLIM), IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET,
     *      'WRITING ALBUS STATIONS TO ADVERB FILE'
         GO TO 980
         END IF
      GO TO 30
C                                       sort/print distances
 900  MDIST = 7000.
      J = 0
      DO 910 I = 1,NS
         IF (AGDIST(I).LT.MDIST) THEN
            MDIST = AGDIST(I)
            J = I
            END IF
 910     CONTINUE
      IF (J.GT.0) THEN
         WRITE (MSGTXT,1910) AGSTAT(J), AGSTAC(J), AGP(1,J), AGP(2,J)
         AGDIST(J) = 100000.
         IF (.NOT.NEWANT) THEN
            DO 920 I = HISTRT,NUMHIS
               IF (AGSTAT(J).EQ.HISCRD(I)(33:36)) GO TO 900
 920           CONTINUE
            END IF
         IF (NUMHIS.LT.HISMAX) THEN
            NUMHIS = NUMHIS + 1
            HISCRD(NUMHIS) = MSGTXT(:64)
            END IF
         CALL MSGWRT (3)
         J = JTRIM (MSGTXT)
         CALL ZTXIO ('WRIT', TLUN, TIND, MSGTXT(:J), IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET,
     *         'WRITING ALBUS STATIONS TO ADVERB FILE'
            GO TO 980
            END IF
         GO TO 900
         END IF
      DO 940 I = 1,NS
         IF (AGDIST(I).EQ.9999.0) THEN
            WRITE (MSGTXT,1920) AGSTAT(I)
            IF (.NOT.NEWANT) THEN
               DO 930 J = HISTRT,NUMHIS
                  IF (AGSTAT(I).EQ.HISCRD(J)(33:36)) GO TO 940
 930              CONTINUE
               END IF
            IF (NUMHIS.LT.HISMAX) THEN
               NUMHIS = NUMHIS + 1
               HISCRD(NUMHIS) = MSGTXT(:64)
               END IF
            CALL MSGWRT (3)
            J = JTRIM (MSGTXT)
            CALL ZTXIO ('WRIT', TLUN, TIND, MSGTXT(:J), IRET)
            IF (IRET.NE.0) THEN
               WRITE (MSGTXT,1000) IRET,
     *            'WRITING ALBUS STATIONS TO ADVERB FILE'
               GO TO 980
               END IF
            END IF
 940     CONTINUE
      GO TO 990
C
 980  CALL MSGWRT (8)
C
 990  CALL ZTXCLS (TLUN, TIND, I)
      CALL ZTXCLS (LUN, FIND, I)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('STATID: ERROR',I4,' ON ',A)
 1015 FORMAT ('Finding stations for source ',A,' antenna',I3,1X,A)
 1016 FORMAT ('Finding stations for all sources, antenna',I3,1X,A)
 1020 FORMAT ('Stations used',8(2X,A))
 1910 FORMAT ('Approximate distance to station ',A,1X,A,F8.1,
     *   ' km at az',F7.0)
 1920 FORMAT ('Approximate distance to station ',A,' UNKNOWN')
      END
      SUBROUTINE RIFRMA (DISKIN, CNOIN, THESRC, THEANT, TEVOUT, CLVIN,
     *   CLVOUT, INFILE, TECTYP, IRET)
C-----------------------------------------------------------------------
C   Reads the input text file(s), copies the CL & TE table
C   Inputs:
C      DISKIN   I       Data set disk
C      CNOIN    I       Data set catalog number
C      THESRC   I       Data set source number
C      THEANT   I       Data set antenna number, 0 -> all
C      TEVOUT   I       Data set TE version number
C      CLVIN    I       Data set CL input version number
C      CLVOUT   I       Data set CL output version number
C      INFILE   C*(*)   ALBUS output data file
C   Output:
C      IRET   I    Return code, 0 => OK, otherwise abort.
C-----------------------------------------------------------------------
      INTEGER   DISKIN, CNOIN, THESRC, THEANT, TEVOUT, CLVIN, CLVOUT,
     *   IRET
      CHARACTER INFILE*(*), TECTYP*3
C
      INCLUDE 'RIFRM.INC'
      INTEGER   INBUFF(512), OUBUFF(512), LUNI, LUNO, ICLRNO, NUMANT,
     *   CLKOLS(MAXCLC), CLNUMV(MAXCLC), NUMPOL, NUMIF, NTERM, SOURID,
     *   ANTNO, SUBA, FREQID, REFA(2,MAXIF), NREC, I, ITERNO, TUNO,
     *   TEKOLS(16), TENUMV(16), OUTUFF(512)
      REAL      GMMOD, TIMEI, IFR, DOPOFF(MAXIF), ATMOS, DATMOS,
     *   MBDELY(2), CLOCK(2), DCLOCK(2), DISP(2), DDISP(2),
     *   CREAL(2,MAXIF), CIMAG(2,MAXIF), DELAY(2,MAXIF), RATE(2,MAXIF),
     *   WEIGHT(2,MAXIF), TEDATA(16)
      DOUBLE PRECISION TIME, GEODLY(MAXIF)
      CHARACTER  RDATE*8, TECRTY*8
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DDCH.INC'
      DATA LUNI, LUNO, TUNO /16, 17, 19/
C-----------------------------------------------------------------------
      CALL RIFRMG (INFILE, IRET)
      IF (IRET.NE.0) GO TO 999
      TECRTY = 'ALBUS' // TECTYP
      CALL H2CHR (8, 1, CATH(KHDOB), RDATE)
C                                       Output new TE table
      CALL TEINI ('WRIT', OUTUFF, DISKIN, CNOIN, TEVOUT, CATBLK, TUNO,
     *   ITERNO, TEKOLS, TENUMV, RDATE, TECRTY, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'OPENING NEW OUTPUT TE TABLE'
         GO TO 990
         END IF
C                                       input CL table
      CALL CALINI ('READ', INBUFF, DISKIN, CNOIN, CLVIN, CATBLK, LUNI,
     *   ICLRNO, CLKOLS, CLNUMV, NUMANT, NUMPOL, NUMIF, NTERM, GMMOD,
     *   IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'OPENING INPUT CL TABLE'
         GO TO 990
         END IF
C                                       Output CL table
      CALL CALINI ('WRIT', OUBUFF, DISKIN, CNOIN, CLVOUT, CATBLK, LUNO,
     *   ICLRNO, CLKOLS, CLNUMV, NUMANT, NUMPOL, NUMIF, NTERM, GMMOD,
     *   IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'OPENING OUTPUT CL TABLE'
         GO TO 990
         END IF
C                                       read loop
      NREC = INBUFF(5)
      DO 20 I = 1,NREC
         ICLRNO = I
         CALL TABCAL ('READ', INBUFF, ICLRNO, CLKOLS, CLNUMV, NUMPOL,
     *      NUMIF, TIME, TIMEI, SOURID, ANTNO, SUBA, FREQID, IFR,
     *      GEODLY, DOPOFF, ATMOS, DATMOS, MBDELY, CLOCK, DCLOCK, DISP,
     *      DDISP, CREAL, CIMAG, DELAY, RATE, WEIGHT, REFA, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'READING INPUT CL TABLE'
            GO TO 990
            END IF
C                                      get new IFR
         IF (((THEANT.EQ.0) .OR. (THEANT.EQ.ANTNO)) .AND.
     *      ((THESRC.EQ.0) .OR. (SOURID.EQ.THESRC))) THEN
            CALL IFRGET (TIME, THESRC, SOURID, IFR, DISP, TEDATA)
            IF (IFR.EQ.FBLANK) BADIFR = BADIFR + 1
            IF (IFR.NE.FBLANK) GUDIFR = GUDIFR + 1
            END IF
         ICLRNO = I
         CALL TABCAL ('WRIT', OUBUFF, ICLRNO, CLKOLS, CLNUMV, NUMPOL,
     *      NUMIF, TIME, TIMEI, SOURID, ANTNO, SUBA, FREQID, IFR,
     *      GEODLY, DOPOFF, ATMOS, DATMOS, MBDELY, CLOCK, DCLOCK, DISP,
     *      DDISP, CREAL, CIMAG, DELAY, RATE, WEIGHT, REFA, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'WRITING OUTPUT CL TABLE'
            GO TO 990
            END IF
         ITERNO = I
         CALL TABTE ('WRIT', OUTUFF, ITERNO, TEKOLS, TENUMV, TIME,
     *      SOURID, ANTNO, TEDATA(1), TEDATA(2), TEDATA(3), TEDATA(4),
     *      TEDATA(5), TEDATA(6), TEDATA(7), TEDATA(8), TEDATA(11),
     *      TEDATA(12), TEDATA(13), TEDATA(14), TEDATA(15), IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'WRITING OUTPUT TE TABLE'
            GO TO 990
            END IF
 20      CONTINUE
C                                       close
      ICLRNO = NREC
      CALL TABCAL ('CLOS', OUBUFF, ICLRNO, CLKOLS, CLNUMV, NUMPOL,
     *   NUMIF, TIME, TIMEI, SOURID, ANTNO, SUBA, FREQID, IFR,
     *   GEODLY, DOPOFF, ATMOS, DATMOS, MBDELY, CLOCK, DCLOCK, DISP,
     *   DDISP, CREAL, CIMAG, DELAY, RATE, WEIGHT, REFA, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'CLOSING OUTPUT CL TABLE'
         GO TO 990
         END IF
      ICLRNO = NREC
      CALL TABCAL ('CLOS', INBUFF, ICLRNO, CLKOLS, CLNUMV, NUMPOL,
     *   NUMIF, TIME, TIMEI, SOURID, ANTNO, SUBA, FREQID, IFR,
     *   GEODLY, DOPOFF, ATMOS, DATMOS, MBDELY, CLOCK, DCLOCK, DISP,
     *   DDISP, CREAL, CIMAG, DELAY, RATE, WEIGHT, REFA, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'CLOSING INPUT CL TABLE'
         GO TO 990
         END IF
      CALL TABTE ('CLOS', OUTUFF, ITERNO, TEKOLS, TENUMV, TIME,
     *   SOURID, ANTNO, TEDATA(1), TEDATA(2), TEDATA(3), TEDATA(4),
     *   TEDATA(5), TEDATA(6), TEDATA(7), TEDATA(8), TEDATA(11),
     *   TEDATA(12), TEDATA(13), TEDATA(14), TEDATA(15), IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'CLOSING OUTPUT TE TABLE'
         GO TO 990
         END IF
      GO TO 999
C                                       Error
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('RIFMRA: ERROR',I4,' ON ',A)
      END
      SUBROUTINE RIFRMO (DISKIN, CNOIN, THESRC, THEANT, TEVOUT, CLVER,
     *   INFILE, TECTYP, IRET)
C-----------------------------------------------------------------------
C   Reads the input text file(s), copies the CL & TE table
C   TE file exists, CL version in same as out
C   Inputs:
C      DISKIN   I       Data set disk
C      CNOIN    I       Data set catalog number
C      THESRC   I       Data set source number
C      THEANT   I       Data set antenna number, 0 -> all
C      TEVOUT   I       Data set TE version number
C      CLVIN    I       Data set CL input version number
C      CLVOUT   I       Data set CL output version number
C      INFILE   C*(*)   ALBUS output data file
C   Output:
C      IRET   I    Return code, 0 => OK, otherwise abort.
C-----------------------------------------------------------------------
      INTEGER   DISKIN, CNOIN, THESRC, THEANT, TEVOUT, CLVER, IRET
      CHARACTER INFILE*(*), TECTYP*3
C
      INCLUDE 'RIFRM.INC'
      INTEGER   INBUFF(512), OUBUFF(512), LUNI, LUNO, ICLRNO, NUMANT,
     *   CLKOLS(MAXCLC), CLNUMV(MAXCLC), NUMPOL, NUMIF, NTERM, SOURID,
     *   ANTNO, SUBA, FREQID, REFA(2,MAXIF), NREC, I, ITERNO, TUNO,
     *   TEKOLS(16), TENUMV(16), OUTUFF(512), TUNI, INTUFF(512)
      REAL      GMMOD, TIMEI, IFR, DOPOFF(MAXIF), ATMOS, DATMOS,
     *   MBDELY(2), CLOCK(2), DCLOCK(2), DISP(2), DDISP(2),
     *   CREAL(2,MAXIF), CIMAG(2,MAXIF), DELAY(2,MAXIF), RATE(2,MAXIF),
     *   WEIGHT(2,MAXIF), TEDATA(16)
      DOUBLE PRECISION TIME, GEODLY(MAXIF)
      CHARACTER  RDATE*8, TECRTY*8
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DMSG.INC'
      DATA LUNI, LUNO, TUNI, TUNO /16, 17, 18, 19/
C-----------------------------------------------------------------------
      CALL RIFRMG (INFILE, IRET)
      IF (IRET.NE.0) GO TO 999
C                                       input CL table
      CALL CALINI ('READ', INBUFF, DISKIN, CNOIN, CLVER, CATBLK, LUNI,
     *   ICLRNO, CLKOLS, CLNUMV, NUMANT, NUMPOL, NUMIF, NTERM, GMMOD,
     *   IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'OPENING CL TABLE AS INPUT'
         GO TO 990
         END IF
C                                       Output CL table
      CALL CALINI ('WRIT', OUBUFF, DISKIN, CNOIN, CLVER, CATBLK, LUNO,
     *   ICLRNO, CLKOLS, CLNUMV, NUMANT, NUMPOL, NUMIF, NTERM, GMMOD,
     *   IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'OPENING CL TABLE AS OUTPUT'
         GO TO 990
         END IF
C                                       read loop
      NREC = INBUFF(5)
      DO 20 I = 1,NREC
         ICLRNO = I
         CALL TABCAL ('READ', INBUFF, ICLRNO, CLKOLS, CLNUMV, NUMPOL,
     *      NUMIF, TIME, TIMEI, SOURID, ANTNO, SUBA, FREQID, IFR,
     *      GEODLY, DOPOFF, ATMOS, DATMOS, MBDELY, CLOCK, DCLOCK, DISP,
     *      DDISP, CREAL, CIMAG, DELAY, RATE, WEIGHT, REFA, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'READING INPUT CL TABLE'
            GO TO 990
            END IF
C                                       get new IFR
         IF (((THEANT.EQ.0) .OR. (THEANT.EQ.ANTNO)) .AND.
     *      ((THESRC.EQ.0) .OR. (SOURID.EQ.THESRC))) THEN
            CALL IFRGET (TIME, THESRC, SOURID, IFR, DISP, TEDATA)
            IF (IFR.EQ.FBLANK) BADIFR = BADIFR + 1
            IF (IFR.NE.FBLANK) GUDIFR = GUDIFR + 1
            END IF
         ICLRNO = I
         CALL TABCAL ('WRIT', OUBUFF, ICLRNO, CLKOLS, CLNUMV, NUMPOL,
     *      NUMIF, TIME, TIMEI, SOURID, ANTNO, SUBA, FREQID, IFR,
     *      GEODLY, DOPOFF, ATMOS, DATMOS, MBDELY, CLOCK, DCLOCK, DISP,
     *      DDISP, CREAL, CIMAG, DELAY, RATE, WEIGHT, REFA, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'WRITING OUTPUT CL TABLE'
            GO TO 990
            END IF
 20      CONTINUE
C                                       close
      ICLRNO = NREC
      CALL TABCAL ('CLOS', OUBUFF, ICLRNO, CLKOLS, CLNUMV, NUMPOL,
     *   NUMIF, TIME, TIMEI, SOURID, ANTNO, SUBA, FREQID, IFR,
     *   GEODLY, DOPOFF, ATMOS, DATMOS, MBDELY, CLOCK, DCLOCK, DISP,
     *   DDISP, CREAL, CIMAG, DELAY, RATE, WEIGHT, REFA, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'CLOSING OUTPUT CL TABLE'
         GO TO 990
         END IF
      ICLRNO = NREC
      CALL TABCAL ('CLOS', INBUFF, ICLRNO, CLKOLS, CLNUMV, NUMPOL,
     *   NUMIF, TIME, TIMEI, SOURID, ANTNO, SUBA, FREQID, IFR,
     *   GEODLY, DOPOFF, ATMOS, DATMOS, MBDELY, CLOCK, DCLOCK, DISP,
     *   DDISP, CREAL, CIMAG, DELAY, RATE, WEIGHT, REFA, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'CLOSING INPUT CL TABLE'
         GO TO 990
         END IF
C                                       Input TE table
      CALL TEINI ('READ', INTUFF, DISKIN, CNOIN, TEVOUT, CATBLK, TUNI,
     *   ITERNO, TEKOLS, TENUMV, RDATE, TECRTY, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'OPENING TE TABLE AS INPUT'
         GO TO 990
         END IF
C                                       Output same TE table
      TECRTY = 'ALBUS' // TECTYP
      CALL TEINI ('WRIT', OUTUFF, DISKIN, CNOIN, TEVOUT, CATBLK, TUNO,
     *   ITERNO, TEKOLS, TENUMV, RDATE, TECRTY, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'OPENING TE TABLE AS OUTPUT'
         GO TO 990
         END IF
      NREC = INTUFF(5)
      DO 120 I = 1,NREC
         ITERNO = I
         CALL TABTE ('READ', INTUFF, ITERNO, TEKOLS, TENUMV, TIME,
     *      SOURID, ANTNO, TEDATA(1), TEDATA(2), TEDATA(3), TEDATA(4),
     *      TEDATA(5), TEDATA(6), TEDATA(7), TEDATA(8), TEDATA(11),
     *      TEDATA(12), TEDATA(13), TEDATA(14), TEDATA(15), IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'READING TE TABLE'
            GO TO 990
            END IF
C                                       get new IFR
         IF (((THEANT.EQ.0) .OR. (THEANT.EQ.ANTNO)) .AND.
     *      ((THESRC.EQ.0) .OR. (SOURID.EQ.THESRC))) THEN
            CALL IFRGET (TIME, THESRC, SOURID, IFR, DISP, TEDATA)
            IF (IFR.EQ.FBLANK) BADIFR = BADIFR + 1
            IF (IFR.NE.FBLANK) GUDIFR = GUDIFR + 1
            END IF
         ITERNO = I
         CALL TABTE ('WRIT', OUTUFF, ITERNO, TEKOLS, TENUMV, TIME,
     *      SOURID, ANTNO, TEDATA(1), TEDATA(2), TEDATA(3), TEDATA(4),
     *      TEDATA(5), TEDATA(6), TEDATA(7), TEDATA(8), TEDATA(11),
     *      TEDATA(12), TEDATA(13), TEDATA(14), TEDATA(15), IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'WRITING TE TABLE'
            GO TO 990
            END IF
 120     CONTINUE
      CALL TABTE ('CLOS', INTUFF, ITERNO, TEKOLS, TENUMV, TIME,
     *   SOURID, ANTNO, TEDATA(1), TEDATA(2), TEDATA(3), TEDATA(4),
     *   TEDATA(5), TEDATA(6), TEDATA(7), TEDATA(8), TEDATA(11),
     *   TEDATA(12), TEDATA(13), TEDATA(14), TEDATA(15), IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'CLOSING INPUT TE TABLE'
         GO TO 990
         END IF
      CALL TABTE ('CLOS', OUTUFF, ITERNO, TEKOLS, TENUMV, TIME,
     *   SOURID, ANTNO, TEDATA(1), TEDATA(2), TEDATA(3), TEDATA(4),
     *   TEDATA(5), TEDATA(6), TEDATA(7), TEDATA(8), TEDATA(11),
     *   TEDATA(12), TEDATA(13), TEDATA(14), TEDATA(15), IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'CLOSING OUTPUT TE TABLE'
         GO TO 990
         END IF
      GO TO 999
C                                       Error
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('RIFMRO: ERROR',I4,' ON ',A)
      END
      SUBROUTINE RIFRMG (INFILE, IRET)
C-----------------------------------------------------------------------
C   Read the ALBUS report and good_station files
C   Input
C      INFILE  C*(*)   ALBUS text file
C   Output
C      IRET   I   Error code
C-----------------------------------------------------------------------
      INTEGER   IRET
      CHARACTER INFILE*(*)
C
      INTEGER   LUN, FIND, I, J, JTRIM, KBPLIM, KBP, NBAD, IY, IM, ID,
     *   LD(3)
      DOUBLE PRECISION XX, T0
      CHARACTER INLINE*256, DOB*8, STRING*16
      INCLUDE 'ALBUS.INC'
      INCLUDE 'ALBUSD.INC'
      INCLUDE 'RIFRM.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DCAT.INC'
      DATA LUN /3/
C-----------------------------------------------------------------------
C                                       Open first file
      I = 1
      CALL ZTXOPN ('READ', LUN, FIND, INFILE, .FALSE., IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'OPEN ALBUS OUTPUT TEXT FILE'
         GO TO 990
         END IF
      NTIMES = 0
      NBAD = 0
      NSRCS = 0
      CALL FILL (2*NSMAX, 0, SRCBRK)
C                                       skip head except ref time
 10   CALL ZTXIO ('READ', LUN, FIND, INLINE, IRET)
      IF (IRET.EQ.0) THEN
         KBPLIM = JTRIM (INLINE)
         IF ((KBPLIM.LE.0) .OR. (INLINE(:1).EQ.'#')) GO TO 10
         IF (INLINE(:9).EQ.'reference') THEN
            J = INDEX (INLINE, ',sec')
            IF (J.GT.0) THEN
               KBP = J + 4
               CALL GETNUM (INLINE, KBPLIM, KBP, XX)
               IF (XX.EQ.DBLANK) GO TO 10
               IY = XX + 0.01D0
               CALL GETNUM (INLINE, KBPLIM, KBP, XX)
               IF (XX.EQ.DBLANK) GO TO 10
               IM = XX + 0.01D0
               CALL GETNUM (INLINE, KBPLIM, KBP, XX)
               IF (XX.EQ.DBLANK) GO TO 10
               ID = XX + 0.01D0
               CALL GETNUM (INLINE, KBPLIM, KBP, XX)
               IF (XX.EQ.DBLANK) GO TO 10
               T0 = XX
               CALL GETNUM (INLINE, KBPLIM, KBP, XX)
               IF (XX.EQ.DBLANK) GO TO 10
               T0 = T0 + XX/60.0D0
               CALL GETNUM (INLINE, KBPLIM, KBP, XX)
               IF (XX.EQ.DBLANK) GO TO 10
               T0 = T0 + XX/3600.0D0
               T0 = T0 / 24.0
               END IF
            END IF
         IF ((INLINE(:12).EQ.'observation:') .OR.
     *      (INLINE(:9).EQ.'Observing')) THEN
            CALL LASTRN (INLINE, STRING)
            DO 15 I = 1,NSORC
               IF (STRING.EQ.SRCNAM(I)) THEN
                  IF (NSRCS.EQ.NSMAX) THEN
                     WRITE (MSGTXT,1012) NSMAX
                     IRET = 10
                     GO TO 990
                     END IF
                  NSRCS = NSRCS + 1
                  SRCBRK(1,NSRCS) = NTIMES + 1
                  SRCBRK(2,NSRCS) = SRCNUM(I)
                  GO TO 10
                  END IF
 15            CONTINUE
            WRITE (MSGTXT,1015) STRING
            CALL MSGWRT (8)
            END IF
         IF (INLINE(:18).EQ.'process_ionosphere') GO TO 25
         IF (INLINE(:3).NE.'seq') GO TO 10
      ELSE
         WRITE (MSGTXT,1000) IRET, 'READING START OF ALBUS OUTPUT FILE'
         IF ((IRET.NE.2) .OR. (NTIMES.LE.0)) GO TO 990
         IRET = 0
         GO TO 30
         END IF
C                                       right day??
      CALL H2CHR (8, 1, CATH(KHDOB), DOB)
      CALL DATEST (DOB, LD)
      IF ((LD(1).NE.IY) .OR. (LD(2).NE.IM) .OR. (LD(3).NE.ID)) THEN
         WRITE (MSGTXT,1010) IY, IM, ID, LD
         IRET = 10
         GO TO 990
         END IF
C                                       read loop
 20   CALL ZTXIO ('READ', LUN, FIND, INLINE, IRET)
      IF (IRET.EQ.0) THEN
         KBPLIM = JTRIM (INLINE)
         IF ((KBPLIM.LE.0) .OR. (INLINE(:1).EQ.'#')) GO TO 10
         NBAD = NBAD + 1
         IF (INLINE(:18).EQ.'process_ionosphere') THEN
            NBAD = NBAD - 1
            GO TO 25
            END IF
         J = INDEX (INLINE,':')
         IF (J.LT.3) GO TO 20
         KBP = J + 1
         CALL GETNUM (INLINE, KBPLIM, KBP, XX)
         IF (XX.EQ.DBLANK) GO TO 20
         CALL GETNUM (INLINE, KBPLIM, KBP, XX)
         IF (XX.EQ.DBLANK) GO TO 20
         TIMES(NTIMES+1) = XX / 86400.0D0 + T0
         CALL GETNUM (INLINE, KBPLIM, KBP, XX)
         IF (XX.EQ.DBLANK) GO TO 20
         CALL GETNUM (INLINE, KBPLIM, KBP, XX)
         IF (XX.EQ.DBLANK) GO TO 20
         DEL(NTIMES+1) = XX
         CALL GETNUM (INLINE, KBPLIM, KBP, XX)
         IF (XX.EQ.DBLANK) GO TO 20
         DAZ(NTIMES+1) = XX
         CALL GETNUM (INLINE, KBPLIM, KBP, XX)
         IF (XX.EQ.DBLANK) GO TO 20
         STEC(NTIMES+1) = XX
         CALL GETNUM (INLINE, KBPLIM, KBP, XX)
         IF (XX.EQ.DBLANK) GO TO 20
         RMS(NTIMES+1) = XX
         CALL GETNUM (INLINE, KBPLIM, KBP, XX)
         IF (XX.EQ.DBLANK) GO TO 20
         VTEC(NTIMES+1) = XX * STEC(NTIMES+1)
         NTIMES = NTIMES + 1
         IF (NTIMES.GT.NTMAX) THEN
            WRITE (MSGTXT,1020) NTMAX
            IRET = 10
            GO TO 990
            END IF
         NBAD = NBAD - 1
         GO TO 20
      ELSE IF (IRET.NE.2) THEN
         WRITE (MSGTXT,1000) IRET, 'READING ALBUS OUTPUT TEXT FILE'
         GO TO 990
         END IF
      GO TO 30
C                                       last text line
 25   J = INDEX (INLINE,'time:')
      KBP = J + 5
      KBPLIM = JTRIM (INLINE)
      CALL GETNUM (INLINE, KBPLIM, KBP, XX)
      IF (XX.NE.DBLANK) THEN
         TOTRUN = XX
         SUMRUN = SUMRUN + XX
         WRITE (MSGTXT,1025) TOTRUN
         CALL MSGWRT (3)
         END IF
C                                       shut down
 30   CALL ZTXCLS (LUN, FIND, I)
      IRET = 0
      WRITE (MSGTXT,1030) NTIMES
      CALL MSGWRT (3)
      WRITE (MSGTXT,1031) NSRCS
      CALL MSGWRT (3)
      WRITE (MSGTXT,1032) NBAD
      CALL MSGWRT (3)
C                                       good stations
      CALL CFILL (STNMAX, '    ', AGSTAT)
      J = JTRIM (DIRDAT)
      INLINE = DIRDAT(:J) // '/albus_good_stations'
      CALL ZTXOPN ('READ', LUN, FIND, INLINE, .FALSE., IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'OPEN GOOD STATIONS FILE'
         GO TO 980
         END IF
      IM = 0
 50   CALL ZTXIO ('READ', LUN, FIND, INLINE, IRET)
      IF (IRET.EQ.0) THEN
         IF (INLINE(:4).NE.' ') THEN
            IF (IM.LT.STNMAX) THEN
               IM = IM + 1
               AGSTAT(IM) = INLINE(:4)
               AGSTAC(IM) = INLINE(5:7)
            ELSE
               MSGTXT = 'USED STATION LIST OVERFLOWS'
               IF (IM.EQ.STNMAX) CALL MSGWRT (6)
               IM = IM + 1
               END IF
            END IF
         GO TO 50
      ELSE IF (IRET.NE.2) THEN
         WRITE (MSGTXT,1000) IRET, 'READING GOOD STATIONS FILE'
         GO TO 980
         END IF
      CALL ZTXCLS (LUN, FIND, ID)
      IRET = 0
      ID = 0
 55   IY = ID + 1
      ID = MIN (IY+7, IM)
      WRITE (MSGTXT,1055) (AGSTAT(I), I = IY,ID)
      CALL MSGWRT (3)
      IF (ID.LT.IM) GO TO 55
C                                       document stations
      CALL STATID (IRET)
      GO TO 999
C
 980  IRET = 0
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('RIFRMG: ERROR',I4,' ON ',A)
 1010 FORMAT ('TEXT FILE FOR',I5,2I3,'  DATA FROM',I5,2I3,' STOPPING')
 1012 FORMAT ('MAXIMUM NUMBER OF SOURCES',I5,' EXCEEDED')
 1015 FORMAT ('SOURCE ''',A,''' NOT FOUND!')
 1020 FORMAT ('MAXIMUM NUMBER OF SOURCE TIMES',I7,' EXCEEDED')
 1025 FORMAT ('ALBUS total run time',F7.2,' minutes')
 1030 FORMAT ('RIFRMG read',I4,' times')
 1031 FORMAT ('RIFRMG in  ',I4,' sources')
 1032 FORMAT ('RIFRMG',I6,' bad values lines')
 1055 FORMAT ('Stations used',8(2X,A))
      END
      SUBROUTINE IFRGET (TIME, THESRC, SOURID, IFR, DISP, TEDATA)
C-----------------------------------------------------------------------
C   IFRGET gets the IFR, DISP, TE values from the tables
C   Inputs
C      THESRC   I      Source being processed (0 -> all)
C      SOURID   I      The current source
C      TIME     D      time (days)
C   In/out
C      IFR      R      Ionospheric Faraday rotation radians/m/m
C                      from table or unchanged if fail to find
C      DISP     R(2)   Dispersive delay
C      TEDATA   R(16)  HA, AZ, ZA, AZION, ZAION, DLON, DLAT, B(3),
C                      TEPATH, MAG, TEC, IFR, DISP(2)
C   Common
C-----------------------------------------------------------------------
      DOUBLE PRECISION TIME
      INTEGER   THESRC, SOURID
      REAL      IFR, DISP(2), TEDATA(16)
C
      INCLUDE 'RIFRM.INC'
      INTEGER   I, LT, LS, LT1, LT2
      REAL      PT, TSC
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:PSTD.INC'
      SAVE LT, PT, LS, LT1, LT2
      DATA LT, PT, LS, LT1, LT2 /1, 0.0, 3*0/
C------------------------------------------------------------------------
      IF (TENEW) CALL RFILL (16, FBLANK, TEDATA)
      IF (THESRC.GT.0) THEN
         LT1 = 1
         LT2 = NTIMES
      ELSE IF (SOURID.NE.LS) THEN
         DO 10 I = 1,NSRCS
            IF (SOURID.EQ.SRCBRK(2,I)) THEN
               LT1 = SRCBRK(1,I)
               IF (I.LT.NSRCS) THEN
                  LT2 = SRCBRK(1,I+1)
               ELSE
                  LT2 = NTIMES
                  END IF
               LT = 1
               PT = 0.0
               LS = SOURID
               GO TO 30
               END IF
 10         CONTINUE
         GO TO 999
         END IF
C                                       Find time
 30   IF (TIME.LT.PT) LT = LT1
      DO 40 I = LT1,LT2-1
         IF ((TIME.GE.TIMES(I)) .AND. (TIME.LE.TIMES(I+1))) THEN
            LT = I
            PT = TIMES(I)
            GO TO 50
            END IF
 40      CONTINUE
      PT = 0.0
      LT = LT1
      GO TO 999
C                                       interpolate
 50   IF ((RMS(I).EQ.FBLANK) .OR. (RMS(I+1).EQ.FBLANK)) THEN
         IFR = FBLANK
      ELSE
         TSC = (TIME-TIMES(I)) / (TIMES(I+1)-TIMES(I))
         IFR = TSC * (RMS(I+1) - RMS(I)) + RMS(I)
         IF (ABS(IFR).GT.100.0) IFR = FBLANK
         TEDATA(2) = TSC * (DAZ(I+1)-DAZ(I)) + DAZ(I)
         TEDATA(3) = TSC * (DEL(I+1)-DEL(I)) + DEL(I)
         TEDATA(3) = 90.0 - TEDATA(3)
         TEDATA(11) = TSC * (STEC(I+1)-STEC(I)) + STEC(I)
         TEDATA(13) = TSC * (VTEC(I+1)-VTEC(I)) + VTEC(I)
         TEDATA(14) = IFR
         TEDATA(15) = 40.28 * TEDATA(11) / (VELITE ** 3) * 1.E16
         TEDATA(16) = TEDATA(15)
         END IF
C
 999  RETURN
      END
      SUBROUTINE ALBUSH
C-----------------------------------------------------------------------
C     ALBUSH adds history to the data set
C-----------------------------------------------------------------------
      INCLUDE 'ALBUS.INC'
      INCLUDE 'ALBUSD.INC'
      INCLUDE 'RIFRM.INC'
      INTEGER   IRET, LUN, TIME(3), DATE(3), I, I1, I2, J, JTRIM
      CHARACTER HILINE*72, CTIME(2)*12, CDUM*10, LABEL*8
      INCLUDE 'INCS:DDCH.INC'
      DATA LUN /27/
C-----------------------------------------------------------------------
      CALL HIINIT (3)
      CALL HIOPEN (LUN, DISKIN, CNOIN, SCRTCH, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'CREATE HI FILE'
         GO TO 990
         END IF
C                                       Task message
      CALL ZDATE (DATE)
      CALL ZTIME (TIME)
      CALL TIMDAT (TIME, DATE, CTIME(2), CTIME)
      WRITE (HILINE,2000) TSKNAM, RLSNAM, CTIME
      CALL HIADD (LUN, HILINE, SCRTCH, IRET)
      IF (IRET.NE.0) GO TO 900
C                                       sources
      CDUM = 'SOURCES ='
      I2 = 0
 10   I1 = I2 + 1
      I2 = MIN (NSORC,I1+2)
      IF (I1.LE.NSORC) THEN
         WRITE (HILINE,2010) TSKNAM, CDUM, (SRCNAM(I), I = I1,I2)
         IF ((I2.EQ.NSORC) .AND. (I2-I1.LT.2)) THEN
            I = JTRIM (HILINE)
            HILINE(I:) = ' '
            END IF
         CALL HIADD (LUN, HILINE, SCRTCH, IRET)
         IF (IRET.NE.0) GO TO 900
         CDUM = ' '
         GO TO 10
      END IF
C                                       antennas
      IF (NANTS.EQ.0) THEN
         HILINE = TSKNAM // '/  all antennas treated as one'
         CALL HIADD (LUN, HILINE, SCRTCH, IRET)
         IF (IRET.NE.0) GO TO 900
      ELSE
         I2 = 0
         CDUM = 'ANTENNAS ='
 20      I1 = I2 + 1
         I2 = MIN (NANTS, I1+13)
         IF (I1.LT.NANTS) THEN
            WRITE (HILINE,2020) TSKNAM, CDUM, (ANTNUM(I), I = I1,I2)
            IF (I2.EQ.NANTS) THEN
               I = JTRIM (HILINE)
               HILINE(I:) = ' '
               END IF
            CALL HIADD (LUN, HILINE, SCRTCH, IRET)
            IF (IRET.NE.0) GO TO 900
            CDUM = ' '
            GO TO 20
            END IF
         END IF
C                                       CL/TE versions
      WRITE (HILINE,2025) TSKNAM, 'GAINVER', CLVIN, 'input CL'
      CALL HIADD (LUN, HILINE, SCRTCH, IRET)
      IF (IRET.NE.0) GO TO 900
      WRITE (HILINE,2025) TSKNAM, 'GAINUSE', CLVOUT, 'output CL'
      CALL HIADD (LUN, HILINE, SCRTCH, IRET)
      IF (IRET.NE.0) GO TO 900
      WRITE (HILINE,2025) TSKNAM, 'TEVER', TEVOUT, 'output TE'
      CALL HIADD (LUN, HILINE, SCRTCH, IRET)
      IF (IRET.NE.0) GO TO 900
C                                       directory
      J = JTRIM (ROOT)
      I2 = 0
      CDUM = 'DATAOUT= '''
 30   I1 = I2 + 1
      I2 = MIN (J, I1+54)
      IF (I1.LE.J) THEN
         WRITE (HILINE,2030) TSKNAM, CDUM, ROOT(I1:I2)
         IF (I2.EQ.J) THEN
            I = JTRIM (HILINE)
            HILINE(I+1:) = ''''
            END IF
         CALL HIADD (LUN, HILINE, SCRTCH, IRET)
         IF (IRET.NE.0) GO TO 900
         CDUM = ' '
         GO TO 30
         END IF
C                                       adverbs
      WRITE (HILINE,2040) TSKNAM, TECTYP
      CALL HIADD (LUN, HILINE, SCRTCH, IRET)
      IF (IRET.NE.0) GO TO 900
      WRITE (HILINE,2041) TSKNAM, DETIME
      CALL HIADD (LUN, HILINE, SCRTCH, IRET)
      IF (IRET.NE.0) GO TO 900
      WRITE (HILINE,2042) TSKNAM, RADIUS
      CALL HIADD (LUN, HILINE, SCRTCH, IRET)
      IF (IRET.NE.0) GO TO 900
      IF ((DOBTW.LE.0.0) .AND. (DOALL.LE.0.0)) THEN
         HILINE = TSKNAM // '/ each source has separate downloaded data'
      ELSE
         HILINE = TSKNAM // '/ all sources use the same downloaded data'
         END IF
      CALL HIADD (LUN, HILINE, SCRTCH, IRET)
      IF (IRET.NE.0) GO TO 900
      IF (ABS(DOBTW).GE.10.0) THEN
         HILINE = TSKNAM // '/ python run on one cpu only'
         CALL HIADD (LUN, HILINE, SCRTCH, IRET)
         IF (IRET.NE.0) GO TO 900
         END IF
      WRITE (HILINE,2050) TSKNAM, SUMRUN
      CALL HIADD (LUN, HILINE, SCRTCH, IRET)
      IF (IRET.NE.0) GO TO 900
      IF (NUMHIS.LE.0) THEN
         J = 0
         DO 40 I = 1,STNMAX
            IF (AGSTAT(I).NE.' ') J = I
 40         CONTINUE
         I2 = 0
 45      I1 = I2 + 1
         I2 = MIN (I1+6, J)
         WRITE (HILINE,2045) TSKNAM, (AGSTAT(I), I=I1,I2)
         CALL HIADD (LUN, HILINE, SCRTCH, IRET)
         IF (IRET.NE.0) GO TO 900
         IF (I2.LT.J) GO TO 45
      ELSE
         LABEL = TSKNAM // '/ '
         DO 50 I = 1,NUMHIS
            HILINE = LABEL // HISCRD(I)
            CALL HIADD (LUN, HILINE, SCRTCH, IRET)
            IF (IRET.NE.0) GO TO 900
 50         CONTINUE
         END IF
      DO 60 I = 1,NUMSTN
         WRITE (HILINE,2060) TSKNAM, I, STATNS(I)
         CALL HIADD (LUN, HILINE, SCRTCH, IRET)
         IF (IRET.NE.0) GO TO 900
 60      CONTINUE
      CALL HICLOS (LUN, .TRUE., SCRTCH, I)
      GO TO 999
C
 900  CALL HICLOS (LUN, .TRUE., SCRTCH, I)
      WRITE (MSGTXT,1000) IRET, 'WRITING HISTORY FILE'
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('ALBUSH ERROR',I4,' ON ',A)
 2000 FORMAT (A6,'RELEASE   =''',A7,' ''  /******* Start ',A12,2X,A8)
 2010 FORMAT (A6,A9,3(' ''',A,''''))
 2020 FORMAT (A6,A10,I3.2,13(',',I3.2))
 2025 FORMAT (A6,A,' =',I4,5X,'/ ',A,' table version')
 2030 FORMAT (A6,A10,A)
 2040 FORMAT (A6,'TECRTYPE = ''',A,'''    / Ionospheric model type')
 2041 FORMAT (A6,'DETIME ',F5.0,5X,'/ Download timeout in seconds')
 2042 FORMAT (A6,'RADIUS ',I5,5X,'/ Radius in km to find data sources')
 2045 FORMAT (A6,'/ stations used',7(1X,'''',A,''''))
 2050 FORMAT (A6,'/ ALBUS reported sum run time',F8.2,' minutes')
 2060 FORMAT (A6,'STATIONS(',I2.2,') = ''',A4,
     *   '''  / use only these stations')
      END
      SUBROUTINE LASTRN (INLINE, STRING)
C-----------------------------------------------------------------------
C   returns the last string in an input line (drops ' marks if any)
C   Input:
C      INLINE   C*(*)   Text line to parse
C   Output
C      STRING   C*(*)   last string
C-----------------------------------------------------------------------
      CHARACTER   INLINE*(*), STRING*(*)
C
      INTEGER   I, J, JTRIM, I1, I2
C-----------------------------------------------------------------------
      STRING = ' '
      J = JTRIM (INLINE)
      DO 10 I = J,1,-1
         IF ((INLINE(I:I).EQ.' ') .OR. (I.EQ.1)) THEN
            I1 = I + 1
            IF (I.EQ.1) I1 = 1
            IF (INLINE(I1:I1).EQ.'''') THEN
               I1 = I1 + 1
            ELSE IF (INLINE(I1:I1).EQ.'"') THEN
               I1 = I1 + 1
               END IF
            I2 = J
            IF (INLINE(I2:I2).EQ.'''') THEN
               I2 = I2 - 1
            ELSE IF (INLINE(I2:I2).EQ.'"') THEN
               I2 = I2 - 1
               END IF
            STRING = INLINE(I1:I2)
            GO TO 999
            END IF
 10      CONTINUE
C
 999  RETURN
      END
