FTN77
$ALIAS/POINT/,NOALLOCATE
$FILES 0,1
      PROGRAM SKYMP (3,30), SKYMAP UPDATE <890705.0954>
C     =============
C
C     Rhodes University fast sky mapping program.
C     Conception and initial design : P I Mountfort.
C     Subsequent changes : J L Jonas with help of M J Gaylard
C
      IMPLICIT NONE
      CHARACTER Ibuf1*80, Ibuf2*80,  ! pairs of lines from source file
     *          TapeName*6,          ! tape label given by user
     *          Return*1             ! dummy variable to allow RETURN replies
C
      LOGICAL LongScan,  LatScan,    ! scan/drive-flat-out flags for COMND (Mes)
     *        HAstop,    DecStop,    ! park/track flags for COMND (Mes)
     *        IFBRK,                 ! system routine to sense for BR,SKYMP
     *        AllOK,                 ! true => scheduling info all ok
     *        Immed,                 ! schedule immediately/deferred flag
     *        RAOK                   ! true => use source file info
C
      REAL    Long,      Lat,        ! coordinate variables for COMND (Mes)
     *        DecLo, DecHi,          ! scan declination limits
     *        DecRate,               ! dsclination scan rate (deg/sec)
     *        FinalDec,              ! antenna declination at end of scan
     *        HAoffset,              ! 13 cm beam offsets HA
     *        DecOffset,             !                    DEC
     *        RA,                    ! general right ascension variable
     *        RAinterval,            ! RA spacing of map (combined) scans
     *        RAmodulo,              ! RA spacing between successive up scans
     *        RasterOffset,          ! RA offset from scans of raster 0
     *        Secint,                ! distance between map scans in time
     *        HA,                    ! general hour angle variable
     *        RAh, RAm, RAs,         ! hour, minute, second components of RA
     *        CmdTime,               ! expiry UT of command to COMND (Mes)
     *        BackTime,              ! minimum HA rewind time between scans
     *        BaseTime,              ! start UT of current up/down scan pair
     *        EndUp,                 ! computed offset till end of up scan
     *        StartDown,             ! computed offset till start of down scan
     *        EndDown,               ! computed offset till end of down scan
     *        StartNext,             ! computed offset till start of next pair
     *        SiderealTime           ! function returning current ST
C
      INTEGER Mes(12),               ! COMND command message buffer
     *        Type,                  ! type of COMND command (Mes)
     *        CmdClass,   Ncmd,      ! "class number" for COMND communication
     *        Wake,                  ! "resource number" for synch. (Mes)
     *        Cons,       Icons,     ! console unit number (for obs log)
     *        Direction,             ! scan direction variable (+1/-1)
     *        Year,       T(5),      ! Year and UT returned by EXEC call
     *        Tday,       Thour,     !   equivalenced to T above
     *        Tminute,    Tsecond,   !
     *        StartDay,   StartHour, ! scheduled start date, UT
     *        StartMinute,           !   of observation
     *        EndDay,     EndHour,   ! scheduled end date, UT
     *        EndMinute,             !   of observation
     *        Delay,                 ! scheduling delay in minutes
     *        Duration,              ! duration of observation in minutes
     *        TapeLU,                ! logical unit number of mag tape
     *        Prog(3),               ! substitute observing program name
     *        Ttest(256),            ! buffer used to validate tape system
     *        Nobs,       Iobs,      ! observation number
     *        Nskip,                 ! number of interleaved rasters required
     *        Nruns,                 ! scheduled number of scans
     *        Nraster,               ! current raster number
     *        Nrun,                  ! current scan number
     *        Istat,      Ierr,      ! status return variables
     *        i,                     ! counter variable
     *        Junk,                  ! one word place holder
C     PROCEDURE LINKS
     *        InPattern,  ReadRA,
     *        Schedule,   ReadSource,
     *        GetThere,   ScanMessage,
     *        Run,        CheckTape
C
      EQUIVALENCE (Mes(1), Long),     (Mes(3), Lat),
     *            (Mes(5), Type),     (Mes(6), CmdTime),
     *            (Mes(8), LongScan), (Mes(9), LatScan),
     *            (Mes(10), HAstop),  (Mes(11), DECstop),
     *            (Mes(12), Wake),
     *            (T(2), Tsecond),    (T(3), Tminute),
     *            (T(4), Thour),      (T(5), Tday)
C
      COMMON /POINT/ Junk, CmdClass
     *       /LOGCM/ Nobs, Nrun, DecLo, DecHi, Nraster, RAinterval,
     *               DecRate, Nskip
      DATA Cons   /7/,          ! use console with printer for logging
     *     TapeLU /9/,          ! write data to mag tape LU 9 (unit 1)
     *     Type   /4/,          ! use equatorial coordinates, current epoch
     *     LongScan /.FALSE./,  ! always track or fast drive in HA
     *     HAstop /.FALSE./,   DecStop  /.FALSE./,  ! never park antenna
     *     HAoffset /+0.070/,   ! 13 cm beam offset to west
     *     DecOffset /+0.450/   !                  and south
C
        Icons = -1
        CALL RCPAR (1,Icons)
        IF ( Icons .GT. 0 ) Cons = Icons
        CALL Initialise (Cons, Prog, TapeLU)
        ASSIGN 10 TO CheckTape
        GO TO 100
   10   ASSIGN 20 TO ReadSource
        GO TO 200
   20   ASSIGN 30 TO InPattern
        GO TO 300
   30   ASSIGN 40 TO ReadRA
        GO TO 400
   40   ASSIGN 50 TO Schedule
        GO TO 500
   50   ASSIGN 60 TO GetThere
        Nrun = 0                       ! reset scan counter
        GO TO 600
C       repeat
   60     ASSIGN 70 TO ScanMessage
          GO TO 700
   70     ASSIGN 80 TO Run
          GO TO 800
   80     IF (.NOT. IFBRK(0) .AND. Nrun .LT. Nruns) GO TO 60
C       until break-in or last run
        CALL ShutDown (Cons, TapeLU)
   90   WRITE (Cons, '('' End of SKYMAP,  Bye Bye'',////)')
        CALL StopProgram
C     END MAIN
C
C       PROCEDURE CheckTape
C       ===================
C
C       validate mag tape and mag tape drive, and erase some leader
C       at the load point
C
  100     CONTINUE
          WRITE (Cons,1100) TapeLU
 1100     FORMAT (/'CHECK:  Magnetic tape is loaded on Logical Unit ',
     *                                                          I2,
     *            /'        A write permit ring is fitted to the tape',
     *            /'        The tape is at the LOAD point and ON-LINE')
  110     WRITE (Cons, '(//''Enter tape name: _'')')
          READ (Cons, '(A)') TapeName
C       check to see if tape is mounted with wpr
          CALL EXEC (3, TapeLU + 600B)
          CALL EXEC (13, TapeLU, Istat)
          IF ( (Istat .AND. 5B) .NE. 0 ) THEN
            WRITE (Cons,1110) Istat
 1110       FORMAT(/'*** Mag Tape Unit not ready, Status is',K7,' ***')
            WRITE (Cons, 1100) TapeLU
            WRITE (Cons, '(/''Press RETURN when fixed _'')')
            READ (Cons,'(A)') Return
            GO TO 110
          END IF
C       validate mag tape and unit
          WRITE (Cons, '(/''Validating magnetic tape ...... _'')')
          DO i = 1 , 256
            Ttest(i) = i - 1
          END DO
          DO i = 1 , 256
            CALL EXEC (2, TapeLU + 100B, Ttest, 256)
          END DO
          CALL RewindTape (TapeLU)
          DO i = 1 , 256
            CALL EXEC (1, TapeLU + 400B, Ttest, 256)
            CALL EXEC (3, TapeLU + 600B)
            CALL EXEC (13, TapeLU, Istat)
            IF ( (Istat .AND. 377B) .NE. 0 ) THEN
              WRITE (Cons,1130) Istat
 1130         FORMAT (//'*** Magnetic Tape Error Status: ',K6,' ***',
     *                //'*** Try new tape or clean heads ***'/)
              GO TO 100
            END IF
          END DO
          CALL RewindTape (TapeLU)
C
C       write gap to ensure tape can be read
          CALL EXEC (3, TapeLU + 1200B)
          CALL EXEC (3, TapeLU + 1200B)
          WRITE (Cons, '(''Tape OK''//)')
          GO TO CheckTape
C       END OF CheckTape
C
C       PROCEDURE InPattern
C       ===================
C
C       input scan pattern from first line of obs data in file
C
  300     CONTINUE
          READ (Ibuf1,*) Nobs, DecLo, DecHi, RAinterval, DecRate
          DecLo = MOD (DecLo + 720.0, 360.0)
          DecHi = MOD (DecHi + 720.0, 360.0)
          EndUp = MOD (DecHi - DecLo + 720.0, 360.0) / DecRate  ! up scan time
          BackTime = EndUp/60.0 + 32.0  ! minimum hour angle rewind time
          SecInt = RAinterval*240.0/1.002 737 909 3  ! RA spacing in ut seconds
          Nskip = (EndUp + BackTime + SecInt - 1.0)/SecInt  ! interleave calc.
          StartDown = Nskip * SecInt   ! time offset to start down scan
          EndDown = StartDown + EndUp  ! time offset to end of down scan
          StartNext = 2.0 * StartDown  ! time offset till start of next scan
          WRITE (CONS,1300) Nobs, DecLo, DecHi, DecRate, RAinterval,
     *                      Nskip, EndUp, StartDown, EndDown, StartNext
 1300     FORMAT (/'Pattern for Observation:',I5/
     *             '-----------------------------'//
     *             'Lo Dec',F8.3,'    Hi Dec',F8.3,'    Dec rate',F5.3/
     *             'RA interval',F5.3,'       No of rasters',I3/
     *             'Break times',4F6.1)
          GO TO InPattern
C       END InPattern
C
C       PROCEDURE ReadRA
C       ================
C
C       input ra from 2nd line of obs data in file, and find ha.
C
  400     CONTINUE
          READ (Ibuf2,*) Nraster, RAH, RAM, RAS
          WRITE (Cons, '(//''Raster no. and RA (H M S) '',A10,'' _'')')
     *           Ibuf2
          WRITE (Cons, '(''      Do you wish to use these? (T/F) _'')')
          READ (Cons, '(L1)', ERR=400) RAOK
          IF ( .NOT. RAOK ) THEN
            WRITE (CONS, '(/''Enter required raster number: _'')')
            READ (Cons, *, ERR=400) Nraster
            IF ( (Nraster .LT. 0) .OR. (Nraster .GE. Nskip) ) GO TO 400
            WRITE (Cons, '(/''Enter start RA (hh mm ss): _'')')
            READ (Cons, *, ERR=400) RAH, RAM, RAS
          END IF
C         find suitable start right ascension for given raster number
          RasterOffset = Nraster * RAinterval
          RA = ((RAH*60.0 + RAM)*60.0 + RAS)/240.0 - RasterOffset
          RA = MOD (RA + 720.0, 360.0)
          RAmodulo = 2.0 * Nskip * RAinterval
          RA = IFIX (RA / RAmodulo) * RAmodulo + RasterOffset
          HA = MOD (SiderealTime()/240.0 - RA + 720.0, 360.0)
          WRITE (CONS, '(/''Adjusted Start RA: _'')')
          CALL WriteHMS (RA, Cons)
          WRITE (Cons, '(''            Current Hour Angle:'',F8.3)') HA
          GO TO ReadRA
C       END ReadRA
C
C       PROCEDURE Schedule
C       ==================
C
C       input start and end times
C
C       input start time
  500     CONTINUE
          CALL EXEC (11, T, Year)      ! get current UT
          WRITE (Cons,
     *          '(/''Enter start time - UT (Days,Hours,Minutes): _'')')
          READ (Cons, *, ERR=500) StartDay, StartHour, StartMinute
C
C         check day number does not pre-date today
          IF ( StartDay .LT. Tday ) THEN
            WRITE (Cons, '(/''*** Check DayNumber ***'')')
            GO TO 500
          END IF
C
C         check start time is later than current ut
          IF ( StartDay .EQ. Tday ) THEN
            IF ( (StartHour * 60 + StartMinute) .LT.
     *           (Thour * 60 + Tminute)) THEN
              WRITE (Cons,
     *             '(/''*** Start Time precedes current UT ***'')')
              GO TO 500
            END IF
          END IF
C
C         input the end time
          CONTINUE
  510     WRITE (CONS,
     *          '(/''Enter end time - UT (Days,Hours,Minutes): _'')')
          READ (Cons, *, ERR=510) EndDay, EndHour, EndMinute
C         check input end time
          Duration = (EndDay - StartDay) * 1440 +
     *               (EndHour - StartHour) * 60 +
     *               (EndMinute - StartMinute)
          IF ( Duration .LE. 1 ) THEN
            WRITE (Cons, '(''*** End Time precedes Start Time ***'')')
            GO TO 510
          END IF
          Nruns = NINT (FLOAT (Duration) / (StartNext/60.0)) * 2
          WRITE (Cons,
     *         '(/''Start UT: Day'',I4,2X,I2,'':'',I2.2,'':00     _'')')
     *           StartDay, StartHour, StartMinute
          WRITE (Cons,
     *         '(''End UT:  Day'',I4,2X,I2,'':'',I2.2,'':00'')')
     *           EndDay, EndHour, EndMinute
          CALL EXEC (11, T, Year)
          Delay = (StartDay - Tday) * 1440 +
     *            (StartHour - Thour) * 60 +
     *            (StartMinute - Tminute)
          HA = MOD (HA + Delay/4.0 + 900.0, 360.0) - 180.0
          WRITE (Cons, '(/''Approximate future HA:'',F8.3)') HA
          IF ( ABS (HA) .GT. 45.0 ) WRITE (CONS,1510)
 1510     FORMAT(/'WARNING - future HA greater than normal '
     *            'Skymap limit of 45 degrees.'/)
          IF ( ABS (HA) .GT. 60.0 ) WRITE (CONS,1520)
 1520     FORMAT(/'*WARNING* - future HA greater than absolute '
     *            'Skymap limit of 60 degrees'/
     *            'Data may be unusable'//)
 520      WRITE (Cons, '(/''Time allows'',I4,'' runs, OK? (T/F) _'')')
     *           Nruns
          READ (Cons, *, ERR=520) AllOK
          IF ( .NOT. AllOK ) GO TO 500
          CALL EXEC (11, T, Year)
          Delay = (StartDay - Tday) * 1440 +
     *            (StartHour - Thour) * 60 +
     *            (StartMinute - Tminute)
          Delay = - Delay              ! system call requires negative time
          Immed = Delay .GE. 0
          IF ( .NOT. Immed ) THEN
              WRITE (Cons, 1530) StartDay, StartHour, StartMinute,
     *                           Tsecond
 1530         FORMAT ('SKYMP suspended until day ',I3,'  UT ',I2.2,':',
     *                I2.2,':',I2.2,' ..... _')
              CALL EXEC (12, 0, 3, 0, Delay)  ! delay in minutes
              WRITE (Cons, '(''SKYMP restarted'')')
            ELSE
              WRITE (Cons, '(/''SKYMP scheduled immediately'')')
          END IF
          GO TO Schedule
C       END Schedule
C
C       PROCEDURE GetThere
C       ==================
C
C       drive to start of observation
C
  600     CONTINUE
          Ncmd = CmdClass
C         drive and wake
          CmdTime = -1                 ! drive immediately
          Long = RA + HAoffset         ! adjust for beam offsets
          Lat = DecLo + DecOffset
          LatScan = .FALSE.            ! don't scan in dec, go flat out
          CALL RNRQ (12B, Wake, Istat) ! wait till antenna is at start
          CALL EXEC (20, 0, Mes, 12, 0, 0, Ncmd)
          CALL RNRQ (5, Wake, Istat)
          CALL RNRQ (40B, Wake, Istat)
          Wake = 0
          WRITE (Cons, '(/''Arrived at start of first scan''/)')
          CALL EXEC (12, 0, 2, 0, -20) ! wait 20 sec for antenna to settle
          CALL EXEC (11, T, Year)      ! current UT
          BaseTime = FLOAT (Thour*60 + Tminute)*60.0 +
     *               FLOAT (Tsecond)   ! define start UT of first scan
          GO TO GetThere
C       END GetThere
C
C       PROCEDURE ScanMessage
C       =====================
C
C       generate steering messages for one up/down scan
C
  700     CONTINUE
C         upscan
          Long = RA + HAoffset         ! adjusted coords for top of up scan
          Lat = DecHi + DecOffset
          CmdTime = BaseTime + EndUp   ! UT at which to reach top of scan
          LatScan = .TRUE.             ! scan at constant velocity
          CALL EXEC (20, 0, Mes, 9, 0, 0, Ncmd)  ! queue command
C         track to start of down
          Long = RA + RAinterval * Nskip + HAoffset  !  adjusted RA of down
          CmdTime = BaseTime + StartDown  ! UT to start down scan
          CALL EXEC (20, 0, Mes, 7, 0, 0, Ncmd)  ! queue command
C         downscan
          Lat = DecLo + DecOffset      ! adjusted bottom dec of down scan
          CmdTime = BaseTime + EndDown  ! UT to reach bottom of down scan
          CALL EXEC (20, 0, Mes, 9, 0, 0, Ncmd)  ! queue command
C         track to next scan
          Long = RA +  2.0 * RAinterval * Nskip + HAoffset  ! RA of next
          CmdTime = BaseTime + StartNext  ! UT to start next up scan
          CALL EXEC (20, 0, Mes, 7, 0, 0, Ncmd)  ! queue command
          GO TO ScanMessage
C       END ScanMessage
C
C       PROCEDURE Run
C       =============
C
C       log complete up/down scan set
C
  800     CONTINUE
          Direction = +1               ! up scan
          Nrun = Nrun + 1              ! bump run counter
C         select 13cm direct inputs on both DVMs
          CALL EXEC (2, 113b, 55b, 1, 5, 5)
C         CALL SETFS (FREQ)
          CALL LogOneScan (Cons, BaseTime, BaseTime + EndUp, RA,
     *                     Direction, FinalDec, 0, .TRUE., TapeLU)
          CALL Check (Cons, FinalDec, DecHi, Prog, Nrun, TapeLU)
          Direction = -1               ! down scan
          Nrun = Nrun + 1              ! bump run counter
          CALL EXEC (2, 113b, 55b, 1, 5, 5)  ! select dvm's
C         CALL SETFS (FREQ)
          RA  = RA + RAinterval * Nskip  ! RA of down scan
          CALL LogOneScan (Cons, BaseTime + StartDown,
     *                     BaseTime + EndDown, RA, Direction, FinalDec,
     *                     0, .TRUE., TapeLU)
          CALL Check (Cons, FinalDec, DecLo, Prog, Nrun, TapeLU)
          BaseTime = MOD (BaseTime + StartNext, 86400.0)  ! base UT for next
          RA = RA + RAinterval * Nskip ! base RA for next   up/down scan set
          GO TO Run
C       END Run
C
C       PROCEDURE ReadSource
C       ====================
C
C       read parameter file skysrc on 16
C
C         open source file 'skysrc' of suspend if not found
  200     OPEN (18, FILE='SKYSRC::16', STATUS='OLD',
     *            IOSTAT=Ierr, ERR=210)
          GO TO 220
  210       WRITE (Cons,1200) Ierr
 1200       FORMAT ('*** File SKYSRC::16 not found, FMP Error ',I3/
     *                ' Press RETURN when fault cleared')
            READ (Cons, '(A)') Return
            GO TO 200
C
  220     WRITE (CONS, '(''Enter Observation Number: _'')')
          READ (Cons, *, ERR=220) Iobs
C
C         repeat reading pairs of lines from source file
  230       READ (18,'(A)',IOSTAT=Ierr,ERR=240) Ibuf1
            READ (18,'(A)',IOSTAT=Ierr,ERR=240) Ibuf2
            READ (IBUF1,*) Nobs
            IF ( IOBS .NE. Nobs ) GO TO 230
C         until required obs or file error
C
C         data successfully read from source file
          CLOSE ( 18 )
          GO TO ReadSource
C
C         file error
  240     WRITE (Cons,1220) Ierr
 1220     FORMAT ('*** Error',I4,' in Source File ***'/
     *            '   ****** SKYMP ABORTED *****')
          CLOSE (18)
          CALL StopProgram
C       END ReadSource
C
      END
      SUBROUTINE Initialise (Cons, Prog, TapeLU)
C     =====================
C
C     initialize and check radiometer system
C
      IMPLICIT NONE
      LOGICAL OK
      CHARACTER FF*1, Return*1
      INTEGER T(5), Year, IY, Prog(3), Isp, Nsam, Irep, MaxRep,
     *        Cons, TapeLU
      REAL Noise, Npeak, Nlow, Nup, NTcal, Freq, RMSup, PPup
C
C
      DATA MaxRep /10/,                ! maximum number of retries
     *       Nsam /40/,                ! number of samples used in tests
     *       Nlow /15.0/, Nup /25.0/,  ! approx. limits on noise cal. mV
     *       Freq /23.6/,              ! syntesizer frequency (L.O./96)
     *       IY /1986/,                ! lower bound on year
     *       RMSup /0.500/, PPup /2.000/,  ! limits on noise fluctuations mV
     *       Isp /2H  /                ! holerith spaces
  
C
        FF = CHAR (12)                 ! throw a page on the printer
        WRITE (Cons, '(A1)') FF
        WRITE (Cons,1000) '<890705.0954>'
 1000   FORMAT ('RHODES UNIVERSITY SKYMAP PROGRAM...Good Evening'/
     *          '***********************************************'//
     *          '           last program revision: ',A//)
        CALL EXEC (11, T, Year)        ! get current UT
        WRITE (Cons,1010) Year, T(5), T(4), T(3)
 1010   FORMAT ('Year',I6,'  Day',I4,'  at',I4,'h',I3.2,'m U.T.'//)
c       CALL SETFS (FREQ)
C       repeat checking system against noise tube
   10     WRITE (Cons,
     *         '(''Checking system against 13 cm noise diode .....'')')
          Irep = 0
C         repeat checking noise tube reading
   20       Noise = ABS (NTcal (Nsam)) ! get amplitude of cal signal in mV
            Irep = Irep + 1
            WRITE (Cons, '(''Attempt'',I3,5X,F8.3,'' mV'')') Irep, Noise
            OK = ( Noise .GT. Nlow ) .AND. ( Noise .LT. Nup )
            IF ( .NOT. OK ) WRITE (Cons,1020) Irep
 1020       FORMAT ('*** Calibration Test',I3,' Failed :'/
     *              'Check Radiometer and DVM')
            IF ( .NOT. OK .AND. (Irep .LT. MaxRep) ) GO TO 20
C         until satisfactory or failed maxrep times
          IF ( OK ) THEN
              WRITE (Cons,
     *        '(''Noise diode amplitude on DVM:'',F8.3,'' mV''/)') Noise
            ELSE
              WRITE (Cons,1030) Nlow, Nup
 1030         FORMAT ('*** Error in Radiometer/DVM System ***'/
     *                'Noise tube < ',F8.3,' or > ',F8.3,' mV'/
     *                'Press RETURN to continue when fixed'/)
              READ (Cons,'(A)') Return
          END IF
          IF ( .NOT. OK ) GO TO 10
C       until successful
C       measure rms and peak to peak noise
        WRITE (CONS,'(''Measuring noise fluctuations .....'')')
        Irep = 0
C       repeat measurement of noise fluctuations
   30     CALL Ndev (Nsam, Noise, Npeak)
          OK = ( Npeak .LT. PPup ) .AND. ( Noise .LT. RMSup )
          Irep = Irep + 1
          IF ( .NOT. OK ) WRITE (Cons,
     *      '(''*** Noise Fluctuation test'',I3,'' failed'')') Irep
          IF ( .NOT. OK .AND. (Irep .LT. MaxRep) ) GO TO 30
C       until satisfactory or failed maxrep times
        IF ( OK ) THEN
            WRITE (Cons,1040) Noise, Npeak
 1040       FORMAT ('RMS noise ',F8.3,' mV'/
     *              'Peak-to-Peak noise ',F8.3,' mV'/)
          ELSE
            WRITE (Cons,1050) RMSup, PPup
 1050       FORMAT (/'*** Noise fluctuations outside limits of:'/
     *               F8.3,' mV RMS'/
     *               F8.3,' mV Peak-to Peak'/
     *               'Press RETURN to continue, else abort')
            READ (Cons,'(A)') Return
        END IF
        Prog(1) = Isp
        WRITE (Cons,
     *  '(/''Enter alternate program name (defaults to none): _'')')
        READ (Cons,'(3A2)') Prog
      END
$ALIAS/POINT/,NOALLOCATE
      SUBROUTINE LogOneScan (Cons, StartTime, EndTime, RA, Direction,
C     =====================
     *                       FinalDec, NTsam, LogScan, TapeLU)
C
C     Log one up or down scan on magnetic tape
C
      IMPLICIT NONE
      LOGICAL EndOfScan, LogScan, LogErr1, LogErr2
      CHARACTER*4078 Cbuf
      INTEGER Cons, Ifunc, Iclass,
     *        Year1, Day1, Year2, Day2,
     *        Nskip, Nobs, Nraster, Nrun, Nblock, Nsam,
     *        Direction, TapeLU, Delay, NTsam,
     *        T(5), Thour, Tminute, Tsecond, Tmilsec,
     *        Buf(2039), Jbuf(2039), Junk(11)
      REAL DVM11, DVM12, DVM21, DVM22, DVM1, DVM2,
     *     RA, HA, RealHA, DHA1, DHA2, DHA, RAinterval,
     *     DecLo, DecHi, DecRate, DDec1, DDec2, DDec, FinalDec,
     *     DUT1, DUT2, DUT, WakeTime, StartTime, TimeLeft, EndTime,
     *     NTcal, Noise
      EQUIVALENCE (Buf, Cbuf),
     *            (T(1), Tmilsec), (T(2), Tsecond), (T(3), Tminute),
     *            (T(4), Thour)
      COMMON /POINT/ Junk, RealHA
      COMMON /LOGCM/ Nobs, Nrun, DecLo, DecHi, Nraster, RAinterval,
     *               DecRate, Nskip
C
C       select 13 cm direct output for both dvm's
        CALL EXEC (2, 113B, 55B, 1, 5, 5)
C
        IF ( Nrun .LE. 1 ) THEN        ! write heading if first run
          WRITE (Cons,1000)
 1000     FORMAT (' Run       RA          UT         HA    Dirn',
     *             '      Noise Tube')
        END IF
C       allocate class number for tape write
        Ifunc = 1
        Iclass = 0
        CALL CLRQ (Ifunc, Iclass)
        IF ( LogScan ) THEN            ! write info if scan is to be logged
          WRITE (Cons, '(I5,''_'')') Nrun  ! run number of scan
          CALL WriteHMS (RA, Cons)         ! intended right acsension
          CALL WriteHMS (StartTime/240.0, Cons)  ! start ut of scan
          HA = RealHA                  ! nominal hour angle
          WRITE (Cons, '(1X,F8.3,I5,''_'')')
     *          HA, Direction  ! direction of scan (up = +1, down = -1)
        END IF
        WRITE (Cbuf(1:74),2000) Nobs, Nrun, RA, Nraster, Direction, HA,
     *                          DecLo, DecHi, RAinterval, DecRate, Nskip
 2000   FORMAT (I6,I4,4X,F8.3,I2,9X,I3,3F8.3,2F6.3,I2)
        WakeTime = StartTime - 1.0  ! start logging 1 sec before scan start
        CALL EXEC (11, T, Year1)
        DUT1 = FLOAT (Thour * 60 + Tminute) * 60.0 +
     *         FLOAT (Tsecond) + FLOAT (Tmilsec)/100.0
        Delay = MOD (WakeTime - DUT1 + 216000.0, 86400.0) - 43200.0
        Delay = - Delay
        IF ( Delay .LT. -1.0 ) CALL EXEC (12, 0, 2, 0, Delay)
        Nblock = 0                     ! reset scan block counter
C       repeat
   10     Nsam = 0                     ! reset block sample counter
C         repeat putting data and coords into block buffer
   20       CALL Logger (DHA1, DDec1, Year1, Day1, DUT1, DVM11, DVM21,
     *                   LogErr1)
            CALL Logger (DHA2, DDec2, Year2, Day2, DUT2, DVM12, DVM22,
     *                   LogErr2)
            IF ( .NOT. (LogErr1 .OR. LogErr2) ) THEN
              DHA = (DHA1 + DHA2)/2.0     ! average hour angles
              DDEC = (Ddec1 + Ddec2)/2.0  ! average declinations
              IF ( Nsam .EQ. 0 )          ! block date is that of first sample
     *          WRITE (Cbuf(25:33), '(I5,I4)') Year1, Day1
              DUT = DUT1                  ! ut of first sample of two
              DVM1 = (DVM11 + DVM12)/2.0  ! average dvm1 reading
              DVM2 = (DVM21 + DVM22)/2.0  ! average dvm2 reading
                                       ! write sample packet to buffer
              WRITE (Cbuf(79+Nsam*40:118+Nsam*40), '(2F8.3,F8.1,2F8.3)')
     *                                   DHA, DDec, DUT, DVM1, DVM2
              Nsam = Nsam + 1          ! bump block sample count
            END IF
            TimeLeft = MOD (EndTime - DUT + 216000.0, 86400.0) - 43200.0
            EndOfScan = TimeLeft .LE. 0.0  ! scan end time reached yet?
            IF ( .NOT. EndOfScan .AND. Nsam .LT. 100 ) GO TO 20
C         until block full or end of scan
          IF ( .NOT. EndOfScan ) THEN
C             output full block and start next one
              Nblock = Nblock + 1
              WRITE (Cbuf(11:14), '(I4)') Nblock
              WRITE (Cbuf(75:78), '(I4)') Nsam
              IF ( Nblock .NE. 1 )     ! wait for previous tape write
     *          CALL EXEC (21, Iclass+20000B, Jbuf, 2039)
              CALL EXEC (18, TapeLU, Buf, 2039, 0, 0, Iclass)  ! write to tape
            ELSE
C             output partial block with noise tube reading
              IF ( NTsam .NE. 0 ) THEN
                IF ( Nsam .GE. 100 ) Nsam = 99
C               wait to settle then calibrate using noise diode
                CALL EXEC (12, 0, 2, 0, -20)
                Noise = NTcal (NTsam)
                DUT = -DUT
                WRITE (CBUF(79+Nsam*40:118+Nsam*40),
     *                            '(2F8.3,F8.1,2F8.3)')
     *                              DHA, DDec, DUT, Noise
                Nsam = Nsam + 1
                IF ( LogScan ) WRITE (Cons, '(8X,F8.3,''_'')') Noise
              END IF
              IF ( LogScan ) WRITE (Cons, '(1X)')
              WRITE (Cbuf(75:78), '(I4)') Nsam
              Nblock = Nblock + 1
              WRITE (CBUF(11:14), '(I4)') Nblock
              IF ( Nblock .NE. 1 )     ! wait for previous tape write
     *          CALL EXEC (21, Iclass+20000B, Jbuf, 2039)
              CALL EXEC (18, TapeLU, BUF, 2039, 0, 0, ICLASS)  ! write to tape
          END IF
          IF ( .NOT. EndOfScan ) GO TO 10
C       until end of scan
C       deallocate class number
        CALL EXEC (21, Iclass, Jbuf, 2039)
        FinalDec = DDec
        RETURN
      END
C
      SUBROUTINE Check (Cons, AntennaDec, WantedDec, Prog, Nrun, TapeLU)
C     ================
C
C     Check telescope drive at the end of each run.
C     Take appropriate action depending on fault that is detected.
C
      IMPLICIT NONE
      CHARACTER BELL*1
      LOGICAL DriveOK, PowerFail
      INTEGER Cons, Prog(3), TapeLU, Ispace, MinRun, Nrun, Idrive
      REAL AntennaDec, WantedDec, DecLim
C
      DATA DecLim /2.0/, Ispace /2H  /, MinRun /40/
C
C       check to see whether antenna has scanned
C
        Bell = CHAR (7)
        DriveOK = ABS (MOD (AntennaDec - WantedDec + 900.0, 360.0)
     *                                              - 180.0) .LT. DecLim
        IF ( .NOT. DriveOK ) THEN
          WRITE (Cons, '(A,''*** Antenna Not Moving ***'',A)')
     *           Bell, Bell
          CALL EXEC (1, 113B, Idrive, 1, 7, 7)  ! check powerfail bit
          Idrive = Idrive .AND. 1B
          PowerFail = Idrive .EQ. 0
          IF ( .NOT. PowerFail ) THEN
              WRITE (Cons,1000) Bell, Bell
 1000         FORMAT (A,/'*** Not Power Failure ***',A/
     *                'Program cannot continue with current ',
     *                'servo status')
              CALL EXEC (10, 6HALARM ) ! activate warning beeper
              RETURN
            ELSE
              WRITE (CONS, '(''*** Power Failure ***'')')
              IF ( Nrun .GE. MinRun ) THEN
                  WRITE (Cons,
     *            '(''Too late to continue, SKYMP aborted'')')
                  CALL ShutDown (Cons, TapeLU)
                  IF ( Prog(1) .NE. Ispace ) THEN
                    WRITE (Cons, '(''Program'',3A2,'' scheduled'')')
     *                     Prog
                    CALL EXEC (12, Prog, 2, 0, -10)  ! fire up alternate prog
                  END IF
                  CALL StopProgram
                ELSE
                  WRITE (Cons, '(/''SKYMP scanning continues'')')
              ENDIF
          ENDIF
        ENDIF
        RETURN
      END
C
$ALIAS/POINT/,NOALLOCATE
      SUBROUTINE ShutDown (Cons, TapeLU)
C     ===================
C
C     Close down hardware prior to skymap completion
C
      IMPLICIT NONE
      LOGICAL LongScan, LatScan,
     *        HAstop,   DecStop
      REAL    Long,     Lat,     CmdTime,
     *        Noise,    NTcal,   Npeak
      INTEGER Mes(12),  Type,    Wake,
     *        LogClass, Ncmd    ,CmdClass,
     *        Cons,     TapeLU,  Nsam,
     *        Istat
      EQUIVALENCE (Mes(1),Long),     (Mes(3),Lat),
     *            (Mes(5),Type),     (Mes(6),CmdTime),
     *            (Mes(8),LongScan), (Mes(9),LatScan),
     *            (Mes(10),HAstop),  (Mes(11),DecStop),
     *            (Mes(12),Wake)
      COMMON /POINT/ LogClass, CmdClass
      DATA Type /2/, Long /0.0/, Lat /334.114/, CmdTime /-1.0/,
     *     LongScan /.FALSE./, LatScan /.FALSE./, HAstop /.TRUE./,
     *     DecStop /.TRUE./, Nsam /40/
C
        CALL TapeMark (TapeLU)         ! write double tape mark
        CALL TapeMark (TapeLU)
        CALL RewindTape (TapeLU)       ! Rewind Tape
        Ncmd = CmdClass                ! drive to zenith
        CALL RNRQ (12B, Wake, Istat)
        CALL EXEC (20, 0, Mes, 12, 0, 0, Ncmd)
        CALL RNRQ (5, Wake, Istat)     ! wait 30 sec for antenna to stabilize
        CALL RNRQ (40B, Wake, Istat)
        WAKE = 0
        CALL EXEC (12, 0, 2, 0, -30)
        Noise = NTcal (Nsam)           ! do noise diode calibration
        WRITE (Cons,
     *       '(//''Noise diode amplitude on DVM:'',F8.3,'' mV'')')
     *         Noise
        CALL NDEV (Nsam, Noise, Npeak)
        WRITE (Cons, '(/''RMS noise '',F8.3,'' mV''/)') Noise
        WRITE (Cons, '(''Peak-to-Peak noise '',F8.3,'' mV''/)') Npeak
        RETURN
      END
C
      REAL FUNCTION NTCAL (NSAM)
C     ===================
C
C     calibrate against noise diode
C
      DOUBLE PRECISION DVM, DVMS, DVMSS
C
C
      DATA IDELAY /-2/
C
C       switch off noise diode and select direct 13cm o/p from dvm 1 and 2
        CALL EXEC (2,113B,0,1,3,3)
        CALL EXEC (2,113B,55B,1,5,5)
C       set up fluke dvms
        CALL RMOTE (35) 
*       CALL RMOTE (36) 
        WRITE (35,'(''*S1'')')
*       WRITE (36,'(''*S1'')')
C       sample before switching on noise diode
        DVMSS = 0.0 
        DO I = 1 , NSAM 
   10     READ (35,*,ERR=10) DVM
          DVMSS = DVMSS + DVM*1000.0
        END DO
C       sample while noise diode switched on after a delay
        CALL EXEC (2,113B,4B,1,3,3) 
        CALL EXEC (12,0,2,0,IDELAY) 
        DVMS = 0.0
        NSAM2 = NSAM*2
        DO I = 1 , NSAM2
   20     READ (35,*,ERR=20) DVM
          DVMS = DVMS + DVM*1000.0
        END DO
C       sample after switching off, allow settling time 
        CALL EXEC (2,113B,0,1,3,3)
        CALL EXEC (12,0,2,0,IDELAY) 
        DO I = 1 , NSAM 
   30     READ (35,*,ERR=30) DVM
          DVMSS = DVMSS + DVM*1000.0
        END DO
C       calculate noise diode deflection in mV
        SAMPLE = NSAM2
        NTCAL = (DVMS - DVMSS)/SAMPLE 
        RETURN
      END 
C 
      SUBROUTINE NDEV (NSAM, NOISE, NPK)
C     =============== 
C 
C     calculate rms and peak to peak noise level in mV
C 
      REAL NOISE, NPEAK(2), NPK 
      DOUBLE PRECISION DVM, DVMS, DVMSS 
C 
        DVMS = 0.0
        DVMSS = 0.0 
        NPEAK(1) = 100000.0 
        NPEAK(2) = -100000.0
        NSAM2 = NSAM*2
        DO I = 1 , NSAM2
   10     READ (35,*,ERR=10) DVM
          DVM = DVM*1000.0
          SDVM = DVM
          NPEAK(1) = AMIN1(NPEAK(1),SDVM) 
          NPEAK(2) = AMAX1(NPEAK(2),SDVM) 
          DVMS = DVMS + DVM
          DVMSS = DVMSS + DVM*DVM
        END DO
        NPK = NPEAK(2) - NPEAK(1)
        SAMPLE = NSAM2
        DVM = (DVMSS - DVMS*DVMS/SAMPLE)/(SAMPLE - 1.0)
        NOISE = DSQRT(DVM)
        RETURN
      END
C
      SUBROUTINE WriteHMS (Angle, LU)
C     ===================
C
C     Write angle in hh:mm:ss.s format
C
      IMPLICIT NONE
      INTEGER  LU, Hour, Minute, Second, Tenth
      REAL     Angle, A
C
        A = MOD (Angle + 0.05/240.0 + 720.0, 360.0)  ! round to 0.1 sec
        Hour = A / 15.0
        A = (A - FLOAT (Hour) * 15.0) * 240.0
        Minute = A / 60.0
        A = A - FLOAT (Minute) * 60.0
        Second = A
        Tenth = IFIX ((A - FLOAT (Second)) * 10.0)
        WRITE (LU,1000) Hour, Minute, Second, Tenth
 1000   FORMAT('  ',I2,':',I2.2,':',I2.2,'.',I1.1,'_')
        RETURN
      END
      REAL FUNCTION SiderealTime ()
C     ==========================
C
      IMPLICIT NONE
      INTEGER T(5), Year, Day, Hour, Minute, Second, MilSec
      REAL    Offset, Tsec, BaseOffset, LongTime
      EQUIVALENCE   (T(1),MilSec), (T(2),Second),
     *              (T(3),Minute), (T(4),Hour),
     *              (T(5),Day)
      DATA BaseOffset /84806.882/,     ! base sidereal time
     *     LongTime   /6644.4/         ! station longitude in time
C
        CALL EXEC (11, T, Year)
        Tsec = FLOAT (Hour*60 + Minute)*60.0 + FLOAT (Second) +
     *         FLOAT (MilSec)/100.0
        Offset = FLOAT((Year - 1979)*365 + (Year - 1977)/4 + Day - 258)
     *               * 236.55536 + BaseOffset + LongTime
        Tsec = Tsec * 1.002 737 909 3 + Offset
        SiderealTime = MOD (Tsec, 86400.0)
        RETURN
      END
      SUBROUTINE Logger (HA, Dec, Yr, Dy, UT, DVM1, DVM2, LogErr)
C     =================
C
C     read antenna coordinates, time and dvm1
C
      IMPLICIT NONE
      LOGICAL LogErr
      INTEGER Ibuf(6), T(5), Year, Day, Yr, Dy,
     *        Hour, Minute, Second, MilSec,
     *        HAinteger, HAfraction, DECinteger, DECfraction
      REAL HA, Dec, UT, DVM1, DVM2
      CHARACTER Cbuf*12
      EQUIVALENCE (Ibuf, Cbuf), (MilSec, T(1)), (Second, T(2)),
     *            (Minute, T(3)), (Hour, T(4)), (Day, T(5))
C
C       read radiometer output from fluke 8840 dvms
        READ (35, *, ERR=10) DVM1
*       READ (36, *, ERR=10) DVM2
        DVM1 = DVM1*1000.0             ! convert to millivolts
        DVM2 = DVM2*1000.0
C       read antenna angles from dio (ascii immediate, 6 words)
        CALL EXEC (1, 0B + 13B, Ibuf, 6, 1, 3)
C       get time (ut), day & year
        CALL EXEC (11, T, Year)
        UT = FLOAT (Hour*60 + Minute)*60.0 + FLOAT (Second) +
     *       FLOAT (MilSec)/100.0
        Dy = Day
        Yr = Year
C       decode hour angle
C       mask out sign an tach bits
        Ibuf(1) = Ibuf(1) .AND. 171777B
C       read ascii equivalent and convert to degrees
        READ (Cbuf(1:6), '(I3,I3)', ERR=10) HAinteger, HAfraction
        HA = FLOAT(HAinteger) + FLOAT(HAfraction)/1000.0
        IF ( HA .GT. 180.0 ) HA = HA - 360.0
C       decode declination
C       mask out sign an tach bits
        Ibuf(4) = Ibuf(4) .AND. 171777B
C       read ascii equivalent and convert to degrees
        READ (Cbuf(7:12), '(I3,I3)', ERR=10) DECinteger, DECfraction
        Dec = FLOAT(DECinteger) + FLOAT(DECfraction)/1000.0
        IF ( Dec .GT. 180.0 ) Dec = Dec - 360.0
        LogErr = .FALSE.
        RETURN
C       error return
   10     LogErr = .TRUE.
          RETURN
      END
      SUBROUTINE TapeMark (LU)
C     ===================
C
C     Write tape mark to specified LU
C
        CALL EXEC (3, LU + 100B)
      END
      SUBROUTINE RewindTape (LU)
C     =====================
C
C     Rewind tape on specified LU
C
        CALL EXEC (3, LU + 400B)
      END
      SUBROUTINE StopProgram
C     ======================
C
C     Stop current program
C
        CALL EXEC (6)
      END
