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