FTN77
$FILES 0,1
      PROGRAM CALT
*******************************************************************
*     System temperature calibration <990524.0708>
*     Also prints Sidereal time and antenna position.
*     source code : in /mike/progs/calt.ftn
*     compile: ftn7x calt 0 -
*     link: link  +eb calt.rel calt.run::programs
*
*     mod 1991 12 03: Tsys updated for new amplifiers.
*     mod 1995 04 24 add optional signal input selection
*     mod 1995 10 04 use lu35 fluke unstead of failed lu36
*     mod 1995 10 18 add check for correlator signal level
*
*     SYSTEM   is the system designation
*     TNOISE   is the calibration noise diode temperature in K
*     TNOM     is the nominal system temperature in K
*     IDVMSL   is the DVM input selector for the given receiver
*     NDSEL    is the calibration noise diode selector
*     LU       is the output logical unit, given when running the program
*     LU8840   is the logical unit of the Fluke 8840 voltmeter
*
      parameter (maxi = 9)    ! number of systems available
      character date*30, cangles*12, answer*1, buffer*80, junk,
     &          system(maxi)*4, caltfl*10, cbuf*4, ctemp*4, INPUTID*1
      logical   noend
      integer   ibuf(4), itm(5), angles(6), idate(15),
     *          ndsel(maxi), idvmsl(maxi), INPUTS(MAXI)
      real*4    tnoise(maxi), tnom(maxi), SFOCUS(MAXI), STILT(MAXI)
      real*8    RDVM, DVM(2), DVM2(2), ADVM(2),
     *          DMSJ, DMS(2), RMS(2), TSON, DT
*
      equivalence (idate,date), (angles,cangles)
*
*  index  1      2      3      4      5      6      7      8       9
      DATA
     & SYSTEM     ! system identity
     & /'2.5S','3.6D','4.5S','  5S','  6S','  6D',' 13S',' 18S',' 18U'/,
     & TNOISE     ! calibration noise diode value
     & / 158.0,  10.0,  14.2,  17.0,   5.8,  0.83,  3.96,   6.2,  6.2/,
     & TNOM       ! nominal system temperature
     & / 132.0,  65.0, 135.0,  50.0,  40.0,  49.0,  40.0,  35.0, 35.0/,
     & IDVMSL     ! dvm select code via dio
     & /   66b,   11b,   66B,   66B,   33b,   33b,   55b,   77b,  77B/,
     & NDSEL      ! noise diode select code via dio
     & /     2,     1,     2,     2,     2,     3,     4,     5,    5/,
     & INPUTS     ! 1 = radiometer, 2 = GPR, 3 = corr video
     & /    23,     1,    23,    23,   123,     1,   123,   123,  123/,
     & SFOCUS     ! standard subreflector focus position
     & /   8.0,   8.0,   8.0,   8.0,   8.0,   8.0,   8.0,   5.0,  8.0/,
     & STILT      ! standard subreflector tilt position
     & / -0.77, -0.77, -0.77, -0.77, -0.77, -0.77, -0.77,   9.7, -0.77/,
*
     *     lu /1/, caltfl/'CALT::HELP'/
*
*     *RU,CALT,LU   To run the program on the selected logical unit.
*     --------------------------------------------------------------
      CALL RMPAR(ITM)
      IF (ITM(1) .EQ. 1 .OR. ITM(1) .EQ. 5 .or.
     *    ITM(1) .EQ. 6 .OR. ITM(1) .EQ. 7)  LU = ITM(1)
*
      CALL FSYSU(LU,LU)
*
*     clear screen on hp vdu's
  100 IF (lu .eq. 1 .or. lu .eq. 5) then
          write (lu,'(4a)') char(27),'H',char(27),'J_'
      END IF
*
*     ensure cal noise diodes are off; restart here for new system test
      CALL EXEC (2,113b,0,1,3,3)
  
*     Calt instructions
      PRINT *,'Set up the receiver in the absolute total power mode'
      PRINT *,'as per the Receiver and Radiometer Users Guide'
      PRINT *,'*'
      PRINT *,'Remove interference sources:'
      PRINT *,'Disconnect the MKIII Phase Cal cable at N35'
      PRINT *,'Set the PM6654 meter in T01 to ST BY'
*
*     find the system in use
*     ----------------------
  120 write (lu,'(/a)') 'Systems available :'
      write (lu,'(20a5)') (system(i), i = 1,maxi)
      write (lu,'(a)')'Use ? _'
      read (lu,'(a)') cbuf
      call UPCASE (cbuf)
      if (cbuf(1:1) .eq. '/') stop 'bye !'
*
*     right justify the input characters
      do while (cbuf(4:4) .eq. ' ')
          ctemp = ' '
          ctemp(2:4) = cbuf(1:3)
          cbuf = ctemp
      end do
*
*     find the system index
      index = 0
      do i = 1,maxi
          if (system(i) .eq. cbuf(1:4)) index = i
      end do
*
      if (index .eq. 0) then
          write (lu,'(3a)') 'WHAT, SYSTEM =',cbuf,' ?'
          go to 120
      end if
*
*     Check that the subreflector is correctly positioned
*     ---------------------------------------------------
      CALL RHYP (FOCUS, TILT)
      IF (ABS(FOCUS-SFOCUS(INDEX)) .GT. 0.5) THEN
          PRINT *,'Focus =',FOCUS
          PRINT *,'WARNING - SUBREFLECTOR FOCUS WRONG FOR THIS SYSTEM'
      END IF
C
      IF (ABS(TILT-STILT(INDEX)) .GT. 0.5) THEN
          PRINT *,'Tilt =',TILT
          PRINT *,'WARNING - SUBREFLECTOR TILT WRONG FOR THIS SYSTEM'
      END IF
*
*     Check the noise calibration for the chosen frequency
*     ----------------------------------------------------
  160 write (lu,1600) system(index), tnoise(index)
 1600 format(/a,' noise calibrator signal assumed to be',f7.2,' K')
      write (lu,1610)
 1610 format(/'If okay hit RETURN, or enter new value (in K) : _')
      DO I = 1,79
          BUFFER(I:I) = ' '
      END DO
      read (lu,'(a)',err=170) buffer
      buffer(79:79) = '/'
      TVAL  = 0.0
      read (buffer,*,iostat=ios,err=170) tval
  170 if (ios .eq. 0 .and. tval .gt. 0.0) tnoise(index) = tval
*
*     for systems that can be read either thru system radiometer (1),
*     GPR (2) or correlator Video (3), choose inputs
*
*     default to system radiometer
  180 ISIGNAL = IDVMSL(INDEX)
      LU8840 = 35
*
      IF (INPUTS(INDEX) .EQ. 123) THEN
          PRINT *,'Use system radiometer    (RETURN)'
          PRINT *,'or General Purpose Radiometer (G)'
          PRINT *,'or correlator Video signal    (V) ? _'
      ELSE IF (INPUTS(INDEX) .EQ. 23) THEN
          PRINT *,'Use General Purpose Radiometer (G)'
          PRINT *,'or correlator Video signal     (V) ? _'
      END IF
*
      INPUTID = 'R'       ! default to radiometer input
      IF (INPUTS(INDEX) .GT. 1) THEN
          READ '(A)', INPUTID
          CALL UPCASE (INPUTID)
*         error check
          IF (INPUTS(INDEX) .EQ. 23 .AND.
     &        (INPUTID .NE. 'G' .AND. INPUTID .NE. 'V')) THEN
              PRINT *,'G or V must be specified'
              GO TO 180
          END IF
*         set inputs according to selection
          IF (INPUTID .EQ. 'G') THEN
              ISIGNAL = 66B        ! dvm input signal select
              LU8840 = 35          ! fluke voltmeter lu
          ELSE IF (INPUTID .EQ. 'V') THEN
              ISIGNAL = 66B        ! video if lu 36 working
              LU8840 = 36          ! if lu36 working
****
              ISIGNAL = 00B        ! video if lu36 not working
              LU8840 = 35          ! if lu36 not working
****
          END IF
      END IF
*
      PRINT *,'Calibrate using _'
      IF (INPUTID .EQ. 'G') THEN
          PRINT *,'GPR'
      ELSE IF (INPUTID .EQ. 'V') THEN
          PRINT *,'correlator video'
      ELSE
          PRINT *,SYSTEM(INDEX),' radiometer'
      END IF
*
*     Fluke 8840 set to medium speed
      write (lu8840,'(''*S1'')')
*
c     write (lu,'(/a,i2,a)') 'FLUKE lu',lu8840,
c    &                   ' input selector (rack N06) : _'
      IF (ISIGNAL .LT. 0) then
*         Input frequency not computer selectable
          WRITE (LU,2100)
 2100     FORMAT(/'FLUKE LU35: Select required input'
     &           /'hit return when ready _')
          read (lu,'(a)') junk
      ELSE
*         Input signal to fluke voltmeter selected by computer
          CALL EXEC(2,113B,ISIGNAL,1,5,5)
          CALL EXEC (12,0,2,0,-1)
      END IF
*
*     Select number of DVM samples
*     ----------------------------
      ISAM = 16
      SAMPL = FLOAT(ISAM)
*
*     Obtain current sidereal time
*     ----------------------------
      STNOW = TIME(2)
      ISTH = STNOW / 3600.0
      ISTM = (STNOW - FLOAT(ISTH) * 3600.0) / 60.0
      ISTS = STNOW - FLOAT(ISTH) * 3600.0 - FLOAT(ISTM) * 60.0
*
*     Obtain current antenna HA and DEC
*     ---------------------------------
      CALL EXEC(1,11,ANGLES,6,1,3)
*     Mask tachometer sign and magnitude bits
      ANGLES = ANGLES .AND. 171777B
      ANGLES(4) = ANGLES(4) .AND. 171777B
      READ (CANGLES,3200,iostat=ierr,err=330) HANOW, DECNOW
 3200 FORMAT(2F6.3)
  330 IF (IERR .NE. 0)  THEN
        WRITE(LU,3402) ISTH, ISTM, ISTS
 3402   FORMAT(/'Sidereal time : hh mm ss',
     *    5X, 'Antenna position is unreadable ****'
     *      //'The calibration check follows :')
      ELSE
        WRITE (LU,3400) ISTH, ISTM, ISTS, HANOW, DECNOW
 3400   FORMAT(/'Sidereal time : hh mm ss',5X,'Antenna  HA     DEC'
     *       /15X,3I3,10X,2F8.3
     *      //'The calibration check follows :')
      END IF
*
*     Program repeats from here for same radiometer
*
  500 CONTINUE
          IF (ISIGNAL .GE. 0) THEN
*             Input frequency selected by computer
              CALL EXEC (2,113B,ISIGNAL,1,5,5)
              CALL EXEC (12,0,2,0,-1)
          END IF
*         read radiometer output with noise cal off, then on
          DO J = 1,2
              DVM(J) = 0.0
              DVM2(J) = 0.0
              DO I = 1,ISAM
                  read (LU8840,*) rdvm
                  IF (I .EQ. 9) WRITE (LU,'('' '')')
                  write (lu,'(f9.6,''_'')') rdvm
*                 Sum DVM and DVM-squared readings
                  DVM2(J) = DVM2(J) + RDVM*RDVM
                  DVM(J) = DVM(J) + RDVM
              end do
*             Calculate average DVM reading and MS and RMS error
              ADVM(J) = DVM(J) / SAMPL
              DMS(J) = (DVM2(J) - DVM(J)*DVM(J)/SAMPL) / (SAMPL - 1.0)
              DMSJ = DMS(J)
              RMS(J) = DSQRT(DMSJ)
              WRITE (LU,5600) ADVM(J), RMS(J)
 5600         FORMAT(/'average = ',F9.6,' +- ',F9.6)
*
              if (J .EQ. 1) then
*                 turn on noise cal, pause to settle
                  CALL EXEC (2,113B,ndsel(index),1,3,3)
                  call exec (12,0,2,0,-2)
              else
*                 Turn off noise cal
                  CALL EXEC (2,113B,0,1,3,3)
              end if
          end do
*
*         Check for noise tube fire :
*         Noise cal signal must be greater than 5 times RMS noise
*         with the noise cal off.
          RDVM = 5.0 * RMS(1) + DABS(ADVM(1))
          IF (DABS(ADVM(2)) .LT. RDVM) then
              write (lu,'(''Noise calibration signal not seen !'')')
          end if
*         Calculate system temp and RMS error
          TSON = ADVM(1) / (ADVM(2) - ADVM(1)) * TNOISE(index)
          DT = TSON * DSQRT(DMS(1) / ADVM(1)**2 + (DMS(1)+DMS(2))/
     *             (ADVM(2) - ADVM(1))**2)
*
          IF (INPUTID .EQ. 'V') THEN
*             check signal level into correlator
              CALL VIDLEV (ADVM(1))
          END IF
*
*         print the results
          call FTIME (idate)
          write (lu,'(/a)') date
          write (lu,1600) system(index), tnoise(index)
          write (lu,7000) tnom(index), tson, dt
 7000     format(/'expected system temperature =',i4,' K'
     *           /'measured system temperature =',F7.2,' +- ',F5.2,' K')
          write (lu,7010) system(index)
 7010     format(/'Repeat the test on ',a,' (Yes or No) ? _')
          read (lu,'(a)') answer
          call UPCASE (answer)
          if (answer .eq. 'Y' .or. answer .eq. 'T') go to 500
*
  800 write (lu,'(/''Test another receiver (Yes or No) ? _'')')
      read  (lu,'(a)') answer
      call UPCASE (answer)
      if (answer .eq. 'Y' .or. answer .eq. 'T') go to 100 
* 
  900 STOP 'bye from CALT !'
      end 
********************** 
      FUNCTION TIME(K)
**********************
*        Return UT (K = 1), or ST (K = 2) in seconds
* 
         INTEGER IT(5)
         EQUIVALENCE (IT(1),MS), (IT(2),IS), (IT(3),M), 
     *               (IT(4),IH), (IT(5),ID) 
         DATA BASEOF/84 806.882/, LSTDAY/0/, RATE/0.002 737 909 3/
* 
*        UT calculation 
*        -------------- 
         CALL EXEC(11,IT,IYR) 
         TIME = FLOAT(IH*60 + M)*60.0 + FLOAT(IS) + FLOAT(MS)/100.0 
         IF (K .LT. 2)  RETURN
* 
*        ST calculation 
*        --------------
         IF (ID .NE. LSTDAY)
     *      OFFSET = FLOAT((IYR-1979)*365 + (IYR-1977)/4 + ID - 258)
     *               * 236.55536 + BASEOF + 6644.4
         TIME = TIME + TIME * RATE + OFFSET
         TIME = TIME - FLOAT(IFIX(TIME/86400.0)) * 86400.0
         RETURN
         END
*********************************
      SUBROUTINE VIDLEV (VOLTAGE)
*********************************
*     check video signal level and warn if too low or high
      REAL*4  VOLTAGE     ! input voltage from video square law detector
      REAL*4  DBOFF       ! offset of detector voltage from nominal in dB
      CHARACTER INCMES*10 ! local "increase" message
      CHARACTER REDMES*8  ! local "reduce" message
      CHARACTER CORMES*11 ! local "correlator" message
      CHARACTER ATTMES*14 ! local "attenuation by" message
      CHARACTER DBMES*10  ! local "dB" message
*
      DATA INCMES /'Increase '/
      DATA REDMES /'Reduce '/
      DATA CORMES /'correlator '/
      DATA ATTMES /'attenuation by'/
      DATA DBMES  /' dB at N07'/
*
*     offset in dB from nominal video level of -10dB on -20dBm scale of HP3400 
*     which equals a video square law detector voltage of 0.074 volts
*     or 10log10(V) = -11.3

      DBOFF = 10.0*ALOG10(VOLTAGE) + 11.3
      IF (DBOFF .LT. -1.0) THEN
          PRINT 1000, REDMES,CORMES,ATTMES,IABS(DBOFF),DBMES
      ELSE IF (DBOFF .GT. +1.0) THEN
          PRINT 1000, INCMES,CORMES,ATTMES,IABS(DBOFF),DBMES
      END IF
 1000 FORMAT (//3A,I3,A//)
      RETURN
      END
****************
         include NCHAR.SUB	! number of non-blank chars in string
         include UPCASE.SUB	! convert characters to uppercase
         include RHYP.SUB	! read hyperbola tilt and focus
****************
