C SPCAL35.SUB C calibration subroutines for lu 35 only, C with video output patched in place of humidity C SUBROUTINE CALT (IDVMSL,NDSEL,DNOISE,ISYNTH,INDEX,FREQUENCY, & NTRIES,PRGNAM,CLOG,ILOG,OBSLG,CHECKVID, & TSYS,DTSYS,TSYSR,DTSYSR, FAULT) ******************************************************************* * calibration for absolute system temperature * rev 1991 04 03 for AGC'd video amp, & rvised error calculation * rev 1993 12 30 printouts on error * rev 1994 01 21 write errors via OBSLG * rev 1995 10 18 if CHECKVID, call VIDLEV to check video level * rev 1996/10/29 mods for uncontrolled synthesizer * CHARACTER CLOG*76, ! input OBSLG message buffer & PRGNAM*6, ! input program name & SIGNALID*3 ! local * LOGICAL*2 CHECKVID ! input check video level LOGICAL*2 FAULT ! output true if ntries failures * INTEGER*2 IDVMSL(1), ! input voltmeter input selection & ISYNTH(1), ! input lo synth type array & NDSEL(1), ! input noise cal selection array & INDEX, ! input pointer for above arrays & NTRIES, ! input no. tries if cal fails & ILOG(1), ! input OBSLG message buffer & OBSLG(1), ! input OBSLG name & ISAMPLES(3), ! RDPWR no. of ok dvm readings & IERROR, ! local & ITIME(5), ! local time array ms s m h d & IY, ! local year & NREAD(3), ! local & IPAUSE(3) ! local wait time between ops * REAL*4 DNOISE(1), ! input cal noise diode temp (K) & TSYS, ! output system temp (K), video & DTSYS, ! output error in system temp (K) & TSYSR, ! output system temp (K), rad & DTSYSR, ! output error in system temp (K) & SYST, ! local system temp (vid) & TRMS ! local error in system temp * REAL*8 FREQUENCY, ! input synth freq (MHz) & DVM(3), ! RDPWR sum of dvm readings & DVM2(3), ! RDPWR sum sqd of dvm readings & ADVM(3), ! local average of dvm readings & RMS(3) ! local avg of dvm sqd readings * INCLUDE COMMONLUS.SUB * * number of readings with LO off, LO on CAL on, LO off cal off DATA NREAD / 25, 50, 50/ * pause in seconds for settling between changes LO off,on ND on,off DATA IPAUSE / -8, -4, -4 / DATA SIGNALID / 'vid' / * * set up FLUKE voltmeters - remote mode, reset, medium sample rate CALL RMOTE (lu8840A) WRITE (lu8840A,'(''*S1'')') * * initialize number of tries at calibration ITRIES = 0 FAULT = .FALSE. * * revised calibraton sequence for AGC'd video amp * j = 1 LO off CAL off; j = 2 LO on CAL on; j = 3 LO on CAL off * 10 DO J = 1, 3 IF (J .EQ. 1) THEN * LO off, CAL off * turn off LO to set zero power signal level IF (ISYNTH(INDEX) .NE. 0) THEN CALL SETLO (ISYNTH, INDEX, 0D0) END IF * turn off the calibration noise diode CALL EXEC (2,113b,0,1,3,3) ELSE IF (J .EQ. 2) THEN * LO on, CAL on * set LO synthesizer to observing frequency CALL SETLO (ISYNTH, INDEX, FREQUENCY) * turn on the calibration noise diode CALL EXEC (2,113b,NDSEL(INDEX),1,3,3) ELSE IF (J .EQ. 3) THEN * LO on, CAL off * turn off the calibration noise diode CALL EXEC (2,113B,0,1,3,3) END IF * * select voltmeter inputs via the DIO CALL EXEC (2,113b,IDVMSL(INDEX),1,5,5) * * pause to settle before taking readings CALL EXEC (12,0,2,0,IPAUSE(J)) * * initialize no. of samples taken, sum of readings, sum of squares * for correlator video square law detector output ISAMPLES(J) = 0 DVM(J) = 0D0 DVM2(J) = 0D0 * * voltmeter sampling loop DO I = 1, NREAD(J) * video signal (square law detector) CALL RDPWR (LU8840A,1,J,ISYNTH,INDEX, ISAMPLES,DVM,DVM2) END DO * * initialise the error count IERROR = 0 IF (ISAMPLES(J) .GT. 2) THEN * compute average ADVM(J) = DVM(J) / ISAMPLES(J) * root mean square error = standard deviation RMS(J) = DSQRT((DVM2(J) & - DVM(J)**2/ISAMPLES(J)) & / (ISAMPLES(J) - 1)) ELSE ADVM(J) = 1D0 RMS(J) = 1D0 IERROR = 1B PRINT *,'TOO MANY BAD READINGS' END IF END DO * * print out the results, check for problems * check that the noise calibration was detected * ok if (cal on - cal off) > 3 * rms noise(cal on + cal off) IF (ABS(ADVM(2)-ADVM(3)) .LT. 3*(RMS(3)+RMS(2))) THEN PRINT *,SIGNALID,'Cal signal not seen' IERROR = 10B + IERROR END IF * * check that lo synth off changed the signal level * ok if (lo on - lo off) > 3 * rms noise(lo on + lo off) IF (ISYNTH(INDEX) .EQ. 0) THEN * uncontrolled synthesizer ADVM(1) = 0D0 RMS(1) = 0D0 END IF IF (DABS(ADVM(3)-ADVM(1)) .LT. 3*(RMS(3)+RMS(1))) THEN PRINT *,SIGNALID,'No change with LO off' IERROR = 100b + IERROR END IF * * calibration appears acceptable if no errors * system temperature : SYST = (ADVM(3)-ADVM(1)) / (ADVM(2)-ADVM(3)) & * DNOISE(INDEX) * * and error : TRMS = SYST * & DSQRT (((RMS(3)**2 + RMS(1)**2) / & (ADVM(3) - ADVM(1))**2) + & ((RMS(2)**2 + RMS(3)**2) / & (ADVM(2) - ADVM(3))**2)) IF (SYST .LT. 25.0) THEN PRINT *,'T',SIGNALID,' too low' IERROR = 1000B + IERROR END IF IF (SYST .GT. 1000.0) THEN PRINT *,'T',SIGNALID,' too high' IERROR = 10000B + IERROR END IF * * check if either calibration failed IF (IERROR .GT. 0) THEN CALL TIMESTAMP (ITIME,IY,PRGNAM,CLOG) CLOG(26:) = 'Calibration failure' CALL EXEC (24,OBSLG,1,0,0,0,0,ILOG,38) * print results for both calibrations if error occurs: WRITE (CLOG,'(A3,3(F8.6,''+-'',F8.6), & '' Tsys'',f6.2,''+-'',f5.2,''K'')',ERR=1100) & SIGNALID, & ADVM(1), RMS(1), & ADVM(2), RMS(2), & ADVM(3), RMS(3), & SYST, TRMS 1100 CALL EXEC (24,OBSLG,1,0,0,0,0,ILOG,38) END IF * * if requested, check video level difference from nominal IF (CHECKVID) CALL VIDLEV(ADVM(3)) * IF (IERROR .GT. 0) THEN * check number of tries at calibrating IF (ITRIES .LT. NTRIES) THEN ITRIES = ITRIES + 1 * and try again GO TO 10 ELSE TSYS = 1.0 DTSYS = 1.0 FAULT = .TRUE. PRINT *,'QUIT TEST' END IF END IF * * if video signal in voltmeter OK, use voltmeter rather than radiometer * this is the normal condition IF (IERROR .EQ. 0) THEN TSYS = SYST DTSYS = TRMS END IF * * return radiometer calibration as well TSYSR = 0.0 DTSYSR = 0.0 * RETURN END ********************** SUBROUTINE RDPWR (LU8840,K,J,ISYNTH,INDEX, ISAMPLES,DVM,DVM2) ********************** * inputs : LU8840 LU of Fluke voltmeter * K 1 = video signal * J 1 = LO off CAL off, 2 LO on CAL on, 3 CAL off * ISYNTH array of LO synthesizers * INDEX index selecting LO synthesizer in use * outputs: ISAMPLES(J) number of readings successfully taken * DVM(J) sum of signal power readings * DVM2(J) sum of signal power squared readings * INTEGER LU8840, K, J, ISYNTH(1), INDEX, ISAMPLES(3) REAL*8 RDVM, DVM(3), DVM2(3) * * in voltmeter sampling loop READ (lu8840,*,ERR=20) RDVM * override reading if synthesizer uncontrolled IF (J .EQ. 1 .AND. ISYNTH(INDEX) .EQ. 0) RDVM = 0 * number of samples succesfully read ISAMPLES(J) = ISAMPLES(J) + 1 * sum the readings of signal power DVM(J) = DVM(J) + RDVM * sum the squares of the signal power DVM2(J) = DVM2(J) + RDVM**2 20 CONTINUE RETURN END *************