C*CALBW -- Return the bandwidth corresponding to a given mode. C+ DOUBLE PRECISION FUNCTION CALBW (CHAN, STEP) INTEGER CHAN, STEP C C This function will return the bandwidth corresponding to a given C mode. C C Returns: C CALBW : The bandwidth of the given mode expressed in Hertz. C A negative value is returned if the input C parameters are incorrect. C Arguments: C CHAN (input) : The instrument mode, as follows: C C CHAN Meaning Valid values for STEP C ---- ------- --------------------- C 0 SFR Channel 0 0 - 31 (not used) C 1 SFR Channel 1 0 - 31 (not used) C 2 SFR Channel 2 0 - 31 (not used) C 3 SFR Channel 3 0 - 31 (not used) C 4 LFC High band 0 - 3 C 5 LFC Low band 0 - 3 C C STEP (input) : The step or channel in the given mode as indicated C in the instrument status data. C-- C Version 1.0 27-Feb-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- DOUBLE PRECISION LFCHI(0:3), LFCLO(0:3), SFR(0:3) C C The following statements contain the effective bandwidths, expressed C in Hertz, for each of the frequency bands of the instruments. The C DATA statements contain the same values found in the files SFR_BWD.CAL C and LFC_BWD.CAL on the optical disk. C DATA LFCHI /2.670D0, 4.670D0, 8.400D0, 15.00D0/ C DATA LFCLO /0.267D0, 0.467D0, 0.840D0, 1.500D0/ C DATA SFR /6.000D0, 52.00D0, 480.0D0, 3900.D0/ C C Assume failure. C CALBW = -1.0D0 C C Check the input values for validity. C IF ((CHAN .GE. 0) .AND. (CHAN .LE. 3)) THEN IF ((STEP .LT. 0) .OR. (STEP .GT. 31)) RETURN ELSE IF ((CHAN .EQ. 4) .OR. (CHAN .EQ. 5)) THEN IF ((STEP .LT. 0) .OR. (STEP .GT. 3)) RETURN ELSE RETURN END IF C C Return the bandwidth based on the given parameters. C IF ((CHAN .GE. 0) .AND. (CHAN .LE. 3)) THEN CALBW = SFR(CHAN) ELSE IF (CHAN .EQ. 4) THEN CALBW = LFCHI(STEP) ELSE CALBW = LFCLO(STEP) END IF C C Return to the calling routine. C RETURN END C*CALELN -- Return the AC electrical length of the given antenna. C+ DOUBLE PRECISION FUNCTION CALELN (ANT) INTEGER ANT C C This function will return the AC electrical length of the given C antenna. C C Returns: C CALELN : The AC electrical length of the given antenna C expressed in meters. The electrical length of the C magnetic antennas are set to 1.0m for convenience. C A negative value is returned if the input C parameters are incorrect. C Arguments: C ANT (input) : The antenna, as follows: C C ANT Meaning C --- ------- C 0 Es C 1 Ez C 2 Ex C 3 Magnetic C-- C Version 1.0 27-Feb-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- DOUBLE PRECISION LENGTH(0:3) C C The following statements contain the effective AC electrical lengths, C expressed in meters, of the various antennas. The values are used to C convert the measured voltages to electric field strength. The C magnetic antennas are treated as having an effective electrical length C of 1.0 meter for convenience in calculations. C DATA LENGTH /0.6D0, 5.0D0, 101.4D0, 1.0D0/ C C Assume failure. C CALELN = -1.0D0 C C Check the input values for validity. C IF ((ANT .LT. 0) .OR. (ANT .GT. 3)) RETURN C C Return the electrical length based on the given parameters. C CALELN = LENGTH(ANT) C C Return to the calling routine. C RETURN END C*CALFRQ -- Return the frequency corresponding to a given step. C+ DOUBLE PRECISION FUNCTION CALFRQ (CHAN, STEP) INTEGER CHAN, STEP C C This function will return the frequency corresponding to a given C correlator and step or channel. C C Returns: C CALFRQ : The frequency of the given mode expressed in Hertz. C A negative value is returned if the input C parameters are incorrect. C Arguments: C CHAN (input) : The correlator or receiver channel, as follows: C C CHAN Meaning Valid values for STEP C ---- ------- --------------------- C 0 SFR Channel 0 0 - 31 C 1 SFR Channel 1 0 - 31 C 2 SFR Channel 2 0 - 31 C 3 SFR Channel 3 0 - 31 C 4 LFC High band 0 - 3 C 5 LFC Low band 0 - 3 C C STEP (input) : The step or channel in the given mode as indicated C in the instrument status data. C-- C Version 1.0 20-Feb-1990 Scott C. Allendorf C - Original version. C Version 2.0 14-Sep-1990 Scott C. Allendorf C - Modify to calculate frequencies rather C than using a table. C----------------------------------------------------------------------- LOGICAL INIT INTEGER I, J DOUBLE PRECISION A(0:31), B(0:3), LFCHI(0:3), LFCLO(0:3) DOUBLE PRECISION SFREQ(0:127) SAVE INIT, SFREQ DATA INIT /.TRUE./ C C The following statements contain the coefficients necessary to C calculate the center frequencies of the 128 SFR steps. C DATA A /243.0D0, 242.0D0, 241.0D0, 240.0D0, 239.0D0, 238.0D0, + 237.0D0, 236.0D0, 235.0D0, 234.0D0, 232.0D0, 231.0D0, + 229.0D0, 227.0D0, 226.0D0, 224.0D0, 223.0D0, 221.0D0, + 219.0D0, 217.0D0, 215.0D0, 213.0D0, 210.0D0, 208.0D0, + 205.0D0, 203.0D0, 200.0D0, 197.0D0, 194.0D0, 190.0D0, + 187.0D0, 183.0D0/ C DATA B /1990.0D0, 15580.0D0, 126810.0D0, 1014570.0D0/ C C The following statements contain the center frequencies, expressed in C Hertz, of the various channels of the LFC. C DATA LFCHI /17.8D0, 31.2D0, 56.2D0, 100.0D0/ C DATA LFCLO /1.78D0, 3.12D0, 5.62D0, 10.00D0/ C C Assume failure C CALFRQ = -1.0D0 C C Check the input values for validity. C IF ((CHAN .GE. 0) .AND. (CHAN .LE. 3)) THEN IF ((STEP .LT. 0) .OR. (STEP .GT. 31)) RETURN ELSE IF ((CHAN .EQ. 4) .OR. (CHAN .EQ. 5)) THEN IF ((STEP .LT. 0) .OR. (STEP .GT. 3)) RETURN ELSE RETURN END IF C C Determine if we need to initialize the SFR frequency array. C IF ((CHAN .LE. 3) .AND. INIT) THEN C C Indicate that the initialization has been completed. C INIT = .FALSE. C C Calculate the center frequencies in Hertz of the 128 SFR steps. C DO 20 I = 0, 3 DO 10 J = 0, 31 SFREQ(32 * I + J) = 2.60625D8 / A(J) / + DBLE (8 ** (3 - I)) - B(I) 10 CONTINUE 20 CONTINUE END IF C C Return the frequency based on the given parameters. C IF (CHAN .LE. 3) THEN CALFRQ = SFREQ(32 * CHAN + STEP) ELSE IF (CHAN .EQ. 4) THEN CALFRQ = LFCHI(STEP) ELSE CALFRQ = LFCLO(STEP) END IF C C Return to the calling routine. C RETURN END C*CALGAI -- Return the data value corrected for the gain setting. C+ DOUBLE PRECISION FUNCTION CALGAI (CHAN, OFFSET, STATUS, VALUE) INTEGER CHAN, OFFSET, STATUS(27) DOUBLE PRECISION VALUE C C This function corrects the given data value for the current gain C setting as determined by the current mode of the instrument. C C Returns: C CALGAI : The data value corrected for the gain setting. A C negative value is returned if the input parameters C are incorrect. C Arguments: C CHAN (input) : The SFR channel, as follows: C C CHAN Meaning C ---- ------- C 0 SFR Channel 0 C 1 SFR Channel 1 C 2 SFR Channel 2 C 3 SFR Channel 3 C C OFFSET (input) : The offset of the byte in the word, counting from C zero at the most significant byte (0 - 3). C STATUS (input) : The array of status words returned by GETSTS. C VALUE (input) : The data value to be corrected. C-- C Version 1.0 28-Mar-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- C C Assume failure. C CALGAI = -1.0D0 C C Check the input values for validity. C IF (VALUE .LT. 0.0D0) RETURN IF ((CHAN .LT. 0) .OR. (CHAN .GT. 3)) RETURN IF ((OFFSET .LT. 0) .OR. (OFFSET .GT. 3)) RETURN C C Assume that we are in high gain mode. C CALGAI = VALUE C C The gain setting only affects the upper three channels of the SFR. C IF (CHAN .EQ. 0) RETURN C C Check to see if we are in low gain mode or if we are in toggle gain C mode and in the low gain part of the toggle, increasing the amplitude C by 30dB if we are. C IF ((STATUS(7) .EQ. 0) .OR. (STATUS(7) .EQ. 2) .OR. + ((STATUS(7) .EQ. 3) .AND. (OFFSET .GT. 1))) + CALGAI = 10.0D0 * DSQRT (10.0D0) * CALGAI C C Return to the calling routine. C RETURN END C*CALLFC -- Calibrate one LFC data point and return the value in volts. C+ DOUBLE PRECISION FUNCTION CALLFC (BAND, CHAN, VALUE) INTEGER BAND, CHAN, VALUE C C This function will return the calibrated LFC data value in volts. C C Returns: C CALLFC : The calibrated LFC data value expressed in volts. C A negative value is returned if the input C parameters are incorrect. C Arguments: C BAND (input) : The LFC band, as follows: C C BAND Meaning C ---- ------- C 0 LFC High band C 1 LFC Low band C C CHAN (input) : The channel in the band (0 - 3 allowed). C VALUE (input) : The uncalibrated data value (0 - 255 allowed). C-- C Version 1.0 14-Mar-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- DOUBLE PRECISION LFCHI(0:255, 0:3), LFCLO(0:255, 0:3) DOUBLE PRECISION LF000(64), LF001(64), LF002(64), LF003(64) DOUBLE PRECISION LF010(64), LF011(64), LF012(64), LF013(64) DOUBLE PRECISION LF020(64), LF021(64), LF022(64), LF023(64) DOUBLE PRECISION LF030(64), LF031(64), LF032(64), LF033(64) DOUBLE PRECISION LF100(64), LF101(64), LF102(64), LF103(64) DOUBLE PRECISION LF110(64), LF111(64), LF112(64), LF113(64) DOUBLE PRECISION LF120(64), LF121(64), LF122(64), LF123(64) DOUBLE PRECISION LF130(64), LF131(64), LF132(64), LF133(64) C C The following equivalences are used to make the code simpler. C EQUIVALENCE (LFCLO( 0, 0), LF000), (LFCLO( 64, 0), LF001) EQUIVALENCE (LFCLO(128, 0), LF002), (LFCLO(192, 0), LF003) EQUIVALENCE (LFCLO( 0, 1), LF010), (LFCLO( 64, 1), LF011) EQUIVALENCE (LFCLO(128, 1), LF012), (LFCLO(192, 1), LF013) EQUIVALENCE (LFCLO( 0, 2), LF020), (LFCLO( 64, 2), LF021) EQUIVALENCE (LFCLO(128, 2), LF022), (LFCLO(192, 2), LF023) EQUIVALENCE (LFCLO( 0, 3), LF030), (LFCLO( 64, 3), LF031) EQUIVALENCE (LFCLO(128, 3), LF032), (LFCLO(192, 3), LF033) EQUIVALENCE (LFCHI( 0, 0), LF100), (LFCHI( 64, 0), LF101) EQUIVALENCE (LFCHI(128, 0), LF102), (LFCHI(192, 0), LF103) EQUIVALENCE (LFCHI( 0, 1), LF110), (LFCHI( 64, 1), LF111) EQUIVALENCE (LFCHI(128, 1), LF112), (LFCHI(192, 1), LF113) EQUIVALENCE (LFCHI( 0, 2), LF120), (LFCHI( 64, 2), LF121) EQUIVALENCE (LFCHI(128, 2), LF122), (LFCHI(192, 2), LF123) EQUIVALENCE (LFCHI( 0, 3), LF130), (LFCHI( 64, 3), LF131) EQUIVALENCE (LFCHI(128, 3), LF132), (LFCHI(192, 3), LF133) C C The following statements contain the data necessary for converting the C uncalibrated LFC amplitudes to physical units (volts). The DATA C statements contain the same values found in the file LFC_AMP.CAL on C the optical disk. C DATA LF000 /1.000D-06, 6.535D-06, 1.307D-05, 1.961D-05, 2.614D-05, + 3.268D-05, 3.921D-05, 4.575D-05, 5.228D-05, 5.882D-05, 6.535D-05, + 7.189D-05, 7.842D-05, 8.496D-05, 9.149D-05, 9.803D-05, 1.046D-04, + 1.111D-04, 1.176D-04, 1.242D-04, 1.307D-04, 1.372D-04, 1.438D-04, + 1.503D-04, 1.568D-04, 1.634D-04, 1.699D-04, 1.764D-04, 1.830D-04, + 1.895D-04, 1.961D-04, 2.026D-04, 2.091D-04, 2.157D-04, 2.222D-04, + 2.287D-04, 2.353D-04, 2.418D-04, 2.483D-04, 2.549D-04, 2.614D-04, + 2.679D-04, 2.745D-04, 2.810D-04, 2.875D-04, 2.941D-04, 3.006D-04, + 3.071D-04, 3.137D-04, 3.202D-04, 3.268D-04, 3.333D-04, 3.398D-04, + 3.464D-04, 3.529D-04, 3.594D-04, 3.660D-04, 3.725D-04, 3.623D-04, + 3.723D-04, 3.826D-04, 3.932D-04, 4.040D-04, 4.152D-04/ C DATA LF001 /4.267D-04, 4.322D-04, 4.370D-04, 4.418D-04, 4.467D-04, + 4.516D-04, 4.565D-04, 4.616D-04, 4.667D-04, 4.718D-04, 4.771D-04, + 4.825D-04, 4.879D-04, 4.933D-04, 4.988D-04, 5.044D-04, 5.101D-04, + 5.158D-04, 5.215D-04, 5.274D-04, 5.355D-04, 5.440D-04, 5.526D-04, + 5.613D-04, 5.702D-04, 5.793D-04, 5.884D-04, 5.977D-04, 6.072D-04, + 6.605D-04, 7.264D-04, 7.650D-04, 8.057D-04, 8.485D-04, 8.813D-04, + 9.068D-04, 9.330D-04, 9.599D-04, 9.876D-04, 1.016D-03, 1.045D-03, + 1.085D-03, 1.134D-03, 1.185D-03, 1.238D-03, 1.293D-03, 1.353D-03, + 1.416D-03, 1.482D-03, 1.551D-03, 1.624D-03, 1.825D-03, 2.035D-03, + 2.131D-03, 2.232D-03, 2.338D-03, 2.448D-03, 2.542D-03, 2.612D-03, + 2.684D-03, 2.758D-03, 2.834D-03, 2.912D-03, 2.992D-03/ C DATA LF002 /3.075D-03, 3.159D-03, 3.241D-03, 3.324D-03, 3.410D-03, + 3.498D-03, 3.588D-03, 3.681D-03, 3.776D-03, 3.873D-03, 3.973D-03, + 4.103D-03, 4.241D-03, 4.382D-03, 4.529D-03, 4.680D-03, 4.837D-03, + 4.998D-03, 5.735D-03, 6.458D-03, 6.903D-03, 7.378D-03, 7.885D-03, + 8.261D-03, 8.633D-03, 9.022D-03, 9.428D-03, 9.853D-03, 1.030D-02, + 1.076D-02, 1.125D-02, 1.175D-02, 1.228D-02, 1.279D-02, 1.327D-02, + 1.377D-02, 1.429D-02, 1.483D-02, 1.539D-02, 1.597D-02, 1.658D-02, + 1.721D-02, 1.787D-02, 1.856D-02, 1.927D-02, 2.001D-02, 2.075D-02, + 2.152D-02, 2.232D-02, 2.315D-02, 2.401D-02, 2.490D-02, 2.625D-02, + 2.780D-02, 2.946D-02, 3.121D-02, 3.247D-02, 3.360D-02, 3.477D-02, + 3.598D-02, 3.724D-02, 3.854D-02, 3.987D-02, 4.102D-02/ C DATA LF003 /4.220D-02, 4.342D-02, 4.467D-02, 4.596D-02, 4.729D-02, + 4.866D-02, 5.006D-02, 5.187D-02, 5.376D-02, 5.572D-02, 5.775D-02, + 5.985D-02, 6.203D-02, 6.490D-02, 6.847D-02, 7.225D-02, 7.623D-02, + 8.138D-02, 9.033D-02, 1.001D-01, 1.046D-01, 1.094D-01, 1.143D-01, + 1.195D-01, 1.249D-01, 1.299D-01, 1.348D-01, 1.400D-01, 1.453D-01, + 1.509D-01, 1.567D-01, 1.621D-01, 1.673D-01, 1.728D-01, 1.784D-01, + 1.842D-01, 1.902D-01, 1.964D-01, 2.029D-01, 2.096D-01, 2.165D-01, + 2.237D-01, 2.311D-01, 2.387D-01, 2.466D-01, 2.622D-01, 2.895D-01, + 3.255D-01, 4.158D-01, 5.003D-01, 5.528D-01, 6.104D-01, 6.929D-01, + 7.943D-01, 7.943D-01, 7.943D-01, 7.943D-01, 7.943D-01, 7.943D-01, + 7.943D-01, 7.943D-01, 7.943D-01, 7.943D-01, 7.943D-01/ C DATA LF010 /1.000D-06, 3.263D-06, 6.526D-06, 9.789D-06, 1.305D-05, + 1.632D-05, 1.958D-05, 2.284D-05, 2.610D-05, 2.937D-05, 3.263D-05, + 3.589D-05, 3.916D-05, 4.242D-05, 4.568D-05, 4.895D-05, 5.221D-05, + 5.547D-05, 5.874D-05, 6.200D-05, 6.526D-05, 6.853D-05, 7.179D-05, + 7.505D-05, 7.831D-05, 8.158D-05, 8.484D-05, 8.810D-05, 9.137D-05, + 9.463D-05, 9.789D-05, 1.012D-04, 1.044D-04, 1.077D-04, 1.109D-04, + 1.142D-04, 1.175D-04, 1.207D-04, 1.240D-04, 1.273D-04, 1.305D-04, + 1.338D-04, 1.371D-04, 1.403D-04, 1.436D-04, 1.468D-04, 1.501D-04, + 1.534D-04, 1.566D-04, 1.599D-04, 1.632D-04, 1.664D-04, 1.697D-04, + 1.692D-04, 1.756D-04, 1.789D-04, 1.795D-04, 1.801D-04, 1.808D-04, + 1.814D-04, 1.820D-04, 1.827D-04, 1.844D-04, 1.864D-04/ C DATA LF011 /1.884D-04, 1.948D-04, 1.995D-04, 2.012D-04, 2.030D-04, + 2.047D-04, 2.065D-04, 2.083D-04, 2.101D-04, 2.119D-04, 2.137D-04, + 2.154D-04, 2.171D-04, 2.189D-04, 2.206D-04, 2.224D-04, 2.242D-04, + 2.260D-04, 2.278D-04, 2.296D-04, 2.314D-04, 2.333D-04, 2.467D-04, + 2.626D-04, 2.684D-04, 2.739D-04, 2.796D-04, 2.853D-04, 2.912D-04, + 2.972D-04, 3.033D-04, 3.270D-04, 3.556D-04, 3.733D-04, 3.897D-04, + 4.068D-04, 4.247D-04, 4.402D-04, 4.534D-04, 4.670D-04, 4.809D-04, + 4.953D-04, 5.101D-04, 5.254D-04, 5.497D-04, 5.786D-04, 6.090D-04, + 6.411D-04, 6.755D-04, 7.122D-04, 7.508D-04, 7.916D-04, 8.341D-04, + 8.783D-04, 9.248D-04, 9.738D-04, 1.023D-03, 1.066D-03, 1.111D-03, + 1.158D-03, 1.207D-03, 1.257D-03, 1.311D-03, 1.366D-03/ C DATA LF012 /1.424D-03, 1.485D-03, 1.548D-03, 1.606D-03, 1.655D-03, + 1.706D-03, 1.758D-03, 1.812D-03, 1.868D-03, 1.925D-03, 1.984D-03, + 2.046D-03, 2.112D-03, 2.179D-03, 2.248D-03, 2.319D-03, 2.393D-03, + 2.469D-03, 2.557D-03, 2.662D-03, 2.770D-03, 2.883D-03, 3.000D-03, + 3.122D-03, 3.265D-03, 3.421D-03, 3.585D-03, 3.757D-03, 3.937D-03, + 4.229D-03, 4.578D-03, 4.955D-03, 5.223D-03, 5.481D-03, 5.752D-03, + 6.036D-03, 6.334D-03, 6.654D-03, 6.989D-03, 7.341D-03, 7.711D-03, + 8.688D-03, 1.010D-02, 1.035D-02, 1.061D-02, 1.088D-02, 1.115D-02, + 1.143D-02, 1.172D-02, 1.202D-02, 1.232D-02, 1.265D-02, 1.313D-02, + 1.363D-02, 1.415D-02, 1.469D-02, 1.524D-02, 1.582D-02, 1.631D-02, + 1.681D-02, 1.732D-02, 1.785D-02, 1.840D-02, 1.896D-02/ C DATA LF013 /1.954D-02, 2.020D-02, 2.099D-02, 2.181D-02, 2.266D-02, + 2.355D-02, 2.448D-02, 2.547D-02, 2.657D-02, 2.773D-02, 2.893D-02, + 3.019D-02, 3.150D-02, 3.280D-02, 3.415D-02, 3.555D-02, 3.702D-02, + 3.854D-02, 4.034D-02, 4.315D-02, 4.616D-02, 4.938D-02, 5.226D-02, + 5.514D-02, 5.817D-02, 6.138D-02, 6.474D-02, 6.827D-02, 7.199D-02, + 7.591D-02, 8.008D-02, 8.467D-02, 8.952D-02, 9.466D-02, 1.001D-01, + 1.040D-01, 1.082D-01, 1.125D-01, 1.169D-01, 1.216D-01, 1.263D-01, + 1.307D-01, 1.352D-01, 1.398D-01, 1.446D-01, 1.496D-01, 1.547D-01, + 1.614D-01, 1.720D-01, 1.834D-01, 1.955D-01, 2.102D-01, 2.270D-01, + 2.451D-01, 3.352D-01, 4.708D-01, 5.012D-01, 5.012D-01, 5.012D-01, + 5.012D-01, 5.012D-01, 5.012D-01, 5.012D-01, 5.012D-01/ C DATA LF020 /1.259D-07, 4.318D-07, 8.635D-07, 1.295D-06, 1.727D-06, + 2.159D-06, 2.591D-06, 3.022D-06, 3.454D-06, 3.886D-06, 4.318D-06, + 4.749D-06, 5.181D-06, 5.613D-06, 6.045D-06, 6.476D-06, 6.908D-06, + 7.340D-06, 7.772D-06, 8.203D-06, 8.635D-06, 9.067D-06, 9.499D-06, + 9.930D-06, 1.036D-05, 1.079D-05, 1.123D-05, 1.166D-05, 1.173D-05, + 1.222D-05, 1.272D-05, 1.325D-05, 1.356D-05, 1.386D-05, 1.417D-05, + 1.448D-05, 1.480D-05, 1.513D-05, 1.556D-05, 1.618D-05, 1.682D-05, + 1.748D-05, 1.821D-05, 1.926D-05, 2.037D-05, 2.155D-05, 2.280D-05, + 2.411D-05, 2.551D-05, 2.744D-05, 3.103D-05, 3.379D-05, 3.565D-05, + 3.762D-05, 3.969D-05, 4.218D-05, 4.512D-05, 4.826D-05, 5.138D-05, + 5.376D-05, 5.624D-05, 5.884D-05, 6.156D-05, 6.544D-05/ C DATA LF021 /7.091D-05, 7.683D-05, 8.257D-05, 8.823D-05, 9.427D-05, + 1.007D-04, 1.072D-04, 1.141D-04, 1.214D-04, 1.292D-04, 1.376D-04, + 1.464D-04, 1.558D-04, 1.620D-04, 1.670D-04, 1.722D-04, 1.775D-04, + 1.830D-04, 1.886D-04, 1.944D-04, 2.004D-04, 2.066D-04, 2.129D-04, + 2.195D-04, 2.263D-04, 2.332D-04, 2.404D-04, 2.478D-04, 2.553D-04, + 2.629D-04, 2.708D-04, 2.789D-04, 2.872D-04, 2.958D-04, 3.046D-04, + 3.137D-04, 3.298D-04, 3.495D-04, 3.703D-04, 3.924D-04, 4.092D-04, + 4.245D-04, 4.404D-04, 4.569D-04, 4.740D-04, 4.917D-04, 5.152D-04, + 5.457D-04, 5.780D-04, 6.122D-04, 6.518D-04, 6.979D-04, 7.472D-04, + 7.985D-04, 8.389D-04, 8.813D-04, 9.259D-04, 9.727D-04, 1.015D-03, + 1.050D-03, 1.086D-03, 1.124D-03, 1.162D-03, 1.202D-03/ C DATA LF022 /1.244D-03, 1.288D-03, 1.334D-03, 1.381D-03, 1.431D-03, + 1.482D-03, 1.535D-03, 1.590D-03, 1.647D-03, 1.705D-03, 1.766D-03, + 1.829D-03, 1.894D-03, 1.962D-03, 2.028D-03, 2.091D-03, 2.157D-03, + 2.225D-03, 2.295D-03, 2.367D-03, 2.442D-03, 2.522D-03, 2.641D-03, + 2.766D-03, 2.896D-03, 3.033D-03, 3.176D-03, 3.328D-03, 3.487D-03, + 3.653D-03, 3.827D-03, 4.019D-03, 4.273D-03, 4.543D-03, 4.830D-03, + 5.126D-03, 5.423D-03, 5.738D-03, 6.072D-03, 6.425D-03, 6.801D-03, + 7.198D-03, 7.619D-03, 8.121D-03, 8.827D-03, 9.595D-03, 1.015D-02, + 1.045D-02, 1.076D-02, 1.108D-02, 1.141D-02, 1.175D-02, 1.209D-02, + 1.245D-02, 1.288D-02, 1.337D-02, 1.387D-02, 1.439D-02, 1.493D-02, + 1.549D-02, 1.604D-02, 1.656D-02, 1.710D-02, 1.765D-02/ C DATA LF023 /1.822D-02, 1.881D-02, 1.942D-02, 2.006D-02, 2.075D-02, + 2.147D-02, 2.221D-02, 2.297D-02, 2.377D-02, 2.458D-02, 2.552D-02, + 2.666D-02, 2.784D-02, 2.908D-02, 3.037D-02, 3.173D-02, 3.332D-02, + 3.499D-02, 3.675D-02, 3.859D-02, 4.068D-02, 4.315D-02, 4.577D-02, + 4.855D-02, 5.148D-02, 5.458D-02, 5.787D-02, 6.135D-02, 6.497D-02, + 6.874D-02, 7.273D-02, 7.694D-02, 8.109D-02, 8.503D-02, 8.917D-02, + 9.350D-02, 9.805D-02, 1.026D-01, 1.071D-01, 1.119D-01, 1.168D-01, + 1.220D-01, 1.273D-01, 1.323D-01, 1.376D-01, 1.431D-01, 1.488D-01, + 1.547D-01, 1.609D-01, 1.675D-01, 1.743D-01, 1.815D-01, 1.889D-01, + 1.966D-01, 2.079D-01, 2.219D-01, 2.368D-01, 2.552D-01, 3.045D-01, + 3.981D-01, 3.981D-01, 3.981D-01, 3.981D-01, 3.981D-01/ C DATA LF030 /1.259D-07, 7.548D-07, 1.510D-06, 2.264D-06, 3.019D-06, + 3.774D-06, 4.529D-06, 5.283D-06, 6.038D-06, 6.793D-06, 7.548D-06, + 8.302D-06, 9.057D-06, 9.812D-06, 1.057D-05, 1.132D-05, 1.208D-05, + 1.283D-05, 1.359D-05, 1.434D-05, 1.510D-05, 1.585D-05, 1.660D-05, + 1.731D-05, 1.809D-05, 1.891D-05, 1.976D-05, 2.058D-05, 2.098D-05, + 2.139D-05, 2.181D-05, 2.224D-05, 2.268D-05, 2.312D-05, 2.358D-05, + 2.404D-05, 2.451D-05, 2.499D-05, 2.549D-05, 2.606D-05, 2.667D-05, + 2.728D-05, 2.791D-05, 2.856D-05, 2.922D-05, 2.990D-05, 3.059D-05, + 3.130D-05, 3.206D-05, 3.344D-05, 3.488D-05, 3.638D-05, 3.794D-05, + 3.958D-05, 4.531D-05, 5.072D-05, 5.257D-05, 5.449D-05, 5.649D-05, + 5.855D-05, 6.069D-05, 6.291D-05, 6.937D-05, 7.690D-05/ C DATA LF031 /8.204D-05, 8.601D-05, 9.017D-05, 9.453D-05, 9.911D-05, + 1.041D-04, 1.094D-04, 1.149D-04, 1.207D-04, 1.269D-04, 1.333D-04, + 1.401D-04, 1.472D-04, 1.546D-04, 1.598D-04, 1.625D-04, 1.651D-04, + 1.679D-04, 1.707D-04, 1.735D-04, 1.764D-04, 1.793D-04, 1.823D-04, + 1.853D-04, 1.884D-04, 1.915D-04, 1.947D-04, 1.979D-04, 2.035D-04, + 2.115D-04, 2.198D-04, 2.285D-04, 2.375D-04, 2.468D-04, 2.602D-04, + 2.777D-04, 2.963D-04, 3.162D-04, 3.380D-04, 3.612D-04, 3.861D-04, + 4.115D-04, 4.374D-04, 4.650D-04, 4.943D-04, 5.208D-04, 5.473D-04, + 5.752D-04, 6.044D-04, 6.355D-04, 6.704D-04, 7.071D-04, 7.459D-04, + 7.867D-04, 8.265D-04, 8.676D-04, 9.107D-04, 9.559D-04, 1.002D-03, + 1.038D-03, 1.075D-03, 1.113D-03, 1.152D-03, 1.193D-03/ C DATA LF032 /1.235D-03, 1.281D-03, 1.332D-03, 1.386D-03, 1.441D-03, + 1.499D-03, 1.560D-03, 1.616D-03, 1.669D-03, 1.724D-03, 1.781D-03, + 1.839D-03, 1.900D-03, 1.963D-03, 2.025D-03, 2.088D-03, 2.152D-03, + 2.219D-03, 2.287D-03, 2.357D-03, 2.430D-03, 2.505D-03, 2.607D-03, + 2.717D-03, 2.830D-03, 2.949D-03, 3.072D-03, 3.210D-03, 3.377D-03, + 3.553D-03, 3.738D-03, 3.933D-03, 4.152D-03, 4.388D-03, 4.637D-03, + 4.900D-03, 5.193D-03, 5.515D-03, 5.856D-03, 6.219D-03, 6.604D-03, + 7.013D-03, 7.447D-03, 7.908D-03, 8.445D-03, 9.022D-03, 9.639D-03, + 1.014D-02, 1.047D-02, 1.080D-02, 1.115D-02, 1.151D-02, 1.188D-02, + 1.226D-02, 1.266D-02, 1.316D-02, 1.368D-02, 1.422D-02, 1.478D-02, + 1.536D-02, 1.594D-02, 1.645D-02, 1.696D-02, 1.750D-02/ C DATA LF033 /1.805D-02, 1.862D-02, 1.920D-02, 1.980D-02, 2.044D-02, + 2.110D-02, 2.179D-02, 2.249D-02, 2.322D-02, 2.397D-02, 2.475D-02, + 2.575D-02, 2.698D-02, 2.827D-02, 2.962D-02, 3.104D-02, 3.253D-02, + 3.410D-02, 3.575D-02, 3.748D-02, 3.929D-02, 4.169D-02, 4.444D-02, + 4.738D-02, 5.050D-02, 5.376D-02, 5.723D-02, 6.092D-02, 6.465D-02, + 6.834D-02, 7.223D-02, 7.635D-02, 8.057D-02, 8.470D-02, 8.904D-02, + 9.360D-02, 9.839D-02, 1.028D-01, 1.071D-01, 1.116D-01, 1.162D-01, + 1.210D-01, 1.261D-01, 1.312D-01, 1.366D-01, 1.421D-01, 1.479D-01, + 1.539D-01, 1.602D-01, 1.669D-01, 1.739D-01, 1.812D-01, 1.887D-01, + 1.966D-01, 2.075D-01, 2.205D-01, 2.343D-01, 2.491D-01, 2.833D-01, + 3.367D-01, 3.981D-01, 3.981D-01, 3.981D-01, 3.981D-01/ C DATA LF100 /1.259D-07, 8.441D-07, 1.688D-06, 2.532D-06, 3.377D-06, + 4.221D-06, 5.065D-06, 5.909D-06, 6.753D-06, 7.597D-06, 8.441D-06, + 9.286D-06, 1.013D-05, 1.097D-05, 1.182D-05, 1.266D-05, 1.351D-05, + 1.435D-05, 1.519D-05, 1.604D-05, 1.688D-05, 1.773D-05, 1.816D-05, + 1.926D-05, 2.043D-05, 2.164D-05, 2.220D-05, 2.277D-05, 2.335D-05, + 2.395D-05, 2.457D-05, 2.540D-05, 2.637D-05, 2.739D-05, 2.844D-05, + 2.929D-05, 2.976D-05, 3.023D-05, 3.072D-05, 3.121D-05, 3.171D-05, + 3.222D-05, 3.273D-05, 3.326D-05, 3.379D-05, 3.433D-05, 3.488D-05, + 3.727D-05, 3.982D-05, 4.252D-05, 4.486D-05, 4.732D-05, 4.991D-05, + 5.290D-05, 5.756D-05, 6.264D-05, 6.703D-05, 7.094D-05, 7.508D-05, + 7.947D-05, 8.370D-05, 8.798D-05, 9.248D-05, 9.722D-05/ C DATA LF101 /1.050D-04, 1.247D-04, 1.297D-04, 1.338D-04, 1.381D-04, + 1.425D-04, 1.471D-04, 1.518D-04, 1.566D-04, 1.615D-04, 1.666D-04, + 1.717D-04, 1.771D-04, 1.826D-04, 1.882D-04, 1.941D-04, 2.000D-04, + 2.051D-04, 2.102D-04, 2.156D-04, 2.210D-04, 2.266D-04, 2.323D-04, + 2.382D-04, 2.442D-04, 2.504D-04, 2.600D-04, 2.704D-04, 2.813D-04, + 2.926D-04, 3.044D-04, 3.166D-04, 3.266D-04, 3.369D-04, 3.475D-04, + 3.585D-04, 3.698D-04, 3.815D-04, 3.936D-04, 4.142D-04, 4.410D-04, + 4.696D-04, 5.001D-04, 5.281D-04, 5.575D-04, 5.885D-04, 6.213D-04, + 6.642D-04, 7.136D-04, 7.666D-04, 8.112D-04, 8.458D-04, 8.818D-04, + 9.194D-04, 9.585D-04, 9.994D-04, 1.044D-03, 1.091D-03, 1.141D-03, + 1.192D-03, 1.246D-03, 1.294D-03, 1.342D-03, 1.392D-03/ C DATA LF102 /1.443D-03, 1.497D-03, 1.552D-03, 1.606D-03, 1.655D-03, + 1.707D-03, 1.759D-03, 1.814D-03, 1.870D-03, 1.928D-03, 1.987D-03, + 2.047D-03, 2.109D-03, 2.173D-03, 2.238D-03, 2.306D-03, 2.375D-03, + 2.447D-03, 2.524D-03, 2.635D-03, 2.751D-03, 2.872D-03, 2.998D-03, + 3.129D-03, 3.268D-03, 3.414D-03, 3.567D-03, 3.726D-03, 3.892D-03, + 4.090D-03, 4.325D-03, 4.573D-03, 4.836D-03, 5.117D-03, 5.420D-03, + 5.741D-03, 6.081D-03, 6.437D-03, 6.806D-03, 7.196D-03, 7.608D-03, + 8.029D-03, 8.424D-03, 8.838D-03, 9.272D-03, 9.727D-03, 1.019D-02, + 1.065D-02, 1.113D-02, 1.164D-02, 1.216D-02, 1.270D-02, 1.320D-02, + 1.373D-02, 1.427D-02, 1.484D-02, 1.543D-02, 1.600D-02, 1.651D-02, + 1.704D-02, 1.758D-02, 1.814D-02, 1.872D-02, 1.932D-02/ C DATA LF103 /1.993D-02, 2.058D-02, 2.126D-02, 2.195D-02, 2.267D-02, + 2.341D-02, 2.418D-02, 2.497D-02, 2.599D-02, 2.709D-02, 2.824D-02, + 2.944D-02, 3.068D-02, 3.202D-02, 3.352D-02, 3.508D-02, 3.672D-02, + 3.844D-02, 4.036D-02, 4.285D-02, 4.549D-02, 4.829D-02, 5.126D-02, + 5.441D-02, 5.774D-02, 6.128D-02, 6.513D-02, 6.932D-02, 7.378D-02, + 7.852D-02, 8.278D-02, 8.708D-02, 9.161D-02, 9.637D-02, 1.012D-01, + 1.057D-01, 1.104D-01, 1.152D-01, 1.204D-01, 1.257D-01, 1.310D-01, + 1.364D-01, 1.422D-01, 1.481D-01, 1.543D-01, 1.608D-01, 1.676D-01, + 1.747D-01, 1.821D-01, 1.899D-01, 1.979D-01, 2.099D-01, 2.235D-01, + 2.380D-01, 2.549D-01, 2.816D-01, 3.112D-01, 3.819D-01, 6.095D-01, + 1.000D+00, 1.000D+00, 1.000D+00, 1.000D+00, 1.000D+00/ C DATA LF110 /1.259D-07, 6.145D-07, 1.229D-06, 1.843D-06, 2.458D-06, + 3.072D-06, 3.687D-06, 4.301D-06, 4.916D-06, 5.530D-06, 6.145D-06, + 6.759D-06, 7.374D-06, 7.988D-06, 8.603D-06, 9.217D-06, 9.832D-06, + 1.045D-05, 1.106D-05, 1.168D-05, 1.229D-05, 1.290D-05, 1.352D-05, + 1.413D-05, 1.475D-05, 1.536D-05, 1.598D-05, 1.659D-05, 1.759D-05, + 1.822D-05, 1.870D-05, 1.918D-05, 1.968D-05, 2.020D-05, 2.073D-05, + 2.127D-05, 2.182D-05, 2.239D-05, 2.298D-05, 2.358D-05, 2.419D-05, + 2.483D-05, 2.547D-05, 2.614D-05, 2.682D-05, 2.752D-05, 2.830D-05, + 2.992D-05, 3.163D-05, 3.344D-05, 3.535D-05, 3.738D-05, 3.952D-05, + 4.178D-05, 4.417D-05, 4.670D-05, 4.938D-05, 5.209D-05, 5.434D-05, + 5.669D-05, 5.914D-05, 6.170D-05, 6.437D-05, 6.750D-05/ C DATA LF111 /7.078D-05, 7.422D-05, 7.783D-05, 8.219D-05, 8.824D-05, + 9.474D-05, 1.008D-04, 1.043D-04, 1.079D-04, 1.116D-04, 1.154D-04, + 1.194D-04, 1.235D-04, 1.276D-04, 1.318D-04, 1.360D-04, 1.404D-04, + 1.449D-04, 1.496D-04, 1.544D-04, 1.598D-04, 1.673D-04, 1.751D-04, + 1.832D-04, 1.918D-04, 2.002D-04, 2.054D-04, 2.107D-04, 2.162D-04, + 2.218D-04, 2.275D-04, 2.334D-04, 2.394D-04, 2.456D-04, 2.533D-04, + 2.708D-04, 2.895D-04, 3.095D-04, 3.250D-04, 3.384D-04, 3.524D-04, + 3.669D-04, 3.820D-04, 3.978D-04, 4.340D-04, 4.739D-04, 5.108D-04, + 5.381D-04, 5.668D-04, 5.971D-04, 6.290D-04, 6.590D-04, 6.902D-04, + 7.228D-04, 7.570D-04, 7.929D-04, 8.424D-04, 8.956D-04, 9.522D-04, + 1.007D-03, 1.040D-03, 1.074D-03, 1.109D-03, 1.146D-03/ C DATA LF112 /1.184D-03, 1.223D-03, 1.264D-03, 1.316D-03, 1.371D-03, + 1.428D-03, 1.487D-03, 1.549D-03, 1.604D-03, 1.648D-03, 1.694D-03, + 1.741D-03, 1.789D-03, 1.838D-03, 1.889D-03, 1.941D-03, 1.995D-03, + 2.069D-03, 2.145D-03, 2.225D-03, 2.307D-03, 2.393D-03, 2.482D-03, + 2.593D-03, 2.720D-03, 2.852D-03, 2.991D-03, 3.137D-03, 3.284D-03, + 3.436D-03, 3.595D-03, 3.762D-03, 3.936D-03, 4.169D-03, 4.434D-03, + 4.716D-03, 5.015D-03, 5.299D-03, 5.600D-03, 5.918D-03, 6.254D-03, + 6.635D-03, 7.044D-03, 7.478D-03, 7.939D-03, 8.314D-03, 8.707D-03, + 9.118D-03, 9.548D-03, 9.999D-03, 1.043D-02, 1.088D-02, 1.135D-02, + 1.184D-02, 1.235D-02, 1.284D-02, 1.331D-02, 1.380D-02, 1.431D-02, + 1.483D-02, 1.537D-02, 1.592D-02, 1.640D-02, 1.689D-02/ C DATA LF113 /1.740D-02, 1.792D-02, 1.846D-02, 1.901D-02, 1.958D-02, + 2.021D-02, 2.094D-02, 2.169D-02, 2.247D-02, 2.328D-02, 2.412D-02, + 2.499D-02, 2.607D-02, 2.723D-02, 2.844D-02, 2.970D-02, 3.102D-02, + 3.255D-02, 3.428D-02, 3.611D-02, 3.804D-02, 4.010D-02, 4.249D-02, + 4.502D-02, 4.770D-02, 5.062D-02, 5.425D-02, 5.814D-02, 6.231D-02, + 6.597D-02, 6.966D-02, 7.355D-02, 7.766D-02, 8.217D-02, 8.707D-02, + 9.226D-02, 9.777D-02, 1.023D-01, 1.062D-01, 1.103D-01, 1.146D-01, + 1.190D-01, 1.235D-01, 1.287D-01, 1.346D-01, 1.408D-01, 1.473D-01, + 1.540D-01, 1.605D-01, 1.661D-01, 1.719D-01, 1.779D-01, 1.842D-01, + 1.906D-01, 1.973D-01, 2.090D-01, 2.241D-01, 2.403D-01, 2.620D-01, + 2.947D-01, 3.621D-01, 5.035D-01, 6.310D-01, 6.310D-01/ C DATA LF120 /1.259D-07, 7.399D-07, 1.480D-06, 2.220D-06, 2.960D-06, + 3.699D-06, 4.439D-06, 5.179D-06, 5.919D-06, 6.659D-06, 7.399D-06, + 8.139D-06, 8.879D-06, 9.619D-06, 1.036D-05, 1.110D-05, 1.184D-05, + 1.258D-05, 1.332D-05, 1.406D-05, 1.480D-05, 1.554D-05, 1.628D-05, + 1.702D-05, 1.776D-05, 1.850D-05, 1.924D-05, 1.998D-05, 2.072D-05, + 2.094D-05, 2.144D-05, 2.195D-05, 2.248D-05, 2.302D-05, 2.357D-05, + 2.414D-05, 2.472D-05, 2.531D-05, 2.592D-05, 2.654D-05, 2.720D-05, + 2.797D-05, 2.876D-05, 2.958D-05, 3.041D-05, 3.127D-05, 3.215D-05, + 3.306D-05, 3.403D-05, 3.503D-05, 3.605D-05, 3.711D-05, 3.819D-05, + 3.931D-05, 4.046D-05, 4.315D-05, 4.753D-05, 5.235D-05, 5.765D-05, + 6.350D-05, 6.710D-05, 7.071D-05, 7.451D-05, 7.852D-05/ C DATA LF121 /8.213D-05, 8.573D-05, 8.949D-05, 9.341D-05, 9.750D-05, + 1.014D-04, 1.050D-04, 1.086D-04, 1.125D-04, 1.164D-04, 1.205D-04, + 1.247D-04, 1.291D-04, 1.336D-04, 1.383D-04, 1.432D-04, 1.483D-04, + 1.535D-04, 1.590D-04, 1.657D-04, 1.727D-04, 1.799D-04, 1.875D-04, + 1.954D-04, 2.028D-04, 2.096D-04, 2.166D-04, 2.239D-04, 2.315D-04, + 2.392D-04, 2.473D-04, 2.570D-04, 2.685D-04, 2.805D-04, 2.931D-04, + 3.062D-04, 3.201D-04, 3.355D-04, 3.517D-04, 3.686D-04, 3.864D-04, + 4.071D-04, 4.326D-04, 4.598D-04, 4.887D-04, 5.196D-04, 5.526D-04, + 5.878D-04, 6.251D-04, 6.631D-04, 7.030D-04, 7.453D-04, 7.902D-04, + 8.321D-04, 8.758D-04, 9.217D-04, 9.700D-04, 1.016D-03, 1.056D-03, + 1.098D-03, 1.141D-03, 1.186D-03, 1.233D-03, 1.283D-03/ C DATA LF122 /1.335D-03, 1.391D-03, 1.448D-03, 1.508D-03, 1.570D-03, + 1.625D-03, 1.678D-03, 1.733D-03, 1.790D-03, 1.848D-03, 1.909D-03, + 1.972D-03, 2.031D-03, 2.090D-03, 2.151D-03, 2.213D-03, 2.277D-03, + 2.343D-03, 2.410D-03, 2.480D-03, 2.569D-03, 2.675D-03, 2.786D-03, + 2.901D-03, 3.021D-03, 3.146D-03, 3.288D-03, 3.437D-03, 3.593D-03, + 3.756D-03, 3.927D-03, 4.144D-03, 4.393D-03, 4.656D-03, 4.935D-03, + 5.232D-03, 5.546D-03, 5.879D-03, 6.233D-03, 6.609D-03, 7.008D-03, + 7.432D-03, 7.881D-03, 8.317D-03, 8.770D-03, 9.249D-03, 9.753D-03, + 1.024D-02, 1.072D-02, 1.122D-02, 1.174D-02, 1.229D-02, 1.284D-02, + 1.339D-02, 1.396D-02, 1.456D-02, 1.519D-02, 1.584D-02, 1.638D-02, + 1.694D-02, 1.752D-02, 1.811D-02, 1.873D-02, 1.937D-02/ C DATA LF123 /2.002D-02, 2.060D-02, 2.120D-02, 2.181D-02, 2.245D-02, + 2.310D-02, 2.377D-02, 2.447D-02, 2.520D-02, 2.618D-02, 2.720D-02, + 2.826D-02, 2.936D-02, 3.051D-02, 3.171D-02, 3.316D-02, 3.468D-02, + 3.627D-02, 3.793D-02, 3.967D-02, 4.212D-02, 4.478D-02, 4.761D-02, + 5.061D-02, 5.375D-02, 5.710D-02, 6.065D-02, 6.447D-02, 6.864D-02, + 7.307D-02, 7.779D-02, 8.256D-02, 8.750D-02, 9.273D-02, 9.827D-02, + 1.032D-01, 1.079D-01, 1.129D-01, 1.180D-01, 1.234D-01, 1.292D-01, + 1.353D-01, 1.417D-01, 1.484D-01, 1.554D-01, 1.620D-01, 1.683D-01, + 1.748D-01, 1.815D-01, 1.886D-01, 1.959D-01, 2.044D-01, 2.141D-01, + 2.244D-01, 2.351D-01, 2.463D-01, 2.641D-01, 2.881D-01, 3.142D-01, + 3.841D-01, 1.000D+00, 1.000D+00, 1.000D+00, 1.000D+00/ C DATA LF130 /1.000D-06, 1.380D-06, 2.760D-06, 4.141D-06, 5.521D-06, + 6.901D-06, 8.281D-06, 9.661D-06, 1.104D-05, 1.242D-05, 1.380D-05, + 1.518D-05, 1.656D-05, 1.794D-05, 1.932D-05, 2.070D-05, 2.208D-05, + 2.346D-05, 2.484D-05, 2.622D-05, 2.760D-05, 2.898D-05, 3.036D-05, + 3.174D-05, 3.312D-05, 3.450D-05, 3.588D-05, 3.726D-05, 3.864D-05, + 4.002D-05, 4.141D-05, 4.279D-05, 4.417D-05, 4.555D-05, 4.693D-05, + 4.625D-05, 4.818D-05, 5.019D-05, 5.220D-05, 5.429D-05, 5.646D-05, + 5.871D-05, 5.971D-05, 6.064D-05, 6.159D-05, 6.255D-05, 6.352D-05, + 6.452D-05, 6.552D-05, 6.722D-05, 7.071D-05, 7.438D-05, 7.824D-05, + 8.231D-05, 8.658D-05, 9.089D-05, 9.406D-05, 9.734D-05, 1.007D-04, + 1.042D-04, 1.079D-04, 1.119D-04, 1.161D-04, 1.204D-04/ C DATA LF131 /1.250D-04, 1.296D-04, 1.345D-04, 1.397D-04, 1.450D-04, + 1.505D-04, 1.562D-04, 1.621D-04, 1.673D-04, 1.722D-04, 1.771D-04, + 1.822D-04, 1.875D-04, 1.929D-04, 1.984D-04, 2.041D-04, 2.106D-04, + 2.173D-04, 2.242D-04, 2.314D-04, 2.388D-04, 2.464D-04, 2.542D-04, + 2.611D-04, 2.681D-04, 2.753D-04, 2.826D-04, 2.902D-04, 2.979D-04, + 3.059D-04, 3.140D-04, 3.240D-04, 3.348D-04, 3.460D-04, 3.576D-04, + 3.695D-04, 3.819D-04, 3.947D-04, 4.134D-04, 4.351D-04, 4.580D-04, + 4.821D-04, 5.079D-04, 5.367D-04, 5.673D-04, 5.995D-04, 6.336D-04, + 6.692D-04, 7.068D-04, 7.465D-04, 7.885D-04, 8.311D-04, 8.758D-04, + 9.228D-04, 9.724D-04, 1.019D-03, 1.060D-03, 1.103D-03, 1.148D-03, + 1.195D-03, 1.243D-03, 1.295D-03, 1.349D-03, 1.405D-03/ C DATA LF132 /1.463D-03, 1.524D-03, 1.587D-03, 1.643D-03, 1.700D-03, + 1.760D-03, 1.822D-03, 1.886D-03, 1.952D-03, 2.016D-03, 2.076D-03, + 2.138D-03, 2.201D-03, 2.267D-03, 2.334D-03, 2.403D-03, 2.474D-03, + 2.553D-03, 2.640D-03, 2.730D-03, 2.824D-03, 2.920D-03, 3.020D-03, + 3.123D-03, 3.244D-03, 3.378D-03, 3.518D-03, 3.664D-03, 3.816D-03, + 3.974D-03, 4.204D-03, 4.451D-03, 4.712D-03, 4.989D-03, 5.286D-03, + 5.601D-03, 5.934D-03, 6.288D-03, 6.671D-03, 7.078D-03, 7.511D-03, + 7.967D-03, 8.408D-03, 8.874D-03, 9.366D-03, 9.885D-03, 1.038D-02, + 1.088D-02, 1.140D-02, 1.195D-02, 1.252D-02, 1.309D-02, 1.367D-02, + 1.428D-02, 1.491D-02, 1.558D-02, 1.619D-02, 1.677D-02, 1.737D-02, + 1.799D-02, 1.864D-02, 1.931D-02, 1.999D-02, 2.060D-02/ C DATA LF133 /2.124D-02, 2.188D-02, 2.255D-02, 2.324D-02, 2.395D-02, + 2.469D-02, 2.547D-02, 2.633D-02, 2.721D-02, 2.812D-02, 2.906D-02, + 3.004D-02, 3.104D-02, 3.220D-02, 3.357D-02, 3.499D-02, 3.646D-02, + 3.801D-02, 3.961D-02, 4.194D-02, 4.450D-02, 4.721D-02, 5.009D-02, + 5.324D-02, 5.660D-02, 6.016D-02, 6.398D-02, 6.819D-02, 7.267D-02, + 7.744D-02, 8.231D-02, 8.734D-02, 9.269D-02, 9.835D-02, 1.033D-01, + 1.081D-01, 1.132D-01, 1.184D-01, 1.240D-01, 1.300D-01, 1.364D-01, + 1.432D-01, 1.502D-01, 1.577D-01, 1.642D-01, 1.709D-01, 1.778D-01, + 1.850D-01, 1.925D-01, 2.003D-01, 2.085D-01, 2.169D-01, 2.258D-01, + 2.349D-01, 2.445D-01, 2.564D-01, 2.734D-01, 2.916D-01, 3.110D-01, + 3.471D-01, 3.936D-01, 1.000D+00, 1.000D+00, 1.000D+00/ C C Assume failure. C CALLFC = -1.0D0 C C Check the input values for validity. C IF ((BAND .LT. 0) .OR. (BAND .GT. 1)) RETURN IF ((CHAN .LT. 0) .OR. (CHAN .GT. 3)) RETURN IF ((VALUE .LT. 0) .OR. (VALUE .GT. 255)) RETURN C C Calibrate the data point. C IF (BAND .EQ. 0) THEN CALLFC = LFCHI(VALUE, CHAN) ELSE CALLFC = LFCLO(VALUE, CHAN) END IF C C Return to the calling routine. C RETURN END C*CALMAG -- Convert one data point from volts to gammas. C+ DOUBLE PRECISION FUNCTION CALMAG (MODE, STEP, VALUE) INTEGER MODE, STEP DOUBLE PRECISION VALUE C C This function will convert the calibrated amplitude values (expressed C in volts) to magnetic field strength (expressed in gammas). C C Returns: C CALMAG : The calibrated magnetic field strength expressed in C gammas. A negative value is returned if the input C parameters are incorrect. C Arguments: C MODE (input) : The instrument mode, as follows: C C MODE Meaning Valid values for STEP C ---- ------- --------------------- C 0 SFR Channel 0 0 - 31 C 1 SFR Channel 1 0 - 31 C 2 SFR Channel 2 0 - 31 C 3 SFR Channel 3 0 - 31 C 4 LFC High band 0 - 3 C 5 LFC Low band 0 - 3 C C STEP (input) : The step or channel in the given mode, as indicated C in the instrument status data. C VALUE (input) : The data value expressed in volts. C-- C Version 1.0 16-Mar-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- DOUBLE PRECISION LFCLO(0:3), LFCHI(0:3) DOUBLE PRECISION SFR0(0:31), SFR1(0:31), SFR2(0:31), SFR3(0:31) C C The following statements contain the data necessary for converting the C calibrated amplitude values (expressed in volts) to magnetic field C strength (expressed in gammas) for times when the receivers were C connected to the search coil or the loop antenna. The DATA statements C contain the same values found in the file MAG_AMP.CAL on the optical C disk. C DATA LFCLO /0.642D+03, 0.369D+03, 0.204D+03, 0.114D+03/ C DATA LFCHI /0.642D+02, 0.369D+02, 0.204D+02, 0.114D+02/ C DATA SFR0 /0.103D+02, 0.953D+01, 0.885D+01, 0.825D+01, 0.773D+01, + 0.727D+01, 0.685D+01, 0.648D+01, 0.614D+01, 0.583D+01, 0.530D+01, + 0.506D+01, 0.464D+01, 0.428D+01, 0.412D+01, 0.383D+01, 0.369D+01, + 0.345D+01, 0.323D+01, 0.304D+01, 0.286D+01, 0.270D+01, 0.249D+01, + 0.236D+01, 0.219D+01, 0.209D+01, 0.195D+01, 0.182D+01, 0.170D+01, + 0.157D+01, 0.148D+01, 0.137D+01/ C DATA SFR1 /0.119D+01, 0.111D+01, 0.103D+01, 0.966D+00, 0.908D+00, + 0.857D+00, 0.810D+00, 0.768D+00, 0.730D+00, 0.695D+00, 0.633D+00, + 0.606D+00, 0.558D+00, 0.516D+00, 0.497D+00, 0.462D+00, 0.446D+00, + 0.418D+00, 0.392D+00, 0.368D+00, 0.347D+00, 0.328D+00, 0.302D+00, + 0.287D+00, 0.266D+00, 0.253D+00, 0.236D+00, 0.220D+00, 0.206D+00, + 0.189D+00, 0.178D+00, 0.164D+00/ C DATA SFR2 /0.143D+00, 0.132D+00, 0.123D+00, 0.114D+00, 0.106D+00, + 0.993D-01, 0.931D-01, 0.874D-01, 0.821D-01, 0.773D-01, 0.688D-01, + 0.649D-01, 0.580D-01, 0.518D-01, 0.490D-01, 0.439D-01, 0.415D-01, + 0.371D-01, 0.332D-01, 0.296D-01, 0.264D-01, 0.236D-01, 0.202D-01, + 0.184D-01, 0.167D-01, 0.163D-01, 0.167D-01, 0.180D-01, 0.202D-01, + 0.238D-01, 0.268D-01, 0.311D-01/ C DATA SFR3 /0.389D-01, 0.440D-01, 0.490D-01, 0.540D-01, 0.590D-01, + 0.640D-01, 0.690D-01, 0.740D-01, 0.790D-01, 0.840D-01, 0.941D-01, + 0.992D-01, 0.110D+00, 0.120D+00, 0.125D+00, 0.136D+00, 0.142D+00, + 0.153D+00, 0.165D+00, 0.176D+00, 0.189D+00, 0.201D+00, 0.221D+00, + 0.235D+00, 0.257D+00, 0.272D+00, 0.296D+00, 0.321D+00, 0.348D+00, + 0.387D+00, 0.419D+00, 0.465D+00/ C C Assume failure. C CALMAG = -1.0D0 C C Check the input values for validity. C IF ((MODE .GE. 0) .AND. (MODE .LE. 3)) THEN IF ((STEP .LT. 0) .OR. (STEP .GT. 31)) RETURN ELSE IF ((MODE .EQ. 4) .OR. (MODE .EQ. 5)) THEN IF ((STEP .LT. 0) .OR. (STEP .GT. 3)) RETURN ELSE RETURN END IF C C Calibrate the data point. C IF (MODE .EQ. 0) THEN CALMAG = VALUE * SFR0(STEP) ELSE IF (MODE .EQ. 1) THEN CALMAG = VALUE * SFR1(STEP) ELSE IF (MODE .EQ. 2) THEN CALMAG = VALUE * SFR2(STEP) ELSE IF (MODE .EQ. 3) THEN CALMAG = VALUE * SFR3(STEP) ELSE IF (MODE .EQ. 4) THEN CALMAG = VALUE * LFCHI(STEP) ELSE CALMAG = VALUE * LFCLO(STEP) END IF C C Return to the calling routine. C RETURN END C*CALPHA -- Return the phase correction for a specified SFR point. C+ DOUBLE PRECISION FUNCTION CALPHA (CHAN, I, J, K) INTEGER CHAN, I, J, K C C This function will return the SFR phase correction, expressed in C degrees, for the specified point in the tables. C C Returns: C CALPHA : The phase correction expressed in degrees. C A negative value is returned if the input C parameters are incorrect. C Arguments: C CHAN (input) : The SFR channel, as follows: C C CHAN Meaning C ---- ------- C 0 SFR Channel 0 C 1 SFR Channel 1 C 2 SFR Channel 2 C 3 SFR Channel 3 C C I (input) : An indication of the desired SFR-B amplitude from C the table. C J (input) : An indication of the desired SFR-A amplitude from C the table. C K (input) : An indication of the desired step value from the C table. C-- C Version 1.0 18-Sep-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- INTEGER FIX0(10, 10, 3), FIX1(10, 10, 3), FIX2(10, 10, 3) INTEGER FIX3(7, 6, 5), FIX00(10, 10), FIX01(10, 10), FIX02(10, 10) INTEGER FIX10(10, 10), FIX11(10, 10), FIX12(10, 10), FIX20(10, 10) INTEGER FIX21(10, 10), FIX22(10, 10), FIX30(7, 6), FIX31(7, 6) INTEGER FIX32(7, 6), FIX33(7, 6), FIX34(7, 6) C C The following equivalences are used to make the code simpler. C EQUIVALENCE (FIX0(1, 1, 1), FIX00), (FIX0(1, 1, 2), FIX01) EQUIVALENCE (FIX0(1, 1, 3), FIX02), (FIX1(1, 1, 1), FIX10) EQUIVALENCE (FIX1(1, 1, 2), FIX11), (FIX1(1, 1, 3), FIX12) EQUIVALENCE (FIX2(1, 1, 1), FIX20), (FIX2(1, 1, 2), FIX21) EQUIVALENCE (FIX2(1, 1, 3), FIX22), (FIX3(1, 1, 1), FIX30) EQUIVALENCE (FIX3(1, 1, 2), FIX31), (FIX3(1, 1, 3), FIX32) EQUIVALENCE (FIX3(1, 1, 4), FIX33), (FIX3(1, 1, 5), FIX34) C C The following statements contain the data necessary for converting C the raw phase values to absolute units (degrees). The DATA statements C contain the same values found in the file SFC_AMP_PHA.CAL on the C optical disk. The phase corrections are stored as follows: C C FIX0(I, J, K) - This is the correction table for SFR channel 0. The C first index corresponds to ten values of the SFR-B C amplitudes. The ten values are -10dB through -100dB C in 10dB steps. The second index corresponds to ten C values of the SFR-A amplitudes. The ten values are C -10dB through -100dB in 10dB steps. The third index C corresponds to three values of the SFR step counter. C The three values are 0, 16, and 31. C C FIX1(I, J, K) - This is the correction table for SFR channel 1. The C first index corresponds to ten values of the SFR-B C amplitudes. The ten values are -10dB through -100dB C in 10dB steps. The second index corresponds to ten C values of the SFR-A amplitudes. The ten values are C -10dB through -100dB in 10dB steps. The third index C corresponds to three values of the SFR step counter. C The three values are 0, 16, and 31. C C FIX2(I, J, K) - This is the correction table for SFR channel 2. The C first index corresponds to ten values of the SFR-B C amplitudes. The ten values are -5dB through -95dB C in 10dB steps. The second index corresponds to ten C values of the SFR-A amplitudes. The ten values are C -5dB through -95dB in 10dB steps. The third index C corresponds to three values of the SFR step counter. C The three values are 0, 16, and 31. C C FIX3(I, J, K) - This is the correction table for SFR channel 3. The C first index corresponds to seven values of the SFR-B C amplitudes. The seven values are -25dB through C -85dB in 10dB steps. The second index corresponds C to six values of the SFR-A amplitudes. The six C values are -15dB through -65dB in 10dB steps. The C third index corresponds to five values of the SFR C step counter. The five values are 0, 8, 16, 24, and C 31. C DATA FIX00 /355, 350, 347, 344, 342, 343, 352, 8, 20, 26, 0, + 354, 352, 348, 345, 343, 346, 354, 9, 15, 2, 357, 354, 350, + 347, 344, 343, 343, 353, 4, 6, 1, 358, 354, 351, 347, 346, + 337, 357, 351, 8, 4, 0, 356, 354, 350, 349, 342, 343, 8, + 9, 6, 4, 1, 357, 352, 351, 348, 345, 343, 2, 7, 8, + 3, 0, 356, 351, 347, 333, 118, 315, 359, 8, 7, 6, 0, + 352, 4, 1, 36, 255, 12, 339, 16, 356, 36, 10, 338, 23, + 10, 244, 268, 226, 231, 325, 54, 40, 324, 331, 36/ C DATA FIX01 /356, 350, 347, 343, 341, 339, 341, 346, 348, 351, 1, + 355, 352, 348, 346, 342, 341, 343, 340, 1, 4, 358, 355, 351, + 348, 343, 341, 340, 337, 356, 7, 2, 359, 355, 352, 347, 348, + 343, 340, 334, 10, 5, 2, 357, 355, 350, 348, 341, 347, 327, + 13, 8, 5, 1, 358, 354, 351, 347, 356, 4, 12, 8, 9, + 5, 2, 356, 359, 347, 342, 349, 352, 17, 8, 5, 0, 354, + 355, 354, 339, 33, 249, 354, 12, 357, 333, 339, 356, 357, 341, + 4, 232, 291, 326, 251, 74, 328, 322, 314, 312, 66/ C DATA FIX02 /355, 350, 347, 343, 340, 337, 337, 343, 351, 354, 359, + 354, 351, 347, 344, 342, 341, 340, 345, 338, 2, 357, 354, 350, + 347, 343, 341, 340, 343, 345, 6, 0, 358, 353, 350, 346, 344, + 343, 335, 344, 8, 3, 0, 356, 353, 349, 345, 344, 343, 274, + 11, 6, 4, 0, 357, 353, 350, 351, 329, 358, 10, 7, 7, + 4, 0, 357, 355, 344, 4, 35, 351, 13, 9, 359, 358, 0, + 353, 342, 353, 305, 242, 298, 323, 343, 1, 350, 351, 352, 9, + 327, 213, 259, 55, 324, 252, 314, 221, 315, 337, 316/ C DATA FIX10 / 9, 341, 334, 329, 327, 324, 321, 316, 312, 308, 40, + 10, 3, 0, 358, 355, 352, 348, 342, 335, 50, 20, 12, 8, + 6, 4, 2, 358, 358, 347, 54, 25, 17, 13, 11, 9, 7, + 6, 5, 8, 55, 26, 19, 15, 13, 11, 10, 6, 4, 353, + 52, 27, 21, 18, 16, 13, 12, 10, 11, 12, 38, 23, 21, + 18, 18, 15, 14, 12, 9, 16, 11, 10, 17, 22, 19, 15, + 16, 12, 12, 12, 352, 346, 7, 16, 19, 14, 16, 7, 14, + 26, 344, 327, 341, 3, 28, 10, 29, 26, 357, 35/ C DATA FIX11 / 13, 340, 333, 328, 327, 325, 324, 325, 325, 326, 45, + 11, 4, 0, 358, 356, 355, 354, 353, 353, 54, 20, 13, 9, + 7, 5, 4, 3, 2, 5, 59, 25, 18, 14, 12, 10, 9, + 8, 10, 5, 60, 27, 20, 16, 14, 12, 11, 10, 13, 0, + 57, 28, 22, 18, 17, 15, 14, 12, 13, 23, 42, 24, 22, + 19, 18, 16, 15, 14, 13, 28, 15, 13, 19, 19, 20, 18, + 16, 16, 19, 21, 352, 347, 5, 17, 19, 19, 16, 18, 13, + 29, 343, 323, 338, 1, 19, 14, 20, 16, 17, 20/ C DATA FIX12 / 22, 5, 359, 356, 354, 352, 351, 350, 349, 349, 37, + 21, 15, 12, 10, 8, 7, 5, 5, 6, 44, 28, 22, 19, + 17, 16, 14, 13, 14, 10, 48, 31, 25, 22, 21, 19, 18, + 17, 17, 19, 49, 33, 27, 24, 23, 21, 19, 19, 21, 23, + 48, 34, 29, 26, 24, 23, 22, 20, 23, 20, 39, 32, 29, + 27, 25, 24, 23, 22, 23, 26, 7, 23, 28, 27, 27, 25, + 24, 23, 23, 24, 318, 353, 16, 22, 24, 24, 23, 21, 27, + 30, 300, 303, 323, 1, 9, 24, 12, 25, 23, 30/ C DATA FIX20 /337, 333, 331, 328, 323, 310, 290, 275, 268, 265, 344, + 339, 338, 336, 334, 327, 314, 293, 278, 271, 346, 341, 339, 338, + 337, 334, 328, 315, 297, 284, 348, 342, 340, 339, 338, 336, 334, + 328, 316, 301, 356, 345, 342, 340, 339, 338, 336, 333, 326, 314, + 13, 353, 345, 342, 340, 339, 338, 336, 331, 323, 35, 10, 352, + 345, 342, 340, 339, 337, 334, 328, 49, 34, 11, 353, 345, 342, + 340, 339, 337, 329, 54, 48, 33, 12, 353, 344, 344, 341, 339, + 335, 56, 53, 47, 33, 14, 351, 341, 338, 338, 346/ C DATA FIX21 /336, 330, 329, 327, 323, 316, 304, 294, 289, 287, 343, + 338, 337, 336, 334, 329, 321, 307, 295, 289, 345, 340, 338, 337, + 336, 334, 330, 321, 308, 299, 347, 341, 339, 338, 337, 336, 334, + 329, 319, 307, 353, 344, 341, 339, 338, 337, 335, 332, 325, 316, + 7, 349, 343, 341, 339, 338, 337, 335, 331, 320, 27, 5, 349, + 344, 341, 339, 338, 337, 332, 325, 43, 27, 5, 350, 343, 340, + 339, 338, 335, 327, 50, 44, 26, 4, 348, 343, 341, 338, 338, + 333, 52, 50, 43, 28, 2, 347, 339, 334, 334, 332/ C DATA FIX22 /339, 328, 328, 327, 325, 321, 316, 312, 310, 309, 347, + 337, 337, 336, 335, 332, 328, 322, 316, 313, 347, 337, 337, 337, + 336, 334, 332, 328, 323, 319, 349, 339, 338, 337, 336, 335, 334, + 332, 328, 324, 356, 341, 339, 338, 337, 336, 335, 334, 330, 327, + 11, 346, 341, 339, 338, 337, 336, 335, 333, 330, 45, 6, 347, + 341, 340, 338, 337, 336, 336, 331, 75, 51, 6, 348, 342, 338, + 338, 337, 338, 333, 86, 82, 48, 4, 343, 338, 333, 335, 333, + 337, 90, 92, 78, 46, 3, 331, 328, 323, 331, 332/ C DATA FIX30 / 37, 38, 40, 42, 46, 52, 63, 43, 45, 46, 47, + 50, 54, 62, 42, 44, 45, 46, 49, 53, 61, 41, 43, 44, + 45, 47, 51, 60, 38, 42, 43, 45, 47, 51, 60, 31, 38, + 41, 43, 45, 49, 57/ C DATA FIX31 / 37, 39, 42, 49, 66, 91, 107, 43, 45, 47, 50, + 57, 75, 102, 42, 44, 46, 47, 51, 60, 80, 40, 43, 44, + 46, 48, 54, 67, 35, 41, 43, 45, 47, 51, 63, 22, 35, + 40, 43, 45, 49, 57/ C DATA FIX32 / 39, 42, 47, 61, 89, 114, 125, 45, 47, 50, 55, + 69, 97, 124, 43, 45, 48, 50, 56, 71, 103, 41, 44, 46, + 47, 51, 57, 69, 35, 41, 44, 46, 49, 53, 62, 22, 35, + 41, 44, 47, 51, 58/ C DATA FIX33 / 38, 42, 51, 71, 103, 123, 130, 45, 47, 51, 59, + 80, 111, 131, 43, 45, 48, 51, 60, 82, 114, 42, 44, 46, + 47, 51, 62, 96, 39, 42, 45, 46, 49, 55, 72, 30, 38, + 43, 44, 46, 52, 62/ C DATA FIX34 / 46, 52, 68, 100, 128, 141, 145, 47, 51, 57, 72, + 104, 132, 145, 44, 47, 51, 57, 72, 106, 134, 39, 44, 48, + 51, 57, 75, 119, 29, 40, 45, 48, 51, 61, 78, 10, 30, + 41, 46, 48, 55, 64/ C C Assume failure. C CALPHA = -1.0D0 C C Check the input values for validity. C IF ((CHAN .GE. 0) .AND. (CHAN .LE. 2)) THEN IF ((I .LT. 1) .OR. (I .GT. 10)) RETURN IF ((J .LT. 1) .OR. (J .GT. 10)) RETURN IF ((K .LT. 1) .OR. (K .GT. 3)) RETURN ELSE IF (CHAN .EQ. 3) THEN IF ((I .LT. 1) .OR. (I .GT. 7)) RETURN IF ((J .LT. 1) .OR. (J .GT. 6)) RETURN IF ((K .LT. 1) .OR. (K .GT. 5)) RETURN ELSE RETURN END IF C C Return the desired phase correction. C IF (CHAN .EQ. 0) THEN CALPHA = DBLE (FIX0(I, J, K)) ELSE IF (CHAN .EQ. 1) THEN CALPHA = DBLE (FIX1(I, J, K)) ELSE IF (CHAN .EQ. 2) THEN CALPHA = DBLE (FIX2(I, J, K)) ELSE CALPHA = DBLE (FIX3(I, J, K)) END IF C C Return to the calling routine. C RETURN END C*CALSDB -- Calibrate one SFR data point and return the value in dBs. C+ INTEGER FUNCTION CALSDB (RECV, CHAN, VALUE) INTEGER CHAN, RECV, VALUE C C This function will return the calibrated SFR data value from the C specified receiver in dBs. C C Returns: C CALSDB : The calibrated SFR data value expressed in dBs. C A negative value is returned if the input C parameters are incorrect. C Arguments: C RECV (input) : The receiver with which the data was taken, as C follows: C C RECV Meaning C ---- ------- C 0 SFR A C 1 SFR B C C CHAN (input) : The SFR channel, as follows: C C CHAN Meaning C ---- ------- C 0 SFR Channel 0 C 1 SFR Channel 1 C 2 SFR Channel 2 C 3 SFR Channel 3 C C VALUE (input) : The uncalibrated data value (0 - 255 allowed). C-- C Version 1.0 18-Sep-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- INTEGER SFRA(0:255, 0:3), SFRB(0:255, 0:3) INTEGER SFRA00(64), SFRA01(64), SFRA02(64), SFRA03(64) INTEGER SFRA10(64), SFRA11(64), SFRA12(64), SFRA13(64) INTEGER SFRA20(64), SFRA21(64), SFRA22(64), SFRA23(64) INTEGER SFRA30(64), SFRA31(64), SFRA32(64), SFRA33(64) INTEGER SFRB00(64), SFRB01(64), SFRB02(64), SFRB03(64) INTEGER SFRB10(64), SFRB11(64), SFRB12(64), SFRB13(64) INTEGER SFRB20(64), SFRB21(64), SFRB22(64), SFRB23(64) INTEGER SFRB30(64), SFRB31(64), SFRB32(64), SFRB33(64) C C The following equivalences are used to make the code simpler. C EQUIVALENCE (SFRA( 0, 0), SFRA00), (SFRA( 64, 0), SFRA01) EQUIVALENCE (SFRA(128, 0), SFRA02), (SFRA(192, 0), SFRA03) EQUIVALENCE (SFRA( 0, 1), SFRA10), (SFRA( 64, 1), SFRA11) EQUIVALENCE (SFRA(128, 1), SFRA12), (SFRA(192, 1), SFRA13) EQUIVALENCE (SFRA( 0, 2), SFRA20), (SFRA( 64, 2), SFRA21) EQUIVALENCE (SFRA(128, 2), SFRA22), (SFRA(192, 2), SFRA23) EQUIVALENCE (SFRA( 0, 3), SFRA30), (SFRA( 64, 3), SFRA31) EQUIVALENCE (SFRA(128, 3), SFRA32), (SFRA(192, 3), SFRA33) EQUIVALENCE (SFRB( 0, 0), SFRB00), (SFRB( 64, 0), SFRB01) EQUIVALENCE (SFRB(128, 0), SFRB02), (SFRB(192, 0), SFRB03) EQUIVALENCE (SFRB( 0, 1), SFRB10), (SFRB( 64, 1), SFRB11) EQUIVALENCE (SFRB(128, 1), SFRB12), (SFRB(192, 1), SFRB13) EQUIVALENCE (SFRB( 0, 2), SFRB20), (SFRB( 64, 2), SFRB21) EQUIVALENCE (SFRB(128, 2), SFRB22), (SFRB(192, 2), SFRB23) EQUIVALENCE (SFRB( 0, 3), SFRB30), (SFRB( 64, 3), SFRB31) EQUIVALENCE (SFRB(128, 3), SFRB32), (SFRB(192, 3), SFRB33) C C The following statements contain the data necessary for converting the C uncalibrated SFR amplitudes to physical units (dBs). C DATA SFRA00 /100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 99, 98, 97, 97, 96, 96, 95, 95, 94, 92, 92, + 92, 91, 91, 91, 91, 91/ C DATA SFRA01 / 90, 90, 90, 90, 89, 89, 89, 89, 88, 88, + 88, 87, 86, 86, 86, 85, 85, 85, 85, 84, 84, 83, + 82, 82, 82, 81, 81, 81, 81, 81, 80, 80, 80, 79, + 79, 79, 78, 78, 78, 77, 77, 76, 75, 75, 74, 74, + 73, 73, 72, 72, 71, 71, 70, 70, 69, 69, 69, 68, + 68, 68, 67, 67, 66, 66/ C DATA SFRA02 / 66, 65, 65, 65, 64, 64, 64, 64, 63, 63, + 63, 63, 62, 62, 62, 61, 61, 61, 61, 60, 60, 60, + 59, 59, 59, 58, 58, 58, 57, 57, 56, 56, 55, 55, + 54, 53, 53, 52, 52, 51, 51, 50, 50, 50, 49, 49, + 48, 48, 48, 47, 47, 46, 46, 46, 45, 45, 45, 44, + 44, 44, 44, 43, 43, 43/ C DATA SFRA03 / 42, 42, 42, 42, 41, 41, 41, 40, 40, 40, + 39, 39, 39, 38, 38, 37, 37, 36, 36, 35, 35, 34, + 34, 33, 32, 32, 31, 31, 30, 30, 29, 29, 29, 28, + 28, 27, 27, 26, 26, 25, 25, 24, 24, 24, 23, 23, + 23, 22, 22, 22, 21, 21, 20, 20, 19, 19, 18, 17, + 16, 15, 14, 13, 11, 8/ C DATA SFRA10 /100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 99, 98, + 98, 97, 97, 97, 96, 96, 95, 95, 94, 94, 93, 92, + 92, 91, 91, 91, 90, 90/ C DATA SFRA11 / 90, 90, 89, 89, 89, 88, 88, 87, 87, 86, + 86, 86, 85, 85, 85, 84, 84, 84, 84, 83, 83, 83, + 83, 82, 82, 82, 81, 81, 81, 81, 80, 80, 80, 79, + 79, 79, 78, 78, 78, 77, 77, 76, 76, 75, 75, 74, + 74, 73, 73, 72, 72, 71, 71, 70, 70, 70, 69, 69, + 68, 68, 68, 67, 67, 66/ C DATA SFRA12 / 66, 66, 65, 65, 65, 64, 64, 64, 63, 63, + 63, 63, 62, 62, 62, 62, 61, 61, 61, 61, 60, 60, + 60, 59, 59, 59, 58, 58, 58, 57, 57, 56, 56, 55, + 55, 54, 54, 53, 53, 52, 52, 51, 51, 50, 50, 49, + 49, 49, 48, 48, 47, 47, 47, 46, 46, 46, 45, 45, + 45, 44, 44, 44, 43, 43/ C DATA SFRA13 / 43, 42, 42, 42, 42, 41, 41, 41, 41, 40, + 40, 40, 39, 39, 39, 38, 38, 38, 37, 37, 36, 36, + 35, 35, 34, 33, 33, 32, 32, 31, 31, 30, 30, 29, + 29, 28, 28, 28, 27, 27, 26, 26, 25, 25, 25, 24, + 24, 24, 23, 23, 23, 22, 22, 21, 20, 19, 18, 17, + 17, 16, 15, 14, 13, 0/ C DATA SFRA20 /100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 98, + 97, 96, 95, 94, 93, 92, 92, 91, 91, 90, 89, 89, + 88, 88, 87, 87, 87, 86, 86, 86, 85, 85, 84, 84, + 83, 83, 82, 82, 81, 81/ C DATA SFRA21 / 80, 80, 80, 79, 79, 78, 78, 78, 77, 77, + 77, 76, 76, 76, 75, 75, 75, 74, 74, 74, 73, 73, + 73, 73, 72, 72, 72, 72, 71, 71, 71, 70, 70, 70, + 69, 69, 69, 68, 68, 68, 67, 67, 66, 66, 65, 65, + 64, 64, 63, 63, 62, 62, 61, 61, 60, 60, 59, 59, + 59, 58, 58, 58, 57, 57/ C DATA SFRA22 / 57, 56, 56, 56, 55, 55, 55, 54, 54, 54, + 54, 53, 53, 53, 53, 52, 52, 52, 52, 51, 51, 51, + 50, 50, 49, 49, 49, 48, 48, 48, 47, 47, 46, 46, + 45, 45, 44, 44, 43, 43, 42, 42, 41, 41, 40, 40, + 39, 39, 38, 38, 38, 37, 37, 37, 36, 36, 36, 35, + 35, 35, 34, 34, 34, 34/ C DATA SFRA23 / 33, 33, 33, 33, 32, 32, 32, 31, 31, 31, + 30, 30, 30, 29, 29, 29, 28, 28, 27, 27, 26, 25, + 25, 24, 24, 23, 23, 22, 22, 21, 21, 20, 20, 19, + 19, 18, 18, 18, 17, 17, 16, 16, 16, 15, 15, 15, + 14, 14, 14, 13, 13, 13, 12, 12, 11, 10, 10, 9, + 8, 8, 7, 5, 4, 2/ C DATA SFRA30 /100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 91, 90, 88, 87, 86, 85, 84, 83, 83, 82, 81, + 81, 80, 80, 79, 79, 78/ C DATA SFRA31 / 78, 77, 77, 76, 76, 76, 75, 75, 75, 74, + 74, 73, 73, 73, 72, 72, 72, 71, 71, 71, 71, 70, + 70, 70, 70, 69, 69, 69, 69, 68, 68, 68, 67, 67, + 67, 66, 66, 65, 65, 64, 64, 64, 63, 63, 62, 61, + 61, 60, 60, 59, 59, 59, 58, 58, 57, 57, 56, 56, + 55, 55, 55, 54, 54, 53/ C DATA SFRA32 / 53, 53, 52, 52, 52, 51, 51, 51, 51, 50, + 50, 50, 50, 49, 49, 49, 49, 48, 48, 48, 47, 47, + 47, 46, 46, 45, 45, 44, 44, 43, 43, 42, 41, 41, + 40, 40, 39, 39, 38, 38, 37, 37, 36, 36, 35, 35, + 34, 34, 33, 33, 33, 32, 32, 32, 31, 31, 31, 30, + 30, 30, 30, 29, 29, 29/ C DATA SFRA33 / 29, 28, 28, 28, 28, 27, 27, 26, 26, 25, + 25, 24, 23, 23, 22, 22, 21, 20, 20, 19, 19, 18, + 18, 17, 16, 16, 15, 15, 14, 14, 14, 13, 13, 12, + 12, 12, 11, 11, 11, 10, 10, 10, 9, 9, 9, 8, + 8, 7, 6, 5, 2, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0/ C DATA SFRB00 /100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100, 98, 96, 95, 95, 95, 94, 92, 92, + 92, 92, 91, 91, 91, 91, 91, 91, 91, 90, 90, 90, + 90, 89, 89, 88, 86, 86/ C DATA SFRB01 / 85, 85, 85, 85, 85, 84, 84, 84, 84, 84, + 84, 83, 83, 83, 83, 83, 83, 82, 82, 82, 82, 82, + 81, 81, 80, 80, 80, 79, 79, 79, 78, 78, 77, 77, + 76, 76, 75, 75, 75, 74, 74, 73, 73, 72, 72, 71, + 71, 70, 70, 69, 69, 69, 68, 68, 68, 67, 67, 66, + 66, 66, 65, 65, 64, 64/ C DATA SFRB02 / 64, 63, 63, 63, 62, 62, 62, 62, 61, 61, + 61, 61, 60, 60, 60, 60, 59, 59, 59, 59, 58, 58, + 58, 57, 57, 56, 56, 56, 55, 55, 54, 54, 53, 53, + 52, 52, 51, 51, 50, 50, 49, 49, 48, 48, 48, 47, + 47, 46, 46, 45, 45, 45, 44, 44, 44, 43, 43, 43, + 42, 42, 42, 42, 41, 41/ C DATA SFRB03 / 41, 41, 40, 40, 40, 40, 39, 39, 39, 38, + 38, 38, 37, 37, 36, 36, 35, 35, 34, 34, 33, 33, + 32, 31, 31, 30, 30, 29, 29, 29, 28, 28, 27, 27, + 26, 26, 25, 25, 24, 24, 24, 23, 23, 23, 22, 22, + 22, 21, 21, 21, 20, 20, 19, 19, 18, 17, 16, 16, + 15, 14, 13, 11, 0, 0/ C DATA SFRB10 /100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100, 100, 100, 99, 99, 99, 99, 99, 98, + 98, 98, 98, 97, 97, 97, 96, 96, 95, 94, 94, 93, + 93, 92, 92, 91, 91, 90/ C DATA SFRB11 / 90, 90, 89, 89, 89, 88, 88, 87, 87, 86, + 86, 86, 85, 85, 85, 85, 84, 84, 84, 84, 83, 83, + 83, 83, 82, 82, 82, 81, 81, 81, 80, 80, 80, 79, + 79, 79, 78, 78, 78, 77, 77, 76, 76, 75, 75, 74, + 74, 73, 73, 72, 72, 71, 71, 70, 70, 69, 69, 69, + 68, 68, 67, 67, 67, 66/ C DATA SFRB12 / 66, 66, 65, 65, 65, 64, 64, 64, 63, 63, + 63, 63, 62, 62, 62, 62, 61, 61, 61, 61, 60, 60, + 60, 60, 59, 59, 59, 58, 58, 57, 57, 56, 56, 55, + 55, 54, 54, 53, 53, 52, 52, 51, 51, 50, 50, 49, + 49, 49, 48, 48, 48, 47, 47, 46, 46, 46, 45, 45, + 45, 44, 44, 44, 44, 43/ C DATA SFRB13 / 43, 43, 43, 42, 42, 42, 41, 41, 41, 41, + 40, 40, 40, 39, 39, 39, 38, 38, 37, 37, 36, 36, + 35, 35, 34, 34, 33, 33, 32, 31, 31, 30, 30, 29, + 29, 29, 28, 28, 27, 27, 26, 26, 26, 25, 25, 25, + 24, 24, 24, 23, 23, 23, 22, 22, 21, 21, 20, 20, + 19, 18, 18, 17, 15, 14/ C DATA SFRB20 /100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100, 96, 95, 93, 92, 91, 91, 90, 89, + 89, 88, 88, 87, 87, 86, 86, 86, 85, 85, 84, 84, + 83, 83, 82, 82, 81, 81/ C DATA SFRB21 / 81, 80, 80, 79, 79, 79, 78, 78, 77, 77, + 77, 76, 76, 76, 75, 75, 75, 74, 74, 74, 74, 73, + 73, 73, 72, 72, 72, 72, 71, 71, 71, 70, 70, 70, + 69, 69, 69, 68, 68, 67, 67, 66, 66, 65, 65, 64, + 64, 63, 63, 62, 62, 61, 61, 60, 60, 59, 59, 59, + 58, 58, 58, 57, 57, 57/ C DATA SFRB22 / 56, 56, 56, 55, 55, 55, 54, 54, 54, 54, + 53, 53, 53, 53, 52, 52, 52, 52, 51, 51, 51, 50, + 50, 50, 49, 49, 49, 48, 48, 47, 47, 46, 46, 45, + 45, 44, 44, 43, 43, 42, 42, 41, 41, 40, 40, 40, + 39, 39, 38, 38, 38, 37, 37, 36, 36, 36, 35, 35, + 35, 35, 34, 34, 34, 34/ C DATA SFRB23 / 33, 33, 33, 33, 32, 32, 32, 31, 31, 31, + 30, 30, 30, 29, 29, 28, 28, 28, 27, 27, 26, 25, + 25, 24, 24, 23, 23, 22, 22, 21, 21, 20, 20, 19, + 19, 19, 18, 18, 17, 17, 17, 16, 16, 16, 15, 15, + 15, 14, 14, 13, 13, 13, 12, 12, 11, 11, 10, 10, + 9, 8, 8, 7, 5, 4/ C DATA SFRB30 /100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 98, 92, 90, 89, 87, 86, 85, 84, 83, 83, 82, + 82, 81, 81, 80, 80, 79/ C DATA SFRB31 / 79, 78, 78, 77, 77, 76, 76, 76, 75, 75, + 75, 74, 74, 74, 73, 73, 73, 72, 72, 72, 71, 71, + 71, 71, 70, 70, 70, 69, 69, 69, 69, 68, 68, 68, + 67, 67, 66, 66, 66, 65, 65, 64, 64, 63, 63, 62, + 61, 61, 60, 60, 59, 59, 59, 58, 58, 57, 57, 56, + 56, 56, 55, 55, 54, 54/ C DATA SFRB32 / 54, 53, 53, 53, 52, 52, 52, 52, 51, 51, + 51, 51, 50, 50, 50, 49, 49, 49, 49, 48, 48, 48, + 47, 47, 46, 46, 45, 45, 44, 43, 43, 42, 42, 41, + 41, 40, 40, 39, 39, 38, 38, 37, 37, 36, 36, 35, + 35, 34, 34, 34, 33, 33, 33, 32, 32, 32, 31, 31, + 31, 31, 30, 30, 30, 29/ C DATA SFRB33 / 29, 29, 29, 28, 28, 28, 27, 27, 26, 26, + 25, 25, 24, 24, 23, 22, 22, 21, 20, 20, 19, 19, + 18, 18, 17, 17, 16, 16, 15, 15, 14, 14, 13, 13, + 12, 12, 12, 11, 11, 11, 10, 10, 10, 9, 9, 8, + 7, 6, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0/ C C Assume failure. C CALSDB = -1 C C Check the input values for validity. C IF ((RECV .LT. 0) .OR. (RECV .GT. 1)) RETURN IF ((CHAN .LT.0) .OR. (CHAN .GT. 3)) RETURN IF ((VALUE .LT. 0) .OR. (VALUE .GT. 255)) RETURN C C Calibrate the data point. C IF (RECV .EQ. 0) THEN CALSDB = SFRA(VALUE, CHAN) ELSE CALSDB = SFRB(VALUE, CHAN) END IF C C Return to the calling routine. C RETURN END C*CALSFR -- Calibrate one SFR data point and return the value in volts. C+ DOUBLE PRECISION FUNCTION CALSFR (CHAN, VALUE) INTEGER CHAN, VALUE C C This function will return the calibrated SFR data value in volts. C C Returns: C CALSFR : The calibrated SFR data value expressed in volts. C A negative value is returned if the input C parameters are incorrect. C Arguments: C CHAN (input) : The SFR channel, as follows: C C CHAN Meaning C ---- ------- C 0 SFR Channel 0 C 1 SFR Channel 1 C 2 SFR Channel 2 C 3 SFR Channel 3 C C VALUE (input) : The uncalibrated data value (0 - 255 allowed). C-- C Version 1.0 28-Feb-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- DOUBLE PRECISION SFR(0:255, 0:3) DOUBLE PRECISION SFR00(64), SFR01(64), SFR02(64), SFR03(64) DOUBLE PRECISION SFR10(64), SFR11(64), SFR12(64), SFR13(64) DOUBLE PRECISION SFR20(64), SFR21(64), SFR22(64), SFR23(64) DOUBLE PRECISION SFR30(64), SFR31(64), SFR32(64), SFR33(64) C C The following equivalences are used to make the code simpler. C EQUIVALENCE (SFR( 0, 0), SFR00), (SFR( 64, 0), SFR01) EQUIVALENCE (SFR(128, 0), SFR02), (SFR(192, 0), SFR03) EQUIVALENCE (SFR( 0, 1), SFR10), (SFR( 64, 1), SFR11) EQUIVALENCE (SFR(128, 1), SFR12), (SFR(192, 1), SFR13) EQUIVALENCE (SFR( 0, 2), SFR20), (SFR( 64, 2), SFR21) EQUIVALENCE (SFR(128, 2), SFR22), (SFR(192, 2), SFR23) EQUIVALENCE (SFR( 0, 3), SFR30), (SFR( 64, 3), SFR31) EQUIVALENCE (SFR(128, 3), SFR32), (SFR(192, 3), SFR33) C C The following statements contain the data necessary for converting the C uncalibrated SFR amplitudes to physical units (volts). The DATA C statements contain the same values found in the file SFR_AMP.CAL on C the optical disk. C DATA SFR00 /1.259D-07, 5.541D-07, 1.108D-06, 1.662D-06, 2.216D-06, + 2.771D-06, 3.325D-06, 3.879D-06, 4.433D-06, 4.987D-06, 5.541D-06, + 6.095D-06, 6.649D-06, 7.203D-06, 7.757D-06, 8.312D-06, 8.866D-06, + 9.420D-06, 9.974D-06, 1.053D-05, 1.108D-05, 1.164D-05, 1.219D-05, + 1.274D-05, 1.330D-05, 1.385D-05, 1.441D-05, 1.496D-05, 1.551D-05, + 1.607D-05, 1.662D-05, 1.718D-05, 1.773D-05, 1.829D-05, 1.884D-05, + 1.939D-05, 1.995D-05, 2.050D-05, 2.106D-05, 2.161D-05, 2.216D-05, + 2.272D-05, 2.327D-05, 2.383D-05, 2.438D-05, 2.493D-05, 2.549D-05, + 2.568D-05, 2.653D-05, 2.710D-05, 2.763D-05, 2.817D-05, 2.872D-05, + 2.929D-05, 2.986D-05, 3.045D-05, 3.112D-05, 3.191D-05, 3.273D-05, + 3.357D-05, 3.443D-05, 3.531D-05, 3.622D-05, 3.715D-05/ C DATA SFR01 /3.810D-05, 3.908D-05, 3.993D-05, 4.073D-05, 4.154D-05, + 4.237D-05, 4.322D-05, 4.409D-05, 4.497D-05, 4.587D-05, 4.817D-05, + 5.162D-05, 5.531D-05, 5.666D-05, 5.801D-05, 5.940D-05, 6.081D-05, + 6.226D-05, 6.374D-05, 6.526D-05, 6.682D-05, 7.715D-05, 8.401D-05, + 8.585D-05, 8.773D-05, 8.965D-05, 9.162D-05, 9.363D-05, 9.568D-05, + 9.777D-05, 9.992D-05, 1.021D-04, 1.055D-04, 1.096D-04, 1.137D-04, + 1.181D-04, 1.226D-04, 1.273D-04, 1.344D-04, 1.424D-04, 1.509D-04, + 1.599D-04, 1.713D-04, 1.835D-04, 1.966D-04, 2.090D-04, 2.216D-04, + 2.351D-04, 2.493D-04, 2.635D-04, 2.784D-04, 2.941D-04, 3.107D-04, + 3.252D-04, 3.388D-04, 3.529D-04, 3.677D-04, 3.831D-04, 3.992D-04, + 4.184D-04, 4.386D-04, 4.597D-04, 4.818D-04, 5.040D-04/ C DATA SFR02 /5.222D-04, 5.411D-04, 5.606D-04, 5.808D-04, 6.018D-04, + 6.235D-04, 6.440D-04, 6.641D-04, 6.848D-04, 7.062D-04, 7.283D-04, + 7.510D-04, 7.744D-04, 7.987D-04, 8.239D-04, 8.499D-04, 8.768D-04, + 9.045D-04, 9.331D-04, 9.626D-04, 9.930D-04, 1.033D-03, 1.076D-03, + 1.122D-03, 1.170D-03, 1.219D-03, 1.275D-03, 1.346D-03, 1.422D-03, + 1.502D-03, 1.586D-03, 1.685D-03, 1.790D-03, 1.902D-03, 2.020D-03, + 2.146D-03, 2.279D-03, 2.421D-03, 2.565D-03, 2.709D-03, 2.861D-03, + 3.021D-03, 3.185D-03, 3.329D-03, 3.480D-03, 3.638D-03, 3.803D-03, + 3.976D-03, 4.164D-03, 4.361D-03, 4.567D-03, 4.783D-03, 5.010D-03, + 5.192D-03, 5.380D-03, 5.575D-03, 5.777D-03, 5.987D-03, 6.204D-03, + 6.416D-03, 6.624D-03, 6.838D-03, 7.059D-03, 7.288D-03/ C DATA SFR03 /7.523D-03, 7.767D-03, 8.020D-03, 8.287D-03, 8.562D-03, + 8.846D-03, 9.140D-03, 9.444D-03, 9.758D-03, 1.012D-02, 1.060D-02, + 1.111D-02, 1.164D-02, 1.220D-02, 1.283D-02, 1.357D-02, 1.435D-02, + 1.518D-02, 1.607D-02, 1.709D-02, 1.816D-02, 1.931D-02, 2.063D-02, + 2.218D-02, 2.384D-02, 2.555D-02, 2.714D-02, 2.884D-02, 3.064D-02, + 3.237D-02, 3.397D-02, 3.565D-02, 3.742D-02, 3.928D-02, 4.156D-02, + 4.412D-02, 4.684D-02, 4.973D-02, 5.213D-02, 5.455D-02, 5.707D-02, + 5.972D-02, 6.248D-02, 6.511D-02, 6.777D-02, 7.054D-02, 7.342D-02, + 7.642D-02, 7.957D-02, 8.355D-02, 8.773D-02, 9.212D-02, 9.673D-02, + 1.021D-01, 1.089D-01, 1.162D-01, 1.239D-01, 1.356D-01, 1.496D-01, + 1.679D-01, 1.932D-01, 2.366D-01, 2.881D-01, 3.674D-01/ C DATA SFR10 /1.259D-07, 6.292D-07, 1.258D-06, 1.888D-06, 2.517D-06, + 3.146D-06, 3.775D-06, 4.405D-06, 5.034D-06, 5.663D-06, 6.292D-06, + 6.921D-06, 7.551D-06, 8.180D-06, 8.809D-06, 9.438D-06, 1.007D-05, + 1.070D-05, 1.133D-05, 1.196D-05, 1.258D-05, 1.321D-05, 1.384D-05, + 1.447D-05, 1.510D-05, 1.573D-05, 1.636D-05, 1.699D-05, 1.762D-05, + 1.825D-05, 1.888D-05, 1.951D-05, 2.013D-05, 2.076D-05, 2.139D-05, + 2.091D-05, 2.227D-05, 2.322D-05, 2.334D-05, 2.346D-05, 2.358D-05, + 2.370D-05, 2.382D-05, 2.394D-05, 2.443D-05, 2.499D-05, 2.540D-05, + 2.575D-05, 2.610D-05, 2.646D-05, 2.683D-05, 2.733D-05, 2.791D-05, + 2.849D-05, 2.909D-05, 2.994D-05, 3.148D-05, 3.309D-05, 3.392D-05, + 3.469D-05, 3.547D-05, 3.626D-05, 3.708D-05, 3.791D-05/ C DATA SFR11 /3.886D-05, 3.998D-05, 4.113D-05, 4.231D-05, 4.352D-05, + 4.477D-05, 4.633D-05, 4.819D-05, 5.013D-05, 5.214D-05, 5.424D-05, + 5.625D-05, 5.829D-05, 6.041D-05, 6.260D-05, 6.487D-05, 6.708D-05, + 6.879D-05, 7.054D-05, 7.233D-05, 7.417D-05, 7.605D-05, 7.799D-05, + 7.997D-05, 8.200D-05, 8.444D-05, 8.702D-05, 8.968D-05, 9.242D-05, + 9.525D-05, 9.816D-05, 1.012D-04, 1.048D-04, 1.089D-04, 1.132D-04, + 1.176D-04, 1.223D-04, 1.271D-04, 1.335D-04, 1.405D-04, 1.479D-04, + 1.557D-04, 1.644D-04, 1.739D-04, 1.839D-04, 1.945D-04, 2.058D-04, + 2.179D-04, 2.306D-04, 2.440D-04, 2.579D-04, 2.721D-04, 2.872D-04, + 3.030D-04, 3.191D-04, 3.334D-04, 3.483D-04, 3.639D-04, 3.801D-04, + 3.972D-04, 4.157D-04, 4.351D-04, 4.554D-04, 4.767D-04/ C DATA SFR12 /4.990D-04, 5.186D-04, 5.385D-04, 5.592D-04, 5.806D-04, + 6.029D-04, 6.261D-04, 6.473D-04, 6.684D-04, 6.902D-04, 7.127D-04, + 7.360D-04, 7.600D-04, 7.848D-04, 8.094D-04, 8.342D-04, 8.597D-04, + 8.860D-04, 9.131D-04, 9.411D-04, 9.699D-04, 9.995D-04, 1.038D-03, + 1.078D-03, 1.119D-03, 1.162D-03, 1.207D-03, 1.253D-03, 1.322D-03, + 1.396D-03, 1.475D-03, 1.559D-03, 1.650D-03, 1.749D-03, 1.853D-03, + 1.964D-03, 2.084D-03, 2.214D-03, 2.351D-03, 2.497D-03, 2.642D-03, + 2.794D-03, 2.955D-03, 3.125D-03, 3.275D-03, 3.423D-03, 3.578D-03, + 3.740D-03, 3.909D-03, 4.090D-03, 4.283D-03, 4.486D-03, 4.698D-03, + 4.920D-03, 5.126D-03, 5.323D-03, 5.528D-03, 5.740D-03, 5.960D-03, + 6.189D-03, 6.411D-03, 6.622D-03, 6.840D-03, 7.065D-03/ C DATA SFR13 /7.298D-03, 7.538D-03, 7.787D-03, 8.033D-03, 8.272D-03, + 8.518D-03, 8.772D-03, 9.033D-03, 9.302D-03, 9.578D-03, 9.863D-03, + 1.023D-02, 1.067D-02, 1.112D-02, 1.160D-02, 1.210D-02, 1.264D-02, + 1.357D-02, 1.456D-02, 1.562D-02, 1.646D-02, 1.727D-02, 1.812D-02, + 1.901D-02, 1.994D-02, 2.123D-02, 2.261D-02, 2.408D-02, 2.562D-02, + 2.722D-02, 2.891D-02, 3.071D-02, 3.242D-02, 3.404D-02, 3.574D-02, + 3.752D-02, 3.939D-02, 4.147D-02, 4.370D-02, 4.604D-02, 4.852D-02, + 5.096D-02, 5.323D-02, 5.561D-02, 5.809D-02, 6.068D-02, 6.337D-02, + 6.604D-02, 6.883D-02, 7.173D-02, 7.475D-02, 7.791D-02, 8.255D-02, + 8.875D-02, 9.543D-02, 1.041D-01, 1.166D-01, 1.307D-01, 1.467D-01, + 1.646D-01, 1.846D-01, 2.087D-01, 2.395D-01, 3.162D-01/ C DATA SFR20 /1.000D-06, 1.102D-06, 2.204D-06, 3.306D-06, 4.407D-06, + 5.509D-06, 6.611D-06, 7.713D-06, 8.815D-06, 9.917D-06, 1.102D-05, + 1.212D-05, 1.322D-05, 1.432D-05, 1.543D-05, 1.653D-05, 1.763D-05, + 1.873D-05, 1.983D-05, 2.094D-05, 2.204D-05, 2.314D-05, 2.424D-05, + 2.534D-05, 2.644D-05, 2.755D-05, 2.865D-05, 2.975D-05, 3.085D-05, + 3.195D-05, 3.306D-05, 3.416D-05, 3.471D-05, 3.665D-05, 3.785D-05, + 3.877D-05, 3.965D-05, 4.060D-05, 4.161D-05, 4.265D-05, 4.366D-05, + 4.470D-05, 4.576D-05, 4.684D-05, 4.876D-05, 5.086D-05, 5.295D-05, + 5.420D-05, 5.548D-05, 5.680D-05, 5.814D-05, 5.952D-05, 6.093D-05, + 6.329D-05, 6.577D-05, 6.835D-05, 7.103D-05, 7.407D-05, 7.738D-05, + 8.084D-05, 8.445D-05, 8.825D-05, 9.227D-05, 9.647D-05/ C DATA SFR21 /1.009D-04, 1.055D-04, 1.102D-04, 1.151D-04, 1.202D-04, + 1.255D-04, 1.311D-04, 1.363D-04, 1.418D-04, 1.474D-04, 1.533D-04, + 1.594D-04, 1.654D-04, 1.712D-04, 1.772D-04, 1.834D-04, 1.898D-04, + 1.965D-04, 2.032D-04, 2.091D-04, 2.151D-04, 2.213D-04, 2.277D-04, + 2.342D-04, 2.409D-04, 2.479D-04, 2.556D-04, 2.641D-04, 2.729D-04, + 2.820D-04, 2.914D-04, 3.011D-04, 3.111D-04, 3.229D-04, 3.365D-04, + 3.506D-04, 3.653D-04, 3.807D-04, 3.967D-04, 4.190D-04, 4.430D-04, + 4.685D-04, 4.953D-04, 5.247D-04, 5.560D-04, 5.892D-04, 6.244D-04, + 6.618D-04, 7.015D-04, 7.435D-04, 7.881D-04, 8.319D-04, 8.774D-04, + 9.255D-04, 9.763D-04, 1.022D-03, 1.064D-03, 1.108D-03, 1.153D-03, + 1.201D-03, 1.250D-03, 1.303D-03, 1.359D-03, 1.418D-03/ C DATA SFR22 /1.478D-03, 1.542D-03, 1.603D-03, 1.658D-03, 1.715D-03, + 1.773D-03, 1.834D-03, 1.897D-03, 1.962D-03, 2.024D-03, 2.084D-03, + 2.145D-03, 2.209D-03, 2.274D-03, 2.341D-03, 2.410D-03, 2.481D-03, + 2.566D-03, 2.662D-03, 2.761D-03, 2.864D-03, 2.971D-03, 3.082D-03, + 3.202D-03, 3.341D-03, 3.486D-03, 3.638D-03, 3.796D-03, 3.961D-03, + 4.191D-03, 4.444D-03, 4.712D-03, 4.996D-03, 5.297D-03, 5.616D-03, + 5.954D-03, 6.312D-03, 6.698D-03, 7.107D-03, 7.542D-03, 7.997D-03, + 8.437D-03, 8.902D-03, 9.392D-03, 9.909D-03, 1.039D-02, 1.089D-02, + 1.141D-02, 1.196D-02, 1.253D-02, 1.308D-02, 1.365D-02, 1.425D-02, + 1.488D-02, 1.553D-02, 1.614D-02, 1.670D-02, 1.729D-02, 1.790D-02, + 1.853D-02, 1.918D-02, 1.986D-02, 2.047D-02, 2.108D-02/ C DATA SFR23 /2.171D-02, 2.236D-02, 2.304D-02, 2.373D-02, 2.444D-02, + 2.519D-02, 2.615D-02, 2.715D-02, 2.819D-02, 2.927D-02, 3.039D-02, + 3.155D-02, 3.297D-02, 3.447D-02, 3.603D-02, 3.766D-02, 3.937D-02, + 4.170D-02, 4.436D-02, 4.719D-02, 5.020D-02, 5.346D-02, 5.694D-02, + 6.064D-02, 6.462D-02, 6.894D-02, 7.355D-02, 7.846D-02, 8.335D-02, + 8.845D-02, 9.387D-02, 9.961D-02, 1.043D-01, 1.091D-01, 1.142D-01, + 1.194D-01, 1.250D-01, 1.310D-01, 1.374D-01, 1.441D-01, 1.511D-01, + 1.585D-01, 1.648D-01, 1.714D-01, 1.782D-01, 1.853D-01, 1.927D-01, + 2.005D-01, 2.091D-01, 2.181D-01, 2.275D-01, 2.373D-01, 2.475D-01, + 2.629D-01, 2.822D-01, 3.030D-01, 3.258D-01, 3.515D-01, 3.792D-01, + 4.150D-01, 4.658D-01, 5.345D-01, 6.403D-01, 7.943D-01/ C DATA SFR30 /1.000D-06, 2.396D-06, 4.792D-06, 7.187D-06, 9.583D-06, + 1.198D-05, 1.437D-05, 1.677D-05, 1.917D-05, 2.156D-05, 2.396D-05, + 2.635D-05, 2.875D-05, 3.115D-05, 3.354D-05, 3.594D-05, 3.833D-05, + 4.073D-05, 4.312D-05, 4.552D-05, 4.792D-05, 5.031D-05, 5.271D-05, + 5.510D-05, 5.750D-05, 5.990D-05, 6.229D-05, 6.469D-05, 6.708D-05, + 6.948D-05, 7.187D-05, 7.427D-05, 7.667D-05, 7.906D-05, 8.146D-05, + 8.385D-05, 8.625D-05, 8.865D-05, 9.104D-05, 9.344D-05, 9.583D-05, + 9.823D-05, 1.006D-04, 1.030D-04, 1.054D-04, 1.078D-04, 1.102D-04, + 1.134D-04, 1.149D-04, 1.170D-04, 1.192D-04, 1.215D-04, 1.250D-04, + 1.281D-04, 1.305D-04, 1.330D-04, 1.356D-04, 1.393D-04, 1.432D-04, + 1.473D-04, 1.514D-04, 1.557D-04, 1.601D-04, 1.646D-04/ C DATA SFR31 /1.695D-04, 1.748D-04, 1.802D-04, 1.858D-04, 1.916D-04, + 1.977D-04, 2.041D-04, 2.108D-04, 2.176D-04, 2.247D-04, 2.321D-04, + 2.400D-04, 2.482D-04, 2.566D-04, 2.653D-04, 2.743D-04, 2.822D-04, + 2.904D-04, 2.988D-04, 3.074D-04, 3.163D-04, 3.255D-04, 3.349D-04, + 3.434D-04, 3.521D-04, 3.610D-04, 3.702D-04, 3.795D-04, 3.891D-04, + 3.990D-04, 4.091D-04, 4.236D-04, 4.414D-04, 4.599D-04, 4.791D-04, + 4.992D-04, 5.217D-04, 5.487D-04, 5.770D-04, 6.069D-04, 6.382D-04, + 6.748D-04, 7.138D-04, 7.550D-04, 7.990D-04, 8.494D-04, 9.031D-04, + 9.601D-04, 1.017D-03, 1.069D-03, 1.123D-03, 1.181D-03, 1.241D-03, + 1.309D-03, 1.383D-03, 1.461D-03, 1.544D-03, 1.624D-03, 1.701D-03, + 1.782D-03, 1.866D-03, 1.955D-03, 2.041D-03, 2.126D-03/ C DATA SFR32 /2.215D-03, 2.307D-03, 2.404D-03, 2.504D-03, 2.588D-03, + 2.673D-03, 2.760D-03, 2.851D-03, 2.944D-03, 3.041D-03, 3.141D-03, + 3.231D-03, 3.319D-03, 3.410D-03, 3.504D-03, 3.600D-03, 3.698D-03, + 3.800D-03, 3.904D-03, 4.035D-03, 4.237D-03, 4.450D-03, 4.673D-03, + 4.908D-03, 5.179D-03, 5.485D-03, 5.810D-03, 6.154D-03, 6.549D-03, + 6.996D-03, 7.473D-03, 7.983D-03, 8.535D-03, 9.124D-03, 9.754D-03, + 1.041D-02, 1.109D-02, 1.181D-02, 1.258D-02, 1.338D-02, 1.422D-02, + 1.512D-02, 1.603D-02, 1.686D-02, 1.772D-02, 1.864D-02, 1.960D-02, + 2.051D-02, 2.140D-02, 2.233D-02, 2.331D-02, 2.432D-02, 2.533D-02, + 2.620D-02, 2.711D-02, 2.804D-02, 2.901D-02, 3.001D-02, 3.105D-02, + 3.203D-02, 3.293D-02, 3.385D-02, 3.480D-02, 3.578D-02/ C DATA SFR33 /3.679D-02, 3.782D-02, 3.888D-02, 4.011D-02, 4.220D-02, + 4.439D-02, 4.669D-02, 4.911D-02, 5.197D-02, 5.522D-02, 5.867D-02, + 6.234D-02, 6.680D-02, 7.175D-02, 7.706D-02, 8.289D-02, 8.926D-02, + 9.612D-02, 1.029D-01, 1.094D-01, 1.163D-01, 1.237D-01, 1.320D-01, + 1.411D-01, 1.508D-01, 1.608D-01, 1.700D-01, 1.797D-01, 1.900D-01, + 2.008D-01, 2.115D-01, 2.229D-01, 2.348D-01, 2.474D-01, 2.570D-01, + 2.655D-01, 2.742D-01, 2.832D-01, 2.925D-01, 3.021D-01, 3.120D-01, + 3.237D-01, 3.371D-01, 3.510D-01, 3.655D-01, 3.806D-01, 3.963D-01, + 4.410D-01, 4.951D-01, 5.918D-01, 7.916D-01, 1.000D+00, 1.000D+00, + 1.000D+00, 1.000D+00, 1.000D+00, 1.000D+00, 1.000D+00, 1.000D+00, + 1.000D+00, 1.000D+00, 1.000D+00, 1.000D+00, 1.000D+00/ C C Assume failure. C CALSFR = -1.0D0 C C Check the input values for validity. C IF ((CHAN .LT. 0) .OR. (CHAN .GT. 3)) RETURN IF ((VALUE .LT. 0) .OR. (VALUE .GT. 255)) RETURN C C Calibrate the data point. C CALSFR = SFR(VALUE, CHAN) C C Return to the calling routine. C RETURN END C*DOIT -- Process and write a file containing the data requested. C+ SUBROUTINE DOIT (USEBEG, USEEND, TYPE, RECV, OUTFIL) INTEGER RECV, TYPE, USEBEG(2), USEEND(2) CHARACTER OUTFIL*(*) C C This subroutine will process the requested DE PWI data and write a C user-specified file containing the calibrated data. C C Arguments: C USEBEG (input) : The start time of the desired interval, as follows: C C Index Meaning C ----- ------- C 1 The date in the form YYDDD (January 1 => DDD = 001). C 2 The millisecond of day (0 - 86399999). C C USEEND (input) : The stop time of the desired interval, expressed in C the same format as USEBEG. C TYPE (input) : The type of data desired, as follows: C C TYPE Meaning C ---- ------- C 0 SFR amplitudes. C 1 LFC amplitudes. C 2 SFR phases. C 3 LFC phases. C 4 DC electric fields. C C RECV (input) : The desired receiver for SFR and LFC requests, as C follows: C C RECV Meaning C ---- ------- C 0 Receiver A C 1 Receiver B C C OUTFIL (input) : The name of the desired output file. C-- C Version 1.0 01-Jun-1990 Scott C. Allendorf C - Original version. C Version 1.1 10-Sep-2003 Larry Granroth C Modified for more portable direct access I/O C----------------------------------------------------------------------- INTEGER ANT, ANTA, ANTB, I, IERR, INTBEG(2), INTEND(2), INT1ST(2) INTEGER IUNIT, I4FLIP, J, OPNDAT, OPNUSE, OUNIT, RECORD(442) INTEGER IREC INTEGER RECTIM(2), TIMCMP, TIME(8) DOUBLE PRECISION CHI(2), COR(4, 32), CORHI(8, 8), CORLO(8, 8) DOUBLE PRECISION DATA(4, 32), DATAHI(8, 8), DATALO(8, 8), EXPAR(2) DOUBLE PRECISION EXPER(2), EZDATA(2), FREQ(4, 32), FRQHI(8), FRQLO DOUBLE PRECISION ORBIT(36), SDEV(2) CHARACTER ANTLFC(4)*2, ANTSFR(4)*2, ESTR*12, FILNAM*13, SSTR*12 DATA ANTSFR /'ES', 'EZ', 'EX', ' B'/ DATA ANTLFC /'ES', 'EZ', 'EX', ' H'/ C C Open the output file. C OUNIT = OPNUSE (OUTFIL) C C Determine the start of the first requested day. C INTBEG(1) = USEBEG(1) INTBEG(2) = 0 C C Determine the start of the following day. C CALL TIMADD (INTBEG, 86400000, INTEND, IERR) C C Fill in the initial start time. C INTBEG(2) = USEBEG(2) C C See if the current day contains the requested stop time and adjust the C stop time if necessary. C 10 IF (TIMCMP (INTEND, USEEND) .EQ. 1) THEN INTEND(1) = USEEND(1) INTEND(2) = USEEND(2) END IF C C Determine the earliest possible record that could contain data in the C desired interval. C CALL TIMADD (INTBEG, -15000, INT1ST, IERR) C C Construct the name of the file containing data for this time interval. C WRITE (FILNAM, 1000) 'pwi', INTBEG(1), '.dat' C C Update the user about the progress. C CALL TIMSTR (INTBEG(2), SSTR) CALL TIMSTR (INTEND(2), ESTR) WRITE (*, 2000) 'Processing file', FILNAM, ':', INTBEG(1), SSTR, + 'to', INTEND(1), ESTR C C Open the data file. C IUNIT = OPNDAT (FILNAM) C C If the file could not be opened, move on to the next day. C IF (IUNIT .LT. 0) GOTO 160 IREC = 0 C C Read another record and correct the byte order. C 20 IREC = IREC + 1 READ (IUNIT, REC = IREC, END = 150) RECORD IERR = I4FLIP (RECORD) IF (IERR .EQ. 0) GOTO 150 C C Extract the timestamp from the record. C CALL GETDAT (RECORD, TIME) C C See if the record contains data from the desired interval. C IF (TIMCMP (TIME, INT1ST) .EQ. -1) GOTO 20 IF (TIMCMP (TIME, INTEND) .EQ. 1) GOTO 150 C C Extract the orbit data from the record. C CALL GETORB (RECORD, ORBIT) C C----------------------------------------------------------------------- C Handle SFR amplitude requests. C----------------------------------------------------------------------- C IF (TYPE .EQ. 0) THEN C C Calibrate the data contained in this record. C CALL GETSFR (RECORD, RECV, ANT, DATA, FREQ) C C Write the requested data to the output file. C DO 40 J = 1, 32 C C Calculate the time tag for this data point. C CALL TIMADD (TIME, 1000 * ((J - 1) / 4), RECTIM, IERR) C C Determine if this point is in the desired time range. C IF (TIMCMP (RECTIM, INTBEG) .EQ. -1) GOTO 40 IF (TIMCMP (RECTIM, INTEND) .EQ. 1) GOTO 140 C C Write out the four measurements taken at this time. C DO 30 I = 1, 4 WRITE (OUNIT, 3000) RECTIM(1), RECTIM(2), FREQ(I, J), + DATA(I, J), ANTSFR(ANT + 1), ORBIT(35), ORBIT(8), + ORBIT(7), ORBIT(36) 30 CONTINUE 40 CONTINUE C C----------------------------------------------------------------------- C Handle LFC amplitude requests. C----------------------------------------------------------------------- C ELSE IF (TYPE .EQ. 1) THEN C C Calibrate the data contained in this record. C CALL GETLFC (RECORD, RECV, ANT, DATAHI, DATALO, FRQHI, FRQLO) C C Write the requested data to the output file. C DO 70 J = 1, 8 C C Calculate the time tag for this data point. C CALL TIMADD (TIME, 1000 * (J - 1), RECTIM, IERR) C C Determine if this point is in the desired time range. C IF (TIMCMP (RECTIM, INTBEG) .EQ. -1) GOTO 70 IF (TIMCMP (RECTIM, INTEND) .EQ. 1) GOTO 140 C C Write out the eight LFC low band measurements taken at this time. C DO 50 I = 1, 8 WRITE (OUNIT, 3000) RECTIM(1), RECTIM(2), FRQLO, + DATALO(I, J), ANTLFC(ANT + 1), ORBIT(35), ORBIT(8), + ORBIT(7), ORBIT(36) 50 CONTINUE C C Write out the eight LFC high band measurements taken at this time. C DO 60 I = 1, 8 WRITE (OUNIT, 3000) RECTIM(1), RECTIM(2), FRQHI(J), + DATAHI(I, J), ANTLFC(ANT + 1), ORBIT(35), ORBIT(8), + ORBIT(7), ORBIT(36) 60 CONTINUE 70 CONTINUE C C----------------------------------------------------------------------- C Handle SFR phase requests. C----------------------------------------------------------------------- C ELSE IF (TYPE .EQ. 2) THEN C C Calibrate the data contained in this record. C CALL GETPHS (RECORD, ANTA, ANTB, DATA, COR, FREQ) C C Write the requested data to the output file. C DO 90 J = 1, 32 C C Calculate the time tag for this data point. C CALL TIMADD (TIME, 1000 * ((J - 1) / 4), RECTIM, IERR) C C Determine if this point is in the desired time range. C IF (TIMCMP (RECTIM, INTBEG) .EQ. -1) GOTO 90 IF (TIMCMP (RECTIM, INTEND) .EQ. 1) GOTO 140 C C Write out the four measurements taken at this time. C DO 80 I = 1, 4 IF (COR(I, J) .NE. -1.0D0) + WRITE (OUNIT, 4000) RECTIM(1), RECTIM(2), FREQ(I, J), + DATA(I, J), COR(I, J), ANTSFR(ANTA + 1), + ANTSFR(ANTB + 1), ORBIT(35), ORBIT(8), ORBIT(7), + ORBIT(36) 80 CONTINUE 90 CONTINUE C C----------------------------------------------------------------------- C Handle LFC phase requests. C----------------------------------------------------------------------- C ELSE IF (TYPE .EQ. 3) THEN C C Calibrate the data contained in this record. C CALL GETPHL (RECORD, ANTA, ANTB, DATAHI, DATALO, CORHI, CORLO, + FRQHI, FRQLO) C C Write the requested data to the output file. C DO 120 J = 1, 8 C C Calculate the time tag for this data point. C CALL TIMADD (TIME, 1000 * (J - 1), RECTIM, IERR) C C Determine if this point is in the desired time range. C IF (TIMCMP (RECTIM, INTBEG) .EQ. -1) GOTO 120 IF (TIMCMP (RECTIM, INTEND) .EQ. 1) GOTO 140 C C Write out the eight LFC low band measurements taken at this time. C DO 100 I = 1, 8 IF (CORLO(I, J) .NE. -1.0D0) + WRITE (OUNIT, 4000) RECTIM(1), RECTIM(2), FRQLO, + DATALO(I, J), CORLO(I, J), ANTLFC(ANTA + 1), + ANTLFC(ANTB + 1), ORBIT(35), ORBIT(8), ORBIT(7), + ORBIT(36) 100 CONTINUE C C Write out the eight LFC high band measurements taken at this time. C DO 110 I = 1, 8 IF (CORHI(I, J) .NE. -1.0D0) + WRITE (OUNIT, 4000) RECTIM(1), RECTIM(2), FRQHI(J), + DATAHI(I, J), CORHI(I, J), ANTLFC(ANTA + 1), + ANTLFC(ANTB + 1), ORBIT(35), ORBIT(8), ORBIT(7), + ORBIT(36) 110 CONTINUE 120 CONTINUE C----------------------------------------------------------------------- C Handle DC electric field requests. C----------------------------------------------------------------------- ELSE C C Calibrate the data contained in this record. C CALL GETDC (RECORD, EXPER, EXPAR, CHI, EZDATA, SDEV) C C Write the requested data to the output file. C DO 130 I = 1, 2 C C Calculate the time tag for this data point. C CALL TIMADD (TIME, 4000 * (I - 1) - 1000, RECTIM, IERR) C C Determine if this point is in the desired time range. C IF (TIMCMP (RECTIM, INTBEG) .EQ. -1) GOTO 130 IF (TIMCMP (RECTIM, INTEND) .EQ. 1) GOTO 140 C C Write out the measurements taken at this time. C IF (CHI(I) .NE. -1.0D0) + WRITE (OUNIT, 5000) RECTIM(1), RECTIM(2), EXPER(I), + EXPAR(I), CHI(I), 'EX', ORBIT(35), ORBIT(8), + ORBIT(7), ORBIT(36) IF (SDEV(I) .NE. -1.0D0) + WRITE (OUNIT, 5000) RECTIM(1), RECTIM(2), EZDATA(I), + 0.0, SDEV(I), 'EZ', ORBIT(35), ORBIT(8), ORBIT(7), + ORBIT(36) 130 CONTINUE END IF C C Get the next record. C 140 GOTO 20 C C Close the current data file. C 150 CLOSE (IUNIT) C C Make the last stop time the new start time. C 160 INTBEG(1) = INTEND(1) INTBEG(2) = INTEND(2) C C If the new start time is the same as the requested end of the C interval, we are finished. C IF (TIMCMP (INTBEG, USEEND) .EQ. 0) GOTO 170 C C Calculate the next stop time and process the data. C CALL TIMADD (INTBEG, 86400000, INTEND, IERR) GOTO 10 C C Close the output file. C 170 CLOSE (OUNIT) C C Return to the calling routine. C 1000 FORMAT (A3, I5.5, A4) 2000 FORMAT (1X, A15, 1X, A13, A1, 1X, I5.5, 1X, A12, 1X, A2, 1X, I5.5, + 1X, A12) 3000 FORMAT (1X, I5, 1X, I8.8, 1X, 1P, E13.7, 1X, E9.3, 0P, 1X, A2, 1X, + F4.2, 1X, F8.2, 1X, F5.2, 1X, F6.2) 4000 FORMAT (1X, I5, 1X, I8.8, 1X, 1P, E13.7, 0P, 1X, F7.3, 1X, F5.3, + 1X, A2, 1X, A2, 1X, F4.2, 1X, F8.2, 1X, F5.2, 1X, F6.2) 5000 FORMAT (1X, I5, 1X, I8.8, 1X, 1P, E10.3, 1X, E10.3, 1X, E10.3, 0P, + 1X, A2, 1X, F4.2, 1X, F8.2, 1X, F5.2, 1X, F6.2) RETURN END C*GETB -- Calculate the local magnetic field. C+ SUBROUTINE GETB (DATE, POS, LAT, LONG, B) INTEGER DATE DOUBLE PRECISION B(3), LAT, LONG, POS(3) C C This subroutine calculates the local magnetic field using the MAGSAT C model. The code was originally derived from the ONEMAG program C described in document NSSDC 72-12 from the National Space Science Data C Center. The code was modified to use the MAGSAT coefficients by Dr. C Daniel R. Weimer in February 1984. The secular variation coefficients C are from the IGRF 1980 model. C C Arguments: C DATE (input) : The date expressed as YYDDD C (January 1 => DDD = 001). C POS (input) : The GEI satellite position vector expressed in km. C LAT (input) : The geocentric latitude of the spacecraft expressed C in degrees. C LONG (input) : The east longitude of the spacecraft (degrees). C B (output) : The rectangular GEI components of the local C magnetic field expressed in gauss. C-- C Version 1.0 03-Sep-90 Scott C. Allendorf C - Modification of MAGSAT subroutine. C----------------------------------------------------------------------- LOGICAL FIRST INTEGER EPS, LY, M, N, YEAR DOUBLE PRECISION APHI(3), AR(3), ATHETA(3), BPHI, BR, BTHETA DOUBLE PRECISION C(2:10, 0:8), CP(10), CPHI, CTHETA, DEGRAD DOUBLE PRECISION DP(0:10, 0:10), FRACYR, GT(0:10, 0:10) DOUBLE PRECISION G0(0:10, 0:10), P(0:10, 0:10), PMAG, R(10), RE DOUBLE PRECISION RHO, S(0:10, 0:10), SP(10), SPHI, STHETA, T DOUBLE PRECISION TEMP, T0 SAVE C, FIRST, GT, G0, T0 DATA FIRST, T0 /.TRUE., 1979.85D0/ C C These are the internal spherical harmonic coefficients for the C MGST(6/80) magnetic field model. The coefficients are are expressed C in nanoTesla and are stored as follows: C C g(n, m) ==> G(N, M) C h(n, m) ==> G(M - 1, N) C DATA G0 / 1.0, -29989.6, -1994.8, 1279.9, 938.3, -217.4, + 48.3, 71.7, 18.4, 5.6, -3.3, 5608.1, -1958.6, + 3027.2, -2179.8, 782.5, 357.6, 65.2, -59.0, 6.8, + 10.4, -3.5, -2127.3, -196.1, 1661.6, 1251.4, 398.4, + 261.0, 41.4, 1.6, -0.1, 1.1, 2.5, -334.4, + 270.7, -251.1, 833.0, -419.2, -73.9, -192.2, 20.5, + -10.8, -12.6, -5.3, 211.6, -256.7, 52., -297.6, + 199.3, -162.0, 3.5, -12.6, -7.0, 9.5, -2.1, + 45.2, 149.4, -150.3, -78.1, 91.8, -48.3, 13.7, + 0.6, 4.3, -3.3, 4.6, -14.5, 93.4, 70.6, + -42.9, -2.4, 16.9, -107.6, 10.6, 2.7, -1.3, + 3.1, -82.4, -27.5, -4.9, 16.1, 18.1, -22.9, + -9.9, -2.0, 6.3, 6.8, 0.6, 6.9, -17.9, + 4.0, -22.3, 9.2, 16.1, -13.1, -14.8, -1.2, + 1.4, 1.8, -21.1, 15.2, 8.9, -4.8, -6.5, + 9.0, 9.5, -5.9, 2.1, -5.1, 2.8, 1.4, + 0.4, 2.6, 5.6, -4.2, -0.4, -1.3, 3.5, + -0.5, -6.2, -0.5/ C C These are the secular variations in the spherical harmonic C coefficients of the International Geomagnetic Reference Field 1980. C The coefficients are expressed in nanoTesla/year and are stored as C follows: C C gdot(n, m) ==> GT(N, M) C hdot(n, m) ==> GT(M - 1, N) C DATA GT / + 1.0, 22.4, -18.3, 0.0, -1.4, 1.5, 0.4, -1.0, 0.8, 2 * 0.0, + -15.9, 11.3, 3.2, -6.5, -1.4, 0.4, 0.0, -0.8, -0.2, 2 * 0.0, + -12.7, -25.2, 7.0, -0.7, -8.2, -0.8, 3.4, 0.4, -0.3, 2 * 0.0, + 0.2, 2.7, -7.9, 1.0, -1.8, -3.3, 0.8, 0.5, 0.0, 2 * 0.0, + 4.6, 1.6, 2.9, 0.4, -5.0, 0.2, 0.8, 1.6, -0.8, 2 * 0.0, + 1.8, -0.4, 0.0, 1.3, 2.1, 1.4, 0.3, 0.1, -0.2, 2 * 0.0, + -0.5, -1.4, 0.0, -1.6, 0.5, 0.0, -0.1, 0.1, 0.7, 2 * 0.0, + -0.4, 0.4, 0.2, 1.4, -0.5, -0.1, 1.1, 0.0, -0.3, 2 * 0.0, + -0.1, -0.7, 0.0, -0.8, 0.2, 0.2, -1.1, 0.8, 1.2, 2 * 0.0, + 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 2 * 0.0, + 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 2 * 0.0/ C C Define a useful constant. C DEGRAD = DATAN (1.0D0) / 45.0D0 C C Do the initialization that only needs to be done once. C IF (FIRST) THEN C C Calculate the normalization coefficients. These coefficients are the C constants necessary to convert P(N, M) and DP(N, M) to the Schmidt C normalization. C S(0, 0) = 1.0 DO 20 N = 1, 10 S(N, 0) = S(N - 1, 0) * DBLE (2 * N - 1) / DBLE (N) EPS = 2 DO 10 M = 1, N S(N, M) = S(N, M - 1) * DSQRT (DBLE (EPS * (N - M + 1)) / + DBLE (N + M)) S(M - 1, N) = S(N, M) EPS = 1 10 CONTINUE 20 CONTINUE C C Apply the Schmidt normalization to the spherical harmonic C coefficients and the secular variation coefficients. Since P(N, M) C and DP(N, M) are always multiplied by G(N, M) and G(M - 1, N), we may C save execution time by premultiplying the arrays in this manner. C DO 40 N = 0, 10 DO 30 M = 0, 10 G0(N, M) = G0(N, M) * S(N, M) GT(N, M) = GT(N, M) * S(N, M) 30 CONTINUE 40 CONTINUE C C Calculate the constants needed in the Legendre polynomial recursion C relationship. C DO 60 N = 2, 10 DO 50 M = 0, N - 2 C(N, M) = DBLE ((N - 1) ** 2 - M ** 2) / + DBLE ((2 * N - 1) * (2 * N - 3)) 50 CONTINUE 60 CONTINUE C C Record that the initialization has been done. C FIRST = .FALSE. END IF C C Determine the position of the spacecraft. C PMAG = DSQRT (POS(1) ** 2 + POS(2) ** 2 + POS(3) ** 2) RE = PMAG / 6371.2D0 STHETA = DCOS (LAT * DEGRAD) CTHETA = DSIN (LAT * DEGRAD) SPHI = DSIN (LONG * DEGRAD) CPHI = DCOS (LONG * DEGRAD) C C Calculate the epoch in which we are interested. C YEAR = DATE / 1000 LY = 0 IF (MOD (YEAR, 4) .EQ. 0) LY = 1 FRACYR = DBLE (MOD (DATE, 1000) - 1) / DBLE (365 + LY) T = 1900.0D0 + DBLE (YEAR) + FRACYR C C If the epoch has changed, update the coefficients. C IF (T .NE. T0) THEN C C Correct the spherical harmonic coefficients for the secular variation. C DO 80 N = 0, 10 DO 70 M = 0, 10 G0(N, M) = G0(N, M) + GT(N, M) * (T - T0) 70 CONTINUE 80 CONTINUE C C Save the epoch of the coefficients. C T0 = T END IF C C Calculate the powers of r and the values of the trigonometric C functions for multiple angles: C C SP(M) = SIN(M * PHI) C CP(M) = COS(M * PHI) C R(1) = RE ** 3 SP(1) = SPHI CP(1) = CPHI DO 90 M = 2, 10 R(M) = R(M - 1) * RE SP(M) = SPHI * CP(M - 1) + CPHI * SP(M - 1) CP(M) = CPHI * CP(M - 1) - SPHI * SP(M - 1) 90 CONTINUE C C Define the lowest order Legendre polynomial and its derivative. C P(0, 0) = 1.0D0 DP(0, 0) = 0.0D0 C C Initialize the accumualtors. C BR = 0.0D0 BTHETA = 0.0D0 BPHI = 0.0D0 C C Calculate the magnetic field using a series of spherical harmonics. C DO 110 N = 1, 10 DO 100 M = 0, N C C Calculate the associated Legendre polynomials and their derivatives. C IF ((N - 1) .EQ. M) THEN P(N, M) = CTHETA * P(M, M) DP(N, M) = CTHETA * DP(M, M) - STHETA * P(M, M) ELSE IF (N .EQ. M) THEN P(N, M) = STHETA * P(N - 1, N - 1) DP(N, M) = STHETA * DP(N - 1, N - 1) + + CTHETA * P(N - 1, N - 1) ELSE P(N, M) = CTHETA * P(N - 1, M) - C(N, M) * P(N - 2, M) DP(N, M) = CTHETA * DP(N - 1, M) - STHETA * P(N - 1, M) - + C(N, M) * DP(N - 2, M) END IF C C Calculate the next term in the series for the field. C IF (M .EQ. 0) THEN TEMP = G0(N, M) ELSE TEMP = G0(N, M) * CP(M) + G0(M - 1, N) * SP(M) BPHI = BPHI + DBLE (M) / R(N) * P(N, M) * + (G0(N, M) * SP(M) - G0(M - 1, N) * CP(M)) END IF BR = BR + DBLE (N + 1) / R(N) * TEMP * P(N, M) BTHETA = BTHETA - TEMP / R(N) * DP(N, M) 100 CONTINUE 110 CONTINUE C C Convert the components of the field to gauss. C BR = BR / 1.0D5 BTHETA = BTHETA / 1.0D5 BPHI = BPHI / STHETA / 1.0D5 C C Determine the transformation to rectangular coordinates. C RHO = DSQRT (POS(1) ** 2 + POS(2) ** 2) AR(1) = POS(1) / PMAG AR(2) = POS(2) / PMAG AR(3) = POS(3) / PMAG APHI(1) = -POS(2) / RHO APHI(2) = POS(1) / RHO APHI(3) = 0.0D0 CALL VCROSS (APHI, AR, ATHETA) C C Transform the magnetic field to rectangular coordinates. C B(1) = BR * AR(1) + BTHETA * ATHETA(1) + BPHI * APHI(1) B(2) = BR * AR(2) + BTHETA * ATHETA(2) + BPHI * APHI(2) B(3) = BR * AR(3) + BTHETA * ATHETA(3) + BPHI * APHI(3) C C Return to the calling routine. C RETURN END C*GETDAT -- Return the timestamp from a DE PWI data record. C+ SUBROUTINE GETDAT (RECORD, TIME) INTEGER RECORD(442), TIME(8) C C This subroutine will read the timestamp from the DE PWI record and C return it in an array of integer numbers. C C Arguments: C RECORD (input) : A DE PWI data record. C TIME (output) : The timestamp, as follows: C C Index Contents C ----- -------- C 1 Date in form YYDDD (January 1 => DDD = 001). C 2 Millisecond of the day (0 - 86399999). C 3 Year C 4 Day of year (January 1 = 1) C 5 Hour (0 - 23) C 6 Minute (0 - 59) C 7 Second (0 - 59) C 8 Millisecond (0 - 999) C-- C Version 1.0 07-Feb-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- C C Copy the original values from the data record. C TIME(1) = RECORD(2) TIME(2) = RECORD(3) C C Decode the year and day of year. C TIME(3) = RECORD(2) / 1000 + 1900 TIME(4) = MOD (RECORD(2), 1000) C C Decode the time of day. C CALL TIMNRM (RECORD(3), TIME(5)) C C Return to the calling routine. C RETURN END C*GETDC -- Return the calibrated DC E-field data from a DE PWI record. C+ SUBROUTINE GETDC (RECORD, EPER, EPAR, CHI, EZAVE, SDEV) INTEGER RECORD(442) DOUBLE PRECISION CHI(2), EPAR(2), EPER(2), EZAVE(2), SDEV(2) C C This subroutine will read the DC electric field data from the DE PWI C record, calibrate it, remove the effects of the spacecraft spin, and C return it in arrays of double precision numbers. The method used is C taken from Dr. Daniel R. Weimer's Master of Science thesis (University C of Iowa, 1983). C C Arguments: C RECORD (input) : A DE PWI data record. C EPER (output) : The component of the electric field measured in the C spin plane that is perpendicular to the projection C of the local magnetic field on the spin plane, C expressed in volts/meter. C EPAR (output) : The component of the electric field measured in the C spin plane that is parallel to the projection of C the local magnetic field on the spin plane, C expressed in volts/meter. C CHI (output) : An indication of the quality of the data taken with C the Ex antenna. A value of -1.0 indicates that the C corresponding EPAR and EPER could not be C determined. C EZAVE (output) : The average electric field measured by the Ez C antenna, expressed in volts/meter. C SDEV (output) : The standard deviation of the electric field C measured by the Ez antenna. A value of -1.0 C indicates that the corresponding EZAVE could not be C determined. C-- C Version 1.0 11-Jul-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- LOGICAL BUFONE, FIRST INTEGER DATE(8), DIFF(3), GETPER, I, IERR, INDEX, I4BITS, J INTEGER LSTDAT(2), LSTNAD(2), NADIR(2, 2), NUMNAD, PERIOD, SAMPLE INTEGER XCOUNT, ZCOUNT DOUBLE PRECISION ANGLE(96), B(3), BAD, BMAG, C(3), CHISQ, DELPHI DOUBLE PRECISION ESCX, ESCY, EX(96), EXDATA(256), EXPAR, EXPER DOUBLE PRECISION EZ(96), EZDATA(256), FILL, ORBIT(36), PHI(256) DOUBLE PRECISION PHI0, SCB(3), SCVXB(3), SCX(3), SCY(3), SCZ(3) DOUBLE PRECISION SUM, SUMSQ, TWOPI, VINNER, VXB(3), YFIT, YMAG DOUBLE PRECISION ZMAG SAVE BUFONE, FIRST, LSTDAT, LSTNAD, SCZ DATA BAD, FILL, FIRST /-99999.0D0, -999.9999D0, .TRUE./ C C Calculate a useful constant. C TWOPI = 8.0D0 * DATAN (1.0D0) C C Assume failure. C DO 10 I = 1, 2 CHI(I) = -1.0D0 SDEV(I) = -1.0D0 EPER(I) = 0.0D0 EPAR(I) = 0.0D0 EZAVE(I) = 0.0D0 10 CONTINUE C C Determine the current spin period in milliseconds. C PERIOD = GETPER (RECORD) C C Extract the timestamp from the record. C CALL GETDAT (RECORD, DATE) C C Extract the orbit data from the record. C CALL GETORB (RECORD, ORBIT) C C Extract the nadir times from the record. C CALL GETNAD (RECORD, NUMNAD, NADIR) C C Determine the amount of time that has passed since the last record and C determine if a time jump has occurred. C IF (.NOT. FIRST) THEN CALL TIMDIF (LSTDAT, DATE, DIFF, IERR) IF ((DIFF(1) .GT. 0) .OR. (DIFF(2) .GT. 8006)) FIRST = .TRUE. END IF C C If this is the first call, check to see if we have all of the pieces C of information necessary to continue. C IF (FIRST) THEN C C We must have at least one valid nadir time. C IF (NUMNAD .EQ. 0) RETURN C C If the spin axis information is missing from the orbital attitude C data, attempt to estimate it. This is only a good approximation when C the spin axis is perpendicular to the orbital plane (i.e., most of the C time). C IF (ORBIT(21) .EQ. FILL) THEN C C Calculate the normal to the orbital plane (RxV). C CALL VCROSS (ORBIT(24), ORBIT(1), SCZ) C C Calculate the unit vector in the direction of the spin axis. C ZMAG = DSQRT (SCZ(1) ** 2 + SCZ(2) ** 2 + SCZ(3) ** 2) SCZ(1) = SCZ(1) / ZMAG SCZ(2) = SCZ(2) / ZMAG SCZ(3) = SCZ(3) / ZMAG END IF C C Initialize the pointer to the initial buffer. C BUFONE = .TRUE. END IF C C Save the timestamp of the record. C LSTDAT(1) = DATE(1) LSTDAT(2) = DATE(2) C C If possible, update the saved nadir time. C IF (NUMNAD .NE. 0) THEN LSTNAD(1) = NADIR(1, 1) LSTNAD(2) = NADIR(2, 1) END IF C C If possible, update the spacecraft spin vector. C IF (ORBIT(21) .NE. FILL) THEN SCZ(1) = ORBIT(21) SCZ(2) = ORBIT(22) SCZ(3) = ORBIT(23) END IF C C Determine the orientation of the spacecraft at the beginning of the C record. The additional offset is as follows: C C -2.73 radians = -156.42 degrees = -165.00 degrees + 8.58 degrees C C -165 degrees = known offset of -Ex antenna from spacecraft Y axis C 8.58 degrees = empirically determined phase shift due to the capacitor C coupling the antennas to the amplifier C CALL TIMDIF (DATE, LSTNAD, DIFF, IERR) PHI0 = DIFF(3) * TWOPI * DIFF(2) / PERIOD - 2.73D0 C C Calculate the amount of rotation between measurements. The measurments C are taken 1/16th second (62.5 milliseconds) apart. C DELPHI = 62.5D0 * TWOPI / PERIOD C C Calibrate the DC electric field data and store it in the appropriate C half of the buffer. C DO 20 I = 1, 128 C C Determine which buffer to fill. C INDEX = I IF (.NOT. BUFONE) INDEX = INDEX + 128 C C Check to see if any data was recorded in this word. C IF (RECORD(52 + I) .EQ. 0) THEN C C Flag the data as invalid. C EXDATA(INDEX) = BAD EZDATA(INDEX) = BAD ELSE C C Extract the high gain sample taken with the Ex antenna. C SAMPLE = I4BITS (RECORD(52 + I), 8, 24) C C Check to see if the instrument was saturated. C IF ((SAMPLE .LT. 6) .OR. (SAMPLE .GT. 249)) THEN C C If the instrument is saturated, use the low gain sample instead. C SAMPLE = I4BITS (RECORD(52 + I), 8, 16) C C Convert the low gain sample to volts per meter. C EXDATA(INDEX) = DBLE (SAMPLE - 125) * 0.01735D0 C C Convert the high gain sample to volts per meter. C ELSE EXDATA(INDEX) = DBLE (SAMPLE - 128) * 0.0004232D0 END IF C C Extract the high gain sample taken with the Ez antenna. C SAMPLE = I4BITS (RECORD(52 + I), 8, 8) C C Check to see if the instrument was saturated. C IF ((SAMPLE .LT. 6) .OR. (SAMPLE .GT. 249)) THEN C C If the instrument is saturated, use the low gain sample instead. C SAMPLE = I4BITS (RECORD(52 + I), 8, 0) C C Convert the low gain sample to volts per meter. C EZDATA(INDEX) = DBLE (SAMPLE - 125) * 0.0140D0 + 0.007D0 ELSE C C Convert the high gain sample to volts per meter. C EZDATA(INDEX) = DBLE (SAMPLE - 127) * 0.0014D0 END IF END IF C C Determine the orientation of the spacecraft at this measurement. C PHI(INDEX) = PHI0 + DBLE (I - 1) * DELPHI 20 CONTINUE C C Toggle the pointer to the current buffer. C BUFONE = .NOT. BUFONE C C If this is the first call, we don't have enough data to carry out the C reduction, so return to the calling routine. C IF (FIRST) THEN FIRST = .FALSE. RETURN END IF C C Determine the direction of the nadir. C YMAG = DSQRT (ORBIT(24) ** 2 + ORBIT(25) ** 2 + ORBIT(26) ** 2) SCY(1) = -1.0D0 * ORBIT(24) / YMAG SCY(2) = -1.0D0 * ORBIT(25) / YMAG SCY(3) = -1.0D0 * ORBIT(26) / YMAG C C Determine the direction of the third orthogonal vector. C CALL VCROSS (SCY, SCZ, SCX) C C Determine if we need to calculate the local magnetic field. C IF (BMAG .EQ. FILL .OR. BMAG .LT. 0.0D0) THEN C C Calculate the local magnetic field. C CALL GETB (DATE(1), ORBIT(24), ORBIT(5), ORBIT(6), B) BMAG = DSQRT (B(1) ** 2 + B(2) ** 2 + B(3) ** 2) ELSE C C Extract the magnetic field values from the orbital data. C BMAG = ORBIT(10) B(1) = ORBIT(11) B(2) = ORBIT(12) B(3) = ORBIT(13) END IF C C Convert the magnetic field to a unit vector in the spacecraft C coordinate system. C SCB(1) = VINNER (B, SCX) / BMAG SCB(2) = VINNER (B, SCY) / BMAG SCB(3) = VINNER (B, SCZ) / BMAG C C Calculate VxB in GEI coordinates. C CALL VCROSS (ORBIT(27), B, VXB) C C Convert VxB to volts per meter. C VXB(1) = VXB(1) / 10.0D0 VXB(2) = VXB(2) / 10.0D0 VXB(3) = VXB(3) / 10.0D0 C C Convert VxB to spacecraft coordinates. C SCVXB(1) = VINNER (VXB, SCX) SCVXB(2) = VINNER (VXB, SCY) SCVXB(3) = VINNER (VXB, SCZ) C C Analyze the two overlapping six-second records. C DO 50 I = 1, 2 C C Copy the six second segment of data that is to be analyzed. C DO 30 J = 1, 96 C C Determine the index of the next data point. C INDEX = 64 * I + J IF (.NOT. BUFONE) INDEX = INDEX + 128 IF (INDEX .GT. 256) INDEX = INDEX - 256 C C Copy the desired data to the work arrays. C EX(J) = EXDATA(INDEX) EZ(J) = EZDATA(INDEX) ANGLE(J) = PHI(INDEX) 30 CONTINUE C C Fit a sine wave to the data from the Ex antenna. C CALL SINFIT (96, ANGLE, EX, C) C C Determine the components of the measured electric field in the C spacecraft coordinate system after removing the VxB field. C ESCX = C(2) * DSIN (C(3)) - SCVXB(1) ESCY = C(2) * DCOS (C(3)) - SCVXB(2) C C Determine the components of the electric field perendicular to and C parallel to the projection of the magnetic field on the spin plane. C EXPAR = ESCX * SCB(1) + ESCY * SCB(2) EXPER = ESCX * SCB(2) - ESCY * SCB(1) C C Initialize the accumulators. C XCOUNT = 0 ZCOUNT = 0 SUM = 0.0D0 SUMSQ = 0.0D0 CHISQ = 0.0D0 C C Loop through the six seconds of data. C DO 40 J = 1, 96 C C Accumulate the sums necessary for calculating the quality parameter C for the data measured by the Ex antenna. C IF ((EX(J) .NE. BAD) .AND. (C(2) .NE. 0.0D0)) THEN XCOUNT = XCOUNT + 1 YFIT = C(1) + C(2) * DCOS (ANGLE(J) - C(3)) CHISQ = CHISQ + ((EX(J) - YFIT) / C(2)) ** 2 END IF C C Accumulate the sums necessary for calculating the mean and standard C deviation of the electric field measured by the Ez antenna. C IF (EZ(J) .NE. BAD) THEN ZCOUNT = ZCOUNT + 1 SUM = SUM + EZ(J) SUMSQ = SUMSQ + EZ(J) ** 2 END IF 40 CONTINUE C C If there was any valid data, calculate the quality of the fit. C IF (XCOUNT .NE. 0) THEN EPAR(I) = EXPAR EPER(I) = EXPER CHI(I) = DSQRT (CHISQ / DBLE (XCOUNT)) END IF C C If there was any valid data, calculate the mean and standard C deviation of the Ez data. C IF (ZCOUNT .NE. 0) THEN EZAVE(I) = SUM / DBLE (ZCOUNT) SDEV(I) = DSQRT (SUMSQ / DBLE (ZCOUNT) - EZAVE(I) ** 2) EZAVE(I) = EZAVE(I) - SCVXB(3) END IF 50 CONTINUE C C Return to the calling routine. C RETURN END C*GETLFC -- Return the calibrated LFC data from a DE PWI data record. C+ SUBROUTINE GETLFC (RECORD, RECV, ANT, LFCHI, LFCLO, FRQHI, FRQLO) INTEGER ANT, RECORD(442), RECV DOUBLE PRECISION FRQHI(8), FRQLO, LFCHI(8, 8), LFCLO(8, 8) C C This subroutine will read the LFC data from the DE PWI record, C calibrate it, and return it in arrays of double precision numbers. C C Arguments: C RECORD (input) : A DE PWI data record. C RECV (input) : The desired receiver: C C RECV Meaning C ---- ------- C 0 Receiver A C 1 Receiver B C C ANT (output) : The antenna connected to the desired receiver: C C ANT Antenna C --- ------- C 0 Es C 1 Ez C 2 Ex C 3 H C C LFCHI (output) : The calibrated LFC high band data expressed in C the appropriate units of spectral density. C LFCLO (output) : The calibrated LFC low band data expressed in the C appropriate units of spectral density. C FRQHI (output) : The frequencies of the data in the LFCHI array C expressed in Hertz. C FRQLO (output) : The frequency of the data in the LFCLO array C expressed in Hertz. C-- C Version 1.0 18-Jun-1990 Scott C. Allendorf C - Original version. C Version 2.0 03-Jul-1990 Scott C. Allendorf C - Rewrite to only do one receiver per call. C----------------------------------------------------------------------- INTEGER BANDHI, BANDLO, I, I4BITS, J, K, OFFHI, OFFLO, STATUS(27) INTEGER VALHI, VALLO DOUBLE PRECISION BWHI, BWLO, CALBW, CALELN, CALFRQ, CALLFC, CALMAG DOUBLE PRECISION ELEN, VOLTHI, VOLTLO C C Determine the offsets of the desired LFC data in the record. C IF (RECV .EQ. 0) THEN OFFHI = 309 OFFLO = 325 ELSE OFFHI = 341 OFFLO = 357 END IF C C Get the instrument status words. C CALL GETSTS (RECORD, STATUS) C C Determine the antenna connected to this receiver. C IF (RECV .EQ. 0) THEN ANT = STATUS(4) ELSE ANT = STATUS(3) END IF C C Determine the effective electrical length of the antenna. C ELEN = CALELN (ANT) C C Determine the low mode band and its corresponding frequency. C BANDLO = STATUS(1) FRQLO = CALFRQ (5, BANDLO) C C Determine the effective bandwidth for the low mode band. C BWLO = CALBW (5, BANDLO) C C Calibrate the LFC low band data, looping through the eight seconds of C data. C DO 30 K = 0, 7 C C Determine the most recent frequency band recorded in the status words. C BANDHI = STATUS(16 + 3 * (K / 2)) C C If we are on an odd (blind) step and we are in sweep mode, increment C the frequency band. C IF (((2 * (K / 2)) .NE. K) .AND. (STATUS(13) .EQ. 0)) + BANDHI = MOD (BANDHI + 1, 4) C C Calculate the frequency for this data point. C FRQHI(K + 1) = CALFRQ (4, BANDHI) C C Determine the effective bandwidth. C BWHI = CALBW (4, BANDHI) C C Loop through the two words of data for each second. C DO 20 J = 0, 1 C C Unpack the four bytes of data from the word. C DO 10 I = 0, 3 C C Extract one data value for each band from the word. C VALHI = I4BITS (RECORD(OFFHI + 2 * K + J), 8, 24 - 8 * I) VALLO = I4BITS (RECORD(OFFLO + 2 * K + J), 8, 24 - 8 * I) C C Convert the data values to volts. C VOLTHI = CALLFC (0, BANDHI, VALHI) VOLTLO = CALLFC (1, BANDLO, VALLO) C C If we are connected to the magnetic antenna, convert volts to gammas. C IF (ANT .EQ. 3) THEN VOLTHI = CALMAG (4, BANDHI, VOLTHI) VOLTLO = CALMAG (5, BANDLO, VOLTLO) END IF C C Calculate the spectral density and load it into the output array. C LFCHI(4 * J + I + 1, K + 1) = (VOLTHI / ELEN) ** 2 / BWHI LFCLO(4 * J + I + 1, K + 1) = (VOLTLO / ELEN) ** 2 / BWLO 10 CONTINUE 20 CONTINUE 30 CONTINUE C C Return to the calling routine. C RETURN END C*GETNAD -- Return the nadir times from a DE PWI data record. C+ SUBROUTINE GETNAD (RECORD, NUM, TIME) INTEGER NUM, RECORD(442), TIME(2, 2) C C This subroutine will read the nadir times from the DE PWI record and C return the number found and the nadir times in an array of integer C numbers. C C Arguments: C RECORD (input) : A DE PWI data record. C NUM (output) : The number of nadir times contained in the record. C TIME (output) : The nadir times, as follows: C C Index Contents C ----- -------- C (1,N) The date in the form YYDDD (January 1 => DDD = 001). C (2,N) Millisecond of day (0 - 86399999). C C NOTE: N varies between 1 and NUM. The other entries in TIME are set C to zero. C-- C Version 1.0 07-Feb-1990 Scott C. Allendorf C - Original version. C Version 2.0 27-Jul-1990 Scott C. Allendorf C - Rewrite to return the date as well as the C millisecond of day. C Version 2.1 06-Aug-1990 Scott C. Allendorf C - Add checks to remove nadir times that fall C outside of the possible range. C----------------------------------------------------------------------- INTEGER DATE(8), I, IERR, J, MAXNAD(2), MINNAD(2), TIMCMP C C Zero out the time array. C DO 20 J = 1, 2 DO 10 I = 1, 2 TIME(I, J) = 0 10 CONTINUE 20 CONTINUE C C Determine the time stamp of the record. C CALL GETDAT (RECORD, DATE) C C Determine the earliest and latest possible nadir time. C CALL TIMADD (DATE, -500, MINNAD, IERR) CALL TIMADD (DATE, 7500, MAXNAD, IERR) C C Determine the number of nadir times recorded. C NUM = 0 IF (RECORD(48) .NE. -1) NUM = 1 IF (RECORD(49) .NE. -1) NUM = 2 C C If there are no nadir times recorded, return to the calling routine. C IF (NUM .EQ. 0) RETURN C C Fill in the output data. C DO 30 I = 1, NUM C C Fill in the date field from the data record timestamp. C TIME(1, I) = DATE(1) C C Copy the original millisecond value from the data record. C TIME(2, I) = RECORD(47 + I) C C See if the date changed during this record. C IF (ABS (TIME(2, I) - DATE(2)) .GT. 86392000) THEN C C Determine if the date needs to be incremented or decremented. C IF (TIME(2, I) .GT. DATE(2)) THEN C C Decrement the nadir time - it occurred on the previous day. C CALL TIMADD (TIME(1, I), -86400000, TIME(1, I), IERR) ELSE C C Increment the nadir time - it occurred on the following day. C CALL TIMADD (TIME(1, I), 86400000, TIME(1, I), IERR) END IF END IF 30 CONTINUE C C Make sure that the second nadir time (if any) is in the allowed range. C IF (NUM .EQ. 2) THEN C C If the nadir time is too early or too late, clear its entry and C decrement the number of nadir times returned. C IF ((TIMCMP (TIME(1, 2), MINNAD) .EQ. -1) .OR. + (TIMCMP (TIME(1, 2), MAXNAD) .EQ. 1)) THEN TIME(1, 2) = 0 TIME(2, 2) = 0 NUM = 1 END IF END IF C C Make sure that the first nadir time is in the allowed range. C IF ((TIMCMP (TIME(1, 1), MINNAD) .EQ. -1) .OR. + (TIMCMP (TIME(1, 1), MAXNAD) .EQ. 1)) THEN C C Copy the second nadir time (if any) to the first slot. C IF (NUM .EQ. 2) THEN TIME(1, 1) = TIME(1, 2) TIME(2, 1) = TIME(2, 2) END IF C C Clear the unused slot. C TIME(1, NUM) = 0 TIME(2, NUM) = 0 C C Decrement the number of nadir times returned. C NUM = NUM - 1 END IF C C Return to the calling routine. C RETURN END C*GETORB -- Return the orbit data from a DE PWI data record. C+ SUBROUTINE GETORB (RECORD, ORBIT) INTEGER RECORD(442) DOUBLE PRECISION ORBIT(36) C C This subroutine will read the orbit data from the DE PWI record and C return it in an array of double precision floating point numbers. C C Arguments: C RECORD (input) : A DE PWI data record. C ORBIT (output) : The orbit data, as follows: C C Index Contents Units C ----- ------------------------------------------------ ----- C 1 GEI satellite velocity vector. v(x) km/sec C 2 v(y) km/sec C 3 v(z) km/sec C 4 Altitude above the spheroid Earth. km C 5 Geodetic latitude of subsatellite point. degrees C 6 East longitude of the satellite. degrees C 7 Local magnetic time. hours C 8 McIlwain's shell parameter (L). Re C 9 Invariant latitude. degrees C 10 Magnetic field strength. gauss C 11 GEI magnetic field vector. B(x) gauss C 12 B(y) gauss C 13 B(z) gauss C 14 Orbit number. C 15 3-by-3 rotation matrix for the X(x) C 16 transformation from spacecraft X(y) C 17 coordinates to GEI. X(z) C 18 Y(x) C 19 Y(y) C 20 Y(z) C 21 Z(x) C 22 Z(y) C 23 Z(z) C 24 GEI satellite position vector. r(x) km C 25 r(y) km C 26 r(z) km C 27 GEI satellite velocity relative to R(x) km/sec C 28 a rotating atmosphere. R(y) km/sec C 29 R(z) km/sec C 30 GEI unit vector toward the Sun. U(x) km C 31 U(y) km C 32 U(z) km C 33 Phase angle of spin measured from the radians C velocity vector to the x-axis of C the spacecraft. C 34 Sunlight/Darkness: 0 = Darkness, 1 = Sunlight. C 35 Geocentric radial distance (Derived) Re C 36 Magnetic Latitude (Derived) degrees C-- C Version 1.0 30-Jan-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- INTEGER I, LY, YEAR DOUBLE PRECISION DEGRAD, FRACYR, G10, G11, H11, LAT, LONG, PI, P2 DOUBLE PRECISION R, RADDEG, SMLAT, T, TSAVE SAVE LAT, LONG, TSAVE DATA TSAVE /0.0D0/ C C Calculate Pi and related constants to machine precision. C PI = 4.0D0 * DATAN (1.0D0) P2 = PI / 2.0D0 DEGRAD = PI / 180.0D0 RADDEG = 1.0D0 / DEGRAD C C Loop through the orbital data. C DO 20 I = 1, 34 C C Convert from fixed floating point to double precision. C ORBIT(I) = DBLE (RECORD(I + 13)) / 10000.0D0 20 CONTINUE C C Calculate the radial distance. C R = DSQRT (ORBIT(24) ** 2 + ORBIT(25) ** 2 + ORBIT(26) ** 2) ORBIT(35) = R / 6378.2D0 C C Determine the current epoch. C YEAR = RECORD(2) / 1000 LY = 0 IF (MOD (YEAR, 4) .EQ. 0) LY = 1 FRACYR = DBLE (MOD (RECORD(2), 1000) - 1) / DBLE (365 + LY) T = 1900.0D0 + DBLE (YEAR) + FRACYR C C See if we have already done the calculations for this date. C IF (T .NE. TSAVE) THEN C C Determine the secular variation correction to the spherical harmonic C coefficients. The spherical harmonic coefficients are taken from the C MGST(6/80) magnetic field model. The secular variation coefficients C are taken from the IGRF 1980 magnetic field model. C H11 = 5608.1D0 - 15.9D0 * (T - 1979.85D0) G11 = -1958.6D0 + 11.3D0 * (T - 1979.85D0) G10 = -29989.6D0 + 22.4D0 * (T - 1979.85D0) C C Determine the orientation of the magnetic dipole. C LAT = DACOS (G10 / DSQRT (G10 ** 2 + G11 ** 2 + H11 ** 2)) - P2 LONG = PI + DATAN2 (H11, G11) C C Update the saved epoch. C TSAVE = T END IF C C Calculate the magnetic latitude. C SMLAT = DSIN (LAT) * DSIN (DEGRAD * ORBIT(5)) + DCOS (LAT) * + DCOS (DEGRAD * ORBIT(5)) * DCOS (DEGRAD * ORBIT(6) - LONG) ORBIT(36) = RADDEG * DATAN2 (SMLAT, DSQRT (1.0D0 - SMLAT ** 2)) C C Return to the calling routine. C RETURN END C*GETPER -- Calculate the current best estimate of the spin period. C+ INTEGER FUNCTION GETPER (RECORD) INTEGER RECORD(442) C C This function will calculate the current best estimate of the spin C period based on the nadir times returned by GETNAD. C C Returns: C GETPER : The spin period expressed in milliseconds. C C Arguments: C RECORD (input) : A DE PWI data record. C C NOTE: This function expects to see all of the DE PWI data records in C order to maintain the best possible estimate of the spin period. C-- C Version 1.0 01-Aug-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- LOGICAL NONAD INTEGER DATE(8), IERR, LSTDAT(2), LSTNAD(2), NAD(2, 2), NUM INTEGER PERIOD, DIFF(3) SAVE LSTDAT, LSTNAD, NONAD, PERIOD DATA NONAD /.TRUE./ C C Extract the timestamp from the record. C CALL GETDAT (RECORD, DATE) C C Extract the nadir times from the record. C CALL GETNAD (RECORD, NUM, NAD) C C Determine the amount of time that has passed since the last record. C IF (.NOT. NONAD) CALL TIMDIF (LSTDAT, DATE, DIFF, IERR) C C Determine if we need to reinitialize the period. This occurs if we do C not have a saved nadir time or we have detected a time jump. C IF (NONAD .OR. (DIFF(1) .GT. 0) .OR. (DIFF(2) .GT. 8006)) THEN C C Note the fact that we have a saved nadir time (unless the record C didn't contain one). C NONAD = .FALSE. IF (NUM .EQ. 0) NONAD = .TRUE. C C Reinitialize the period to a nominal value. C PERIOD = 6070 ELSE C C Calculate an estimate of the spin period by determining the difference C between the last two nadir times. Don't change the current estimate C unless the calculated value is reasonable. C IF (NUM .GT. 0) THEN CALL TIMDIF (LSTNAD, NAD(1, 1), DIFF, IERR) IF ((DIFF(1) .EQ. 0) .AND. (DIFF(2) .GT. 5500) .AND. + (DIFF(2) .LT. 6500)) PERIOD = DIFF(2) END IF END IF C C If two nadir times are present, determine the spin period using the C supplied nadir times. Don't change the current estimate unless the C calculated value is reasonable. C IF (NUM .EQ. 2) THEN CALL TIMDIF (NAD(1, 1), NAD (1, 2), DIFF, IERR) IF ((DIFF(1) .EQ. 0) .AND. (DIFF(2) .GT. 5500) .AND. + (DIFF(2) .LT. 6500)) PERIOD = DIFF(2) END IF C C Save the last nadir time for future use. C IF (NUM .NE. 0) THEN LSTNAD(1) = NAD(1, NUM) LSTNAD(2) = NAD(2, NUM) END IF C C Save the record timestamp for future use. C LSTDAT(1) = DATE(1) LSTDAT(2) = DATE(2) C C Return the current best estimate of the spin period. C GETPER = PERIOD C C Return to the calling routine. C RETURN END C*GETPHL -- Return the calibrated LFC phase data from a DE PWI record. C+ SUBROUTINE GETPHL (RECORD, ANTA, ANTB, LFCHI, LFCLO, + CORHI, CORLO, FRQHI, FRQLO) INTEGER ANTA, ANTB, RECORD(442) DOUBLE PRECISION CORHI(8, 8), CORLO(8, 8), FRQHI(8), FRQLO DOUBLE PRECISION LFCHI(8, 8), LFCLO(8, 8) C C This subroutine will read the LFC phase data from the DE PWI record, C calibrate it, and return it in arrays of double precision numbers. C C Arguments: C RECORD (input) : A DE PWI data record. C ANTA (output) : The antenna connected to LFC-A. C C ANT Antenna C --- ------- C 0 Es C 1 Ez C 2 Ex C 3 H C C ANTB (output) : The antenna connected to LFC-B, encoded in the same C manner as ANTA. C LFCHI (output) : The calibrated LFC high band phase data expressed C in degrees. C LFCLO (output) : The calibrates LFC low band phase data expressed in C degrees. C CORHI (output) : The correlation of the measured LFC high band C phase. A value of -1.0 indicates that the C corresponding phase could not be determined. C CORLO (output) : The correlation of the measured LFC low band phase. C A value of -1.0 indicates that the corresponding C phase could not be determined. C FRQHI (output) : The frequencies if the data in the LFCHI array C expressed in Hertz. C FRQLO (output) : The frequency of the data in the LFCLO array C expressed in Hertz. C-- C Version 1.0 22-Sep-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- INTEGER BANDHI, BANDLO, CHI, CLO, COFFHI, COFFLO, I, I4BITS, J, K INTEGER MODE, SHI, SLO, SOFFHI, SOFFLO, STATUS(27) DOUBLE PRECISION CALFRQ, CTMPHI, CTMPLO, PTMPHI, PTMPLO C C Define the offsets of the data in the record. C SOFFHI = 373 COFFHI = 405 SOFFLO = 389 COFFLO = 421 C C Get the instrument status words. C CALL GETSTS (RECORD, STATUS) C C Determine the antennas connected to the two channels. C ANTA = STATUS(4) ANTB = STATUS(3) C C Determine which mode the instrument is currently in. C IF ((ANTA .EQ. 2) .AND. (ANTB .EQ. 1)) THEN MODE = 0 ELSE IF ((ANTA .EQ. 1) .AND. (ANTB .EQ. 3)) THEN MODE = 1 ELSE IF ((ANTA .EQ. 2) .AND. (ANTB .EQ. 3)) THEN MODE = 2 ELSE MODE = -1 END IF C C Determine the low mode band and its corresponding frequency. C BANDLO = STATUS(1) FRQLO = CALFRQ (5, BANDLO) C C Calibrate the LFC phase data, looping through the eight seconds of C data. C DO 30 K = 0, 7 C C Determine the most recent frequency band recorded in the status words. C BANDHI = STATUS(16 + 3 * (K / 2)) C C If we are on an odd (blind) step and we are in sweep mode, increment C the frequency band. C IF (((2 * (K / 2)) .NE. K) .AND. (STATUS(13) .EQ. 0)) + BANDHI = MOD (BANDHI + 1, 4) C C Calculate the frequency for this data point. C FRQHI(K + 1) = CALFRQ (4, BANDHI) C C Loop through the two words of data for each second. C DO 20 J = 0, 1 C C Unpack the four bytes of data from the word. C DO 10 I = 0, 3 C C Extract the correlator coefficients from the record. C SHI = I4BITS (RECORD(SOFFHI + 2 * K + J), 8, 24 - 8 * I) CHI = I4BITS (RECORD(COFFHI + 2 * K + J), 8, 24 - 8 * I) SLO = I4BITS (RECORD(SOFFLO + 2 * K + J), 8, 24 - 8 * I) CLO = I4BITS (RECORD(COFFLO + 2 * K + J), 8, 24 - 8 * I) C C Determine if the instrument is in a useful mode. C IF (MODE .NE. -1) THEN C C Calculate the phase from the correlation coefficients. C CALL PHACAL (0, SHI, CHI, MODE, 0, 0, PTMPHI, CTMPHI) CALL PHACAL (0, SLO, CLO, MODE, 0, 0, PTMPLO, CTMPLO) ELSE C C Indicate that there is no usable phase data. C PTMPHI = 0.0D0 CTMPHI = -1.0D0 PTMPLO = 0.0D0 CTMPLO = -1.0D0 END IF C C Load the output arrays with the calculated values. C LFCHI(4 * J + I + 1, K + 1) = PTMPHI CORHI(4 * J + I + 1, K + 1) = CTMPHI LFCLO(4 * J + I + 1, K + 1) = PTMPLO CORLO(4 * J + I + 1, K + 1) = CTMPLO 10 CONTINUE 20 CONTINUE 30 CONTINUE C C Return to the calling routine. C RETURN END C*GETPHS -- Return the calibrated SFR phase data from a DE PWI record. C+ SUBROUTINE GETPHS (RECORD, ANTA, ANTB, SFRPHA, CORPHA, FREQ) INTEGER ANTA, ANTB, RECORD(442) DOUBLE PRECISION CORPHA(4, 32), FREQ(4, 32), SFRPHA(4, 32) C C This subroutine will read the SFR phase data from the DE PWI record, C calibrate it, and return it in arrays of double precision numbers. C C Arguments: C RECORD (input) : A DE PWI data record. C ANTA (output) : The antenna connected to SFR-A. C C ANT Antenna C --- ------- C 0 Es C 1 Ez C 2 Ex C 3 B C C ANTB (output) : The antenna connected to SFR-B, encoded in the same C manner as ANTA. C SFRPHA (output) : The calibrated SFR phase data expressed in degrees. C CORPHA (output) : The correlation of the measured phase. C FREQ (output) : The frequencies of the data in the SFRPHA array C expressed in Hertz. C-- C Version 1.0 22-Aug-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- INTEGER AOFF, AVAL, BOFF, BVAL, COFF, CVAL, GETSTP, I, I4BITS, J INTEGER K, MODE, SOFF, STATUS(27), STEP, SVAL DOUBLE PRECISION CALFRQ, CTMP, PHAFIX, PTMP C C Define the offsets of the data in the record. C AOFF = 205 BOFF = 237 SOFF = 269 COFF = 301 C C Get the instrument status words. C CALL GETSTS (RECORD, STATUS) C C Determine the antennas connected to the two channels. C ANTA = STATUS(6) ANTB = STATUS(5) C C Determine which mode the instrument is currently in. C IF ((ANTA .EQ. 2) .AND. (ANTB .EQ. 1)) THEN MODE = 0 ELSE IF ((ANTA .EQ. 1) .AND. (ANTB .EQ. 3)) THEN MODE = 1 ELSE IF ((ANTA .EQ. 2) .AND. (ANTB .EQ. 3)) THEN MODE = 2 ELSE MODE = -1 END IF C C Calibrate the SFR phase data, looping through the eight frequency C steps. C DO 30 K = 0, 7 C C Loop through the four channels. C DO 20 J = 0, 3 C C Unpack the four bytes of data from the word. C DO 10 I = 0, 3 C C Determine the step counter for this frequency step. C STEP = GETSTP (K, I, STATUS) C C Extract the correlator coefficients from the record. C SVAL = I4BITS (RECORD(SOFF - 8 * J + K), 8, 24 - 8 * I) CVAL = I4BITS (RECORD(COFF - 8 * J + K), 8, 24 - 8 * I) C C Extract the SFR amplitude values from the record. C AVAL = I4BITS (RECORD(AOFF - 8 * J + K), 8, 24 - 8 * I) BVAL = I4BITS (RECORD(BOFF - 8 * J + K), 8, 24 - 8 * I) C C Determine if the instrument is in a useful mode. C IF (MODE .NE. -1) THEN C C Calculate the phase from the correlation coefficients. C CALL PHACAL (1, SVAL, CVAL, MODE, J, STEP, PTMP, CTMP) C C Correct the raw phase for known instrumental effects. C PTMP = PHAFIX (J, STEP, AVAL, BVAL, PTMP) C C During the mission, the phase output by SFR channel 2 changed by 60 C degrees. Correct the phase to compensate for this. C IF (J .EQ. 2) PTMP = PTMP - 60.0D0 C C Normalize the phase. C PTMP = DMOD (PTMP, 360.0D0) IF (PTMP .LT. 0.0D0) PTMP = PTMP + 360.0D0 ELSE C C Indicate that there is no usable phase data. C PTMP = 0.0D0 CTMP = -1.0D0 END IF C C Load the output arrays with the calculated values. C SFRPHA(I + 1, 4 * K + J + 1) = PTMP CORPHA(I + 1, 4 * K + J + 1) = CTMP C C Calculate the frequency for this data point. C FREQ(I + 1, 4 * K + J + 1) = CALFRQ (J, STEP) 10 CONTINUE 20 CONTINUE 30 CONTINUE C C Return to the calling routine. C RETURN END C*GETSFR -- Return the calibrated SFR data from a DE PWI data record. C+ SUBROUTINE GETSFR (RECORD, RECV, ANT, SFR, FREQ) INTEGER ANT, RECORD(442), RECV DOUBLE PRECISION FREQ(4, 32), SFR(4, 32) C C This subroutine will read the SFR data from the DE PWI record, C calibrate it, and return it in arrays of double precision numbers. C C Arguments: C RECORD (input) : A DE PWI data record. C RECV (input) : The desired receiver, as follows: C C RECV Meaning C ---- --------- C 0 Receiver A C 1 Receiver B C C ANT (output) : The antenna connected to the desired receiver: C C ANT Antenna C --- ------- C 0 Es C 1 Ez C 2 Ex C 3 B C C SFR (output) : The calibrated SFR data expressed in the C appropriate units of spectral density. C FREQ (output) : The frequencies of the data in the SFR arrays C expressed in Hertz. C-- C Version 1.0 22-Feb-1990 Scott C. Allendorf C - Original version. C Version 2.0 03-Jul-1990 Scott C. Allendorf C - Rewrite to only do one receiver per call. C----------------------------------------------------------------------- INTEGER GETSTP, I, I4BITS, J, K, OFF, STATUS(27), STEP, VALUE DOUBLE PRECISION BW, CALBW, CALELN, CALGAI, CALMAG, CALSFR, ELEN DOUBLE PRECISION CALFRQ, VOLT C C Determine the appropriate offset of the desired data in the record. C IF (RECV .EQ. 0) THEN OFF = 205 ELSE OFF = 237 END IF C C Get the instrument status words. C CALL GETSTS (RECORD, STATUS) C C Determine the antenna connected to this receiver. C IF (RECV .EQ. 0) THEN ANT = STATUS(6) ELSE ANT = STATUS(5) END IF C C Determine the effective electrical length of the antenna. C ELEN = CALELN (ANT) C C Calibrate the SFR data, looping through the eight frequency steps. C DO 30 K = 0, 7 C C Loop through the four channels. C DO 20 J = 0, 3 C C Unpack the four bytes of data from the word. C DO 10 I = 0, 3 C C Determine the step counter for this frequency step. C STEP = GETSTP (K, I, STATUS) C C Extract one data value from the word. C VALUE = I4BITS (RECORD(OFF - 8 * J + K), 8, 24 - 8 * I) C C Convert the data value to volts. C VOLT = CALSFR (J, VALUE) C C Correct the voltage for the gain selection. C VOLT = CALGAI (J, I, STATUS, VOLT) C C Determine the effective bandwidth. C BW = CALBW (J, STEP) C C If we are connected to the magnetic antenna, convert volts to gammas. C IF (ANT .EQ. 3) VOLT = CALMAG (J, STEP, VOLT) C C Calculate the spectral density and load it into the output array. C SFR(I + 1, 4 * K + J + 1) = (VOLT / ELEN) ** 2 / BW C C Calculate the frequency for this data point. C FREQ(I + 1, 4 * K + J + 1) = CALFRQ (J, STEP) 10 CONTINUE 20 CONTINUE 30 CONTINUE C C Return to the calling routine. C RETURN END C*GETSTP -- Return the current SFR step counter. C+ INTEGER FUNCTION GETSTP (TIME, OFFSET, STATUS) INTEGER OFFSET, STATUS(*), TIME C C This function will return the SFR step value corresponding to the C specified time and byte offset taking into account the various modes C of the instrument. C C Returns: C GETSTP : The SFR step value. A negative value is returned C if the input parameters are incorrect. C Arguments: C TIME (input) : The time since the start of the record (0 - 7). C OFFSET (input) : The offset of the byte in the word, counting from C zero at the most significant byte (0 - 3 allowed). C STATUS (input) : The array of status words returned by GETSTS. C-- C Version 1.0 23-Mar-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- LOGICAL TIMES4 INTEGER STSOFF C C Assume failure. C GETSTP = -1 C C Check the input values for validity. C IF ((TIME .LT. 0) .OR. (TIME .GT. 7)) RETURN IF ((OFFSET .LT. 0) .OR. (OFFSET .GT. 3)) RETURN C C Determine the proper offset in the status words for this data point. C STSOFF = 3 * (TIME / 2) C C Determine the most recent step counter from the status words. C GETSTP = STATUS(17 + STSOFF) C C Check to see if we are in SKIP8 or LOCK mode and return to the C calling routine if we are. C IF ((STATUS(2) .EQ. 1) .OR. (STATUS(14) .EQ. 1)) RETURN C C Determine if we are in x4 mode. C TIMES4 = (STATUS(15 + STSOFF) .EQ. 1) C C Increment the step count if we are on an odd (blind) step. C IF ((2 * (TIME / 2)) .NE. TIME) THEN GETSTP = MOD (GETSTP + 1, 32) C C Check to see if we are in x4 mode, and increment the step count C an additional three steps. C IF (TIMES4) GETSTP = MOD (GETSTP + 3, 32) END IF C C Check to see if we are in x4 mode, and increment the step count to C compensate for the offset of the byte in the word. C IF (TIMES4) GETSTP = MOD (GETSTP + OFFSET, 32) C C Return to the calling routine. C RETURN END C*GETSTS -- Return instrument status words from a DE PWI data record. C+ SUBROUTINE GETSTS (RECORD, STATUS) INTEGER RECORD(442), STATUS(27) C C This subroutine will read the instrument status words from the DE PWI C record and return it in an array of integer numbers. C C Arguments: C RECORD (input) : A DE PWI data record. C STATUS (output) : The status words, as follows: C C Index Contents C ----- -------- C 1 LFC Low Band Channel C 0 - 1.78 Hz C 1 - 3.12 Hz C 2 - 6.25 Hz C 3 - 10.0 Hz C 2 SFR Skip Mode C 0 - Skip 1 C 1 - Skip 8 C 3 LFC B Antenna C 0 - Es C 1 - Ez C 2 - Ex C 3 - H C 4 LFC A Antenna C 0 - Es C 1 - Ez C 2 - Ex C 3 - H C 5 SFR B Antenna C 0 - Es C 1 - Ez C 2 - Ex C 3 - B C 6 SFR A Antenna C 0 - Es C 1 - Ez C 2 - Ex C 3 - B C 7 SFR Gain Select C 0 - Low gain (30 dB attenuator) C 1 - High gain C 2 - Low Gain (30dB attenuator) C 3 - Toggle (switch every 0.5 seconds) C 8 CMD 22 Cal Inhibit C 0 - Inhibit C 1 - On C 9 SC 17 Cal Enable C 0 - Disable C 1 - Enable C 10 SFR Antenna Manual/Automatic C 0 - Manual C 1 - Automatic C 11 LFC Antenna Manual/Automatic C 0 - Manual C 1 - Automatic C 12 LFC Low Band Lock/Sweep C 0 - Sweep C 1 - Lock C 13 LFC High Band Lock/Sweep C 0 - Sweep C 1 - Lock C 14 SFR Lock/Sweep C 0 - Sweep C 1 - Lock C 15 SFR x4 Rate (T = 0) C 0 - x1 C 1 - x4 C 16 LFC High Band Channel (T = 0) C 0 - 17.8 Hz C 1 - 31.2 Hz C 2 - 62.5 Hz C 3 - 100 Hz C 17 SFR Step (T = 0) C n (0 - 31) SFR frequency step C 18 SFR x4 Rate (T = 2) C 0 - x1 C 1 - x4 C 19 LFC High Band Channel (T = 2) C 0 - 17.8 Hz C 1 - 31.2 Hz C 2 - 62.5 Hz C 3 - 100 Hz C 20 SFR Step (T = 2) C n (0 - 31) SFR frequency step C 21 SFR x4 Rate (T = 4) C 0 - x1 C 1 - x4 C 22 LFC High Band Channel (T = 4) C 0 - 17.8 Hz C 1 - 31.2 Hz C 2 - 62.5 Hz C 3 - 100 Hz C 23 SFR Step (T = 4) C n (0 - 31) SFR frequency step C 24 SFR x4 Rate (T = 6) C 0 - x1 C 1 - x4 C 25 LFC High Band Channel (T = 6) C 0 - 17.8 Hz C 1 - 31.2 Hz C 2 - 62.5 Hz C 3 - 100 Hz C 26 SFR Step (T = 6) C n (0 - 31) SFR frequency step C 27 Wide Band Data Present C 0 - No wideband data present C 1 - Wideband data present C-- C Version 1.0 15-Feb-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- INTEGER I4BITS C C Extract the values from the data record. A few of the status values C are massaged slightly to provide consistent return values for the C antenna designations. C STATUS(1) = I4BITS (RECORD(4), 2, 6) STATUS(2) = I4BITS (RECORD(5), 1, 7) STATUS(3) = I4BITS (RECORD(6), 2, 6) STATUS(4) = MOD (I4BITS (RECORD(6), 2, 4) + 1, 4) STATUS(5) = I4BITS (RECORD(6), 2, 2) STATUS(6) = MOD (I4BITS (RECORD(6), 2, 0) + 1, 4) STATUS(7) = I4BITS (RECORD(7), 2, 6) STATUS(8) = I4BITS (RECORD(7), 1, 5) STATUS(9) = I4BITS (RECORD(7), 1, 4) STATUS(10) = I4BITS (RECORD(8), 1, 5) STATUS(11) = I4BITS (RECORD(8), 1, 4) STATUS(12) = I4BITS (RECORD(8), 1, 2) STATUS(13) = I4BITS (RECORD(8), 1, 1) STATUS(14) = I4BITS (RECORD(8), 1, 0) STATUS(15) = I4BITS (RECORD(9), 1, 31) STATUS(16) = I4BITS (RECORD(9), 2, 29) STATUS(17) = I4BITS (RECORD(9), 5, 24) STATUS(18) = I4BITS (RECORD(9), 1, 23) STATUS(19) = I4BITS (RECORD(9), 2, 21) STATUS(20) = I4BITS (RECORD(9), 5, 16) STATUS(21) = I4BITS (RECORD(9), 1, 15) STATUS(22) = I4BITS (RECORD(9), 2, 13) STATUS(23) = I4BITS (RECORD(9), 5, 8) STATUS(24) = I4BITS (RECORD(9), 1, 7) STATUS(25) = I4BITS (RECORD(9), 2, 5) STATUS(26) = I4BITS (RECORD(9), 5, 0) STATUS(27) = I4BITS (RECORD(10), 1, 2) C C Return to the calling routine. C RETURN END C*PHACAL -- Calculate the phase from the correlator output. C+ SUBROUTINE PHACAL (SFRFLG, S, C, MODE, CHAN, STEP, PHASE, CORR) INTEGER C, CHAN, MODE, S, SFRFLG, STEP DOUBLE PRECISION PHASE, CORR C C This subroutine will take the given correlation coefficients and the C information about the mode of the instrument and return the calibrated C phase and the correlation coefficient. C C Arguments: C SFRFLG (input) : The correlator the data was obtained from. The C value 0 indicates the LFC, and the value 1 C indicates the SFR. C S (input) : The in-phase correlation coefficient. C C (input) : The quadrature-phase correlation C MODE (input) : The current mode of the instrument, as follows: C C MODE Meaning C ---- ------- C 0 Ex/Ez antenna combination C 1 Ez/Magnetic antenna combination C 2 Ex/Magnetic antenna combination C C CHAN (input) : The SFR channel, as follows: C C CHAN Meaning C ---- ------- C 0 SFR Channel 0 C 1 SFR Channel 1 C 2 SFR Channel 2 C 3 SFR Channel 3 C C STEP (input) : The SFR step counter as indicated in the instrument C status data (0 - 31 allowed). C PHASE (output) : The raw phase derived from the correlation C coefficients expressed in degrees (0.0 - 360.0). C CORR (output) : The correlation coefficient of the phase C measurement (0.0 - SQRT (2.0)). C C NOTE: STEP and CHAN are only used if SFRFLG is equal to 1. C-- C Version 1.0 02-Sep-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- LOGICAL FIRST INTEGER I, J DOUBLE PRECISION BCORR(0:3, 0:31), CALFRQ, F, PI, RADDEG, RHOSC DOUBLE PRECISION RHOSS, SINE(0:255), THETA SAVE BCORR, FIRST, SINE DATA FIRST /.TRUE./ C C Initialize some useful variables. C PI = 4.0D0 * DATAN (1.0D0) RADDEG = 180.0D0 / PI C C On the first call, initialize some arrays. C IF (FIRST) THEN C C Note the fact that we have completed the initialization. C FIRST = .FALSE. C C Initialize the SFR magnetic phase correction table. C DO 20 I = 0, 3 DO 10 J = 0, 31 F = CALFRQ (I, J) BCORR(I, J) = -1.0D0 * (RADDEG * (DATAN2 (F, 6.1D5) + + DATAN2 (F / 6.65D4, 1.0D0 - (F ** 2) / 1.165D9) + + DATAN2 (F, 2.0D6)) + 90.0D0) 10 CONTINUE 20 CONTINUE C C Precompute the table of sines. C DO 30 I = 0, 255 THETA = PI / 2.0D0 * (2.0D0 * DBLE (I) / 250.0D0 - 1.0D0) SINE(I) = DSIN (THETA) 30 CONTINUE END IF C C Determine the correlation coefficients. C RHOSS = SINE(S) RHOSC = SINE(C) C C Calculate the measured phase unless the data is clearly bad. C IF ((RHOSC .EQ. 0.0D0) .AND. (RHOSS .EQ. 0.0D0)) THEN PHASE = 0.0D0 CORR = -1.0D0 RETURN ELSE PHASE = RADDEG * DATAN2 (RHOSC, RHOSS) + 180.0D0 END IF C C Calculate the correlation coefficient. C CORR = DSQRT (RHOSS ** 2 + RHOSC ** 2) C C Apply the appropriate corrections for SFR data. C IF (SFRFLG .EQ. 1) THEN C C Correct for known geometric offsets. C IF (MODE .EQ. 1) PHASE = PHASE + 90.0D0 C C If there is a magnetic antenna involved, correct the phase for the C phase response of the magnetic sensor. C IF (MODE .GT. 0) PHASE = PHASE - BCORR(CHAN, STEP) END IF C C Normalize the result. C PHASE = DMOD (PHASE, 360.0D0) IF (PHASE .LE. 0.0D0) PHASE = PHASE + 360.0D0 C C Return to the calling routine. C RETURN END C*PHAFIX -- Return the SFR phase corrected for instrumental effects. C+ DOUBLE PRECISION FUNCTION PHAFIX (CHAN, STEP, SFRA, SFRB, PHASE) INTEGER CHAN, SFRA, SFRB, STEP DOUBLE PRECISION PHASE C C This function will correct the raw SFR phase for known amplitude and C frequency-dependent instrumental effects. C C Returns: C PHAFIX : The raw phase corrected for known instrumental C effects. A negative value is returned if the input C parameters are incorrect. C Arguments: C CHAN (input) : The SFR channel, as follows: C C CHAN Meaning C ---- ------- C 0 SFR Channel 0 C 1 SFR Channel 1 C 2 SFR Channel 2 C 3 SFR Channel 3 C C STEP (input) : The SFR step counter as indicated in the instrument C status data (0 - 31 allowed). C SFRA (input) : The raw SFR-A amplitude (0 - 255 allowed). C SFRB (input) : The raw SFR-B amplitude (0 - 255 allowed). C PHASE (input) : The SFR phase expressed in degrees (0.0 - 360.0). C-- C Version 1.0 20-Sep-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- INTEGER AINDEX, BINDEX, CALSDB, DBMAXA, DBMAXB, DBMINA, DBMINB, I INTEGER MODVAL, SINDEX, VALA, VALB DOUBLE PRECISION B, C(2), CALPHA, CORR, DELTA, DIFF, LL, LR, T, UL DOUBLE PRECISION UR C C Assume failure. C PHAFIX = -1.0D0 C C Check the input values for validity. C IF ((CHAN .LT. 0) .OR. (CHAN .GT. 3)) RETURN IF ((STEP .LT. 0) .OR. (STEP .GT. 31)) RETURN IF ((SFRA .LT. 0) .OR. (SFRA .GT. 255)) RETURN IF ((SFRB .LT. 0) .OR. (SFRB .GT. 255)) RETURN IF ((PHASE .LT. 0.0D0) .OR. (PHASE .GT. 360.0D0)) RETURN C C Define the boundaries of the calibration tables. C IF (CHAN .EQ. 3) THEN DBMINA = 15 DBMAXA = 65 DBMINB = 25 DBMAXB = 85 ELSE IF (CHAN .EQ. 2) THEN DBMINA = 5 DBMAXA = 95 DBMINB = 5 DBMAXB = 95 ELSE DBMINA = 10 DBMAXA = 100 DBMINB = 10 DBMAXB = 100 END IF C C Determine the SFR amplitude (in dBs) for each instrument. C VALA = CALSDB (0, CHAN, SFRA) VALB = CALSDB (1, CHAN, SFRB) C C Limit the range of the SFR amplitude values appropriately. C IF (VALA .LT. DBMINA) VALA = DBMINA IF (VALA .GT. DBMAXA) VALA = DBMAXA IF (VALB .LT. DBMINB) VALB = DBMINB IF (VALB .GT. DBMAXB) VALB = DBMAXB C C Determine the indices of the element in the table that is less than or C equal to the two amplitudes and the step value. C AINDEX = (VALA - DBMINA) / 10 + 1 BINDEX = (VALB - DBMINB) / 10 + 1 IF (CHAN .EQ. 3) THEN SINDEX = STEP / 8 ELSE SINDEX = STEP / 16 END IF C C Interpolate the phase correction along the amplitude axes for the C tabulated step above and below the specified step. C DO 10 I = 1, 2 C C Get the value of the phase correction at the four entries that C bracket the desired point. C LL = CALPHA (CHAN, BINDEX, AINDEX, SINDEX + I) UL = CALPHA (CHAN, BINDEX + 1, AINDEX, SINDEX + I) LR = CALPHA (CHAN, BINDEX, AINDEX + 1, SINDEX + I) UR = CALPHA (CHAN, BINDEX + 1, AINDEX + 1, SINDEX + I) C C Interpolate to the specified value of the SFR-A amplitude for the C tabulated value of the SFR-B amplitude that is less than the specified C SFR-B amplitude. C DELTA = LR - LL IF (DELTA .GT. 180.0D0) DELTA = DELTA - 360.0D0 IF (DELTA .LT. -180.0D0) DELTA = DELTA + 360.0D0 B = LL + DBLE (MOD (VALA - DBMINA, 10)) * DELTA / 10.0D0 B = DMOD (B, 360.0D0) IF (B .LT. 0.0D0) B = B + 360.0D0 C C Interpolate to the specified value of the SFR-A amplitude for the C tabulated value of the SFR-B amplitude that is larger than the C specified SFR-B amplitude. C DELTA = UR - UL IF (DELTA .GT. 180.0D0) DELTA = DELTA - 360.0D0 IF (DELTA .LT. -180.0D0) DELTA = DELTA + 360.0D0 T = UL + DBLE (MOD (VALA - DBMINA, 10)) * DELTA / 10.0D0 T = DMOD (T, 360.0D0) IF (T .LT. 0.0D0) T = T + 360.0D0 C C Interpolate to the specified value of the SFR-B amplitude. C DELTA = T - B IF (DELTA .GT. 180.0D0) DELTA = DELTA - 360.0D0 IF (DELTA .LT. -180.0D0) DELTA = DELTA + 360.0D0 C(I) = B + DBLE (MOD (VALB - DBMINB, 10)) * DELTA / 10.0D0 C(I) = DMOD (C(I), 360.0D0) IF (C(I) .LT. 0.0D0) C(I) = C(I) + 360.0D0 10 CONTINUE C C Interpolate to the specified step value. C IF (CHAN .EQ. 3) THEN DIFF = 8.0D0 MODVAL = 8 IF (SINDEX .EQ. 3) DIFF = 7.0D0 ELSE DIFF = 16.0D0 MODVAL = 16 IF (SINDEX .EQ. 1) DIFF = 15.0D0 END IF DELTA = C(2) - C(1) IF (DELTA .GT. 180.0D0) DELTA = DELTA - 360.0D0 IF (DELTA .LT. -180.0D0) DELTA = DELTA + 360.0D0 CORR = C(1) + DBLE (MOD (STEP, MODVAL)) * DELTA / DIFF C C Apply the correction to the given phase. C PHAFIX = PHASE - CORR PHAFIX = DMOD (PHAFIX, 360.0D0) IF (PHAFIX .LT. 0.0D0) PHAFIX = PHAFIX + 360.0D0 C C Return to the calling routine. C RETURN END C*SINFIT -- Calculate a least-squares fit to a sine wave. C+ SUBROUTINE SINFIT (NPTS, THETA, EX, S) INTEGER NPTS DOUBLE PRECISION EX(*), S(3), THETA(*) C C This subroutine will perform a least-squares fit of the input data to C a function of the form: C C EX(I) = S(1) + S(2) * COS (THETA(I) - S(3)) C C Arguments: C NPTS (input) : The number of data points passed. C THETA (input) : The angular value (in radians) at which the C measurement was taken. C EX (input) : The value of the measurement. C S (output) : The calculated least-squares coefficients. If an C error condition arises, S is set to 0.0. C C The function to be fit is mathematically equivalent to: C C EX(I) = S(1) + S(2) * COS (THETA(I)) * COS (S(3)) C + S(2) * SIN (THETA(I)) * SIN (S(3)) C C We transform this equation, letting: C C X1 = S(1) C X2 = S(2) * COS (S(3)) C X3 = S(2) * SIN (S(3)) C C We apply a linear least-squares fit to the transformed equation: C C EX(I) = X1 + X2 * COS (THETA(I)) + X3 * SIN (THETA(I)) C C The original coefficients are given by: C C S(1) = X1 C S(2) = SQRT (X2 ** 2 + X3 ** 2) C S(3) = ATAN (X3 / X2) C-- C Version 1.0 13-Jul-1990 Scott C. Allendorf C - Rewrite of original subroutine FLSFIT. C----------------------------------------------------------------------- INTEGER I DOUBLE PRECISION A11, A12, A13, A21, A22, A23, A31, A32, A33, B01 DOUBLE PRECISION B02, B03, CTHETA, DENOM, STHETA, X1, X1NUM, X2 DOUBLE PRECISION X2NUM, X3, X3NUM C C Initialize the solution. C S(1) = 0.0D0 S(2) = 0.0D0 S(3) = 0.0D0 C C Initialize the accumulators. C B01 = 0.0D0 B02 = 0.0D0 B03 = 0.0D0 A11 = 0.0D0 A12 = 0.0D0 A13 = 0.0D0 A22 = 0.0D0 A23 = 0.0D0 A33 = 0.0D0 C C Loop through all of the data points. C DO 10 I = 1, NPTS C C Check to see if the data is valid. C IF (EX(I) .NE. -99999.0D0) THEN C C Precompute the sine and cosine of the angle. C CTHETA = COS (THETA(I)) STHETA = SIN (THETA(I)) C C Accumulate the appropriate sums. C B01 = B01 + EX(I) B02 = B02 + EX(I) * CTHETA B03 = B03 + EX(I) * STHETA A11 = A11 + 1.0D0 A12 = A12 + CTHETA A13 = A13 + STHETA A22 = A22 + CTHETA * CTHETA A23 = A23 + CTHETA * STHETA A33 = A33 + STHETA * STHETA END IF 10 CONTINUE C C Set the remaining matrix elements, exploiting the symmetry in the C equations. C A21 = A12 A31 = A13 A32 = A23 C C Make sure that we were passed some valid data. C IF (A11 .NE. 0.0D0) THEN C C Solve the equations using Cramer's rule. First, calculate the C denominator (the determinant of A). C DENOM = A11 * (A22 * A33 - A23 * A32) - + A12 * (A21 * A33 - A23 * A31) + + A13 * (A21 * A32 - A22 * A31) C C Make sure the determinant is nonsingular. C IF (DENOM .NE. 0.0D0) THEN C C Calculate the numerators for Cramer's rule. C X1NUM = B01 * (A22 * A33 - A23 * A32) - + A12 * (B02 * A33 - A23 * B03) + + A13 * (B02 * A32 - A22 * B03) X2NUM = A11 * (B02 * A33 - A23 * B03) - + B01 * (A21 * A33 - A23 * A31) + + A13 * (A21 * B03 - B02 * A31) X3NUM = A11 * (A22 * B03 - B02 * A32) - + A12 * (A21 * B03 - B02 * A31) + + B01 * (A21 * A32 - A22 * A31) C C Calculate the solution. C X1 = X1NUM / DENOM X2 = X2NUM / DENOM X3 = X3NUM / DENOM C C Convert the solution to the form that the user is expecting. C S(1) = X1 S(2) = DSQRT (X2 ** 2 + X3 ** 2) S(3) = DATAN2 (X3, X2) END IF END IF C C Return to the calling routine. C RETURN END C*TIMADD -- Add the specified number of milliseconds to the given time. C+ SUBROUTINE TIMADD (INTIME, MSEC, OUTTIM, IERR) INTEGER IERR, INTIME(2), MSEC, OUTTIM(2) C C This subroutine will add the specified number of milliseconds to the C supplied time and return the normalized time. Subtraction may be C accomplished by providing a negative value for the number of C milliseconds. C C Arguments: C INTIME (input) : The input time, as follows: C C Index Meaning C ----- ------- C 1 The date in the form YYDDD (January 1 => DDD = 001). C 2 The millisecond of the day (0 - 86399999). C C MSEC (input) : The number of milliseconds to add, in the range C (-86400000 - 86400000) C OUTTIM (output) : The output time in the same format as the input C time. C IERR (output) : A status return value. A value of 1 indicates C successful completion, a value of 0 indicates C an error. C-- C Version 1.0 20-Mar-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- INTEGER DOY, DT, LY, MS, PLY, YEAR C C Assume failure. C IERR = 0 C C Move the time to temporary variables. C DT = MSEC MS = INTIME(2) DOY = MOD (INTIME(1), 1000) YEAR = INTIME(1) / 1000 C C Determine if the input year and the previous year were leap years. C This will only yield correct result for input years in the range 1902 C to 2099 (2 - 199). C LY = 0 PLY = 0 IF (MOD (YEAR, 4) .EQ. 0) LY = 1 IF (MOD (YEAR - 1, 4) .EQ. 0) PLY = 1 C C Check the input values for validity. The year is constrained by the C range of validity of the leap year calculation. C IF (ABS (DT) .GT. 86400000) RETURN IF (MS .LT. 0 .OR. MS .GT. 86399999) RETURN IF (DOY .LT. 1 .OR. DOY .GT. (365 + LY)) RETURN IF (YEAR .LT. 2 .OR. YEAR .GT. 199) RETURN C C Indicate that the subroutine has succeeded. C IERR = 1 C C Add the desired offset (in milliseconds). C MS = MS + DT C C Normalize the time, if necessary. C IF (MS .GT. 86399999) THEN MS = MS - 86400000 DOY = DOY + 1 IF (DOY .GT. (365 + LY)) THEN DOY = 1 YEAR = YEAR + 1 END IF ELSE IF (MS .LT. 0) THEN MS = MS + 86400000 DOY = DOY - 1 IF (DOY .LT. 1) THEN DOY = 365 + PLY YEAR = YEAR - 1 END IF END IF C C Place the values into the output array. C OUTTIM(1) = 1000 * YEAR + DOY OUTTIM(2) = MS C C Return to the calling routine. C RETURN END C*TIMCMP -- Compare two times. C+ INTEGER FUNCTION TIMCMP (TIME1, TIME2) INTEGER TIME1(*), TIME2(*) C C This function will compare the two specified times and determine which C one is later. C C Returns: C TIMCMP : An indication of which time is later. A value of 1 C indicates that the first time is later, a value C of -1 indicates that second time is later, a value C of 0 indicates that the two times are the same. C Arguments: C TIME1 (input) : The first time, as follows: C C Index Meaning C ----- ------- C 1 The date in the form YYDDD (January 1 => DDD = 001). C 2 The millisecond of the day (0 - 86399999). C C TIME2 (input) : The second time in the same format as the first C time. C-- C Version 1.0 24-May-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- C C Assume the times are the same. C TIMCMP = 0 C C Compare the dates and branch appropriately. C IF (TIME1(1) - TIME2(1)) 20, 10, 30 C C Compare the times and branch appropriately. C 10 IF (TIME1(2) - TIME2(2)) 20, 40, 30 C C First date is earlier than the second. C 20 TIMCMP = -1 RETURN C C First date is later than the second. C 30 TIMCMP = 1 C C Return to the calling routine. C 40 RETURN END C*TIMDIF -- Calculate the difference between two specified times. C+ SUBROUTINE TIMDIF (TIME1, TIME2, DIFF, IERR) INTEGER DIFF(3), IERR, TIME1(*), TIME2(*) C C This subroutine will calculate the difference between two specified C times and return the difference expressed in days and milliseconds, as C well as an indication of which time is later. C C Arguments: C TIME1 (input) : The first time, as follows: C C Index Meaning C ----- ------- C 1 The date in the form YYDDD (January 1 => DDD = 001). C 2 The millisecond of the day (0 - 86399999). C C TIME2 (input) : The second time in the same format as the first C time. C DIFF (output) : The difference between the two times, as follows: C C Index Meaning C ----- ------- C 1 The number of whole days between the two times. C 2 The additional milliseconds between the two times. C 3 An indication of which time is later. A value of 1 C indicates that the first time is later, a value of -1 C indicates that second time is later, a value of 0 C indicates that the two times are the same. C C IERR (output) : A status return value. A value of 1 indicates C successful completion, a value of 0 indicates an C error. C-- C Version 1.0 27-Jul-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- INTEGER DATE1(3), DATE2(3), I, LY, TEMP, TIMCMP C C Assume failure. C IERR = 0 C C Extract the year from the input times. C DATE1(1) = TIME1(1) / 1000 DATE2(1) = TIME2(1) / 1000 C C Extract the day of year from the input times. C DATE1(2) = MOD (TIME1(1), 1000) DATE2(2) = MOD (TIME2(1), 1000) C C Extract the millisecond of day from the input times. C DATE1(3) = TIME1(2) DATE2(3) = TIME2(2) C C Check the input years for validity. The year is constrained by the C range of validity of the leap year calculation. C IF ((DATE1(1) .LT. 1) .OR. (DATE1(1) .GT. 199)) RETURN IF ((DATE2(1) .LT. 1) .OR. (DATE2(1) .GT. 199)) RETURN C C Check the input day of years for validity, taking into account leap C years. C LY = 0 IF (MOD (DATE1(2), 4) .EQ. 0) LY = 1 IF ((DATE1(2) .LT. 1) .OR. (DATE1(2) .GT. (365 + LY))) RETURN LY = 0 IF (MOD (DATE2(2), 4) .EQ. 0) LY = 1 IF ((DATE2(2) .LT. 1) .OR. (DATE2(2) .GT. (365 + LY))) RETURN C C Check the input millisecond of days for validity. C IF ((DATE1(3) .LT. 0) .OR. (DATE1(3) .GT. 86399999)) RETURN IF ((DATE2(3) .LT. 0) .OR. (DATE2(3) .GT. 86399999)) RETURN C C Indicate that the subroutine has succeeded. C IERR = 1 C C Determine which time is later. C DIFF(3) = TIMCMP (TIME1, TIME2) C C If the first time is later, swap the times. C IF (DIFF(3) .EQ. 1) THEN DO 10 I = 1, 3 TEMP = DATE1(I) DATE1(I) = DATE2(I) DATE2(I) = TEMP 10 CONTINUE END IF C C Express both times in a common year by decrementing the year and C incrementing the day of year of the later time, until the years are C the same. C 20 IF (DATE2(1) .EQ. DATE1(1)) GOTO 30 C C Decrement the year. C DATE2(1) = DATE2(1) - 1 C C Determine if this year was a leap year. This will only yield correct C results for years in the range 1901 to 2099 (1 - 199). C LY = 0 IF (MOD (DATE2(1), 4) .EQ. 0) LY = 1 C C Add the number of days in this year to the day of year. C DATE2(2) = DATE2(2) + 365 + LY C C Check to see if the times are normalized yet. C GOTO 20 C C Determine if we need to borrow from the day of year to insure that C the millisecond difference is positive. C 30 IF (DATE1(3) .GT. DATE2(3)) THEN C C Decrement the day of the year and increment the millisecond of day. C DATE2(2) = DATE2(2) - 1 DATE2(3) = DATE2(3) + 86400000 END IF C C Load the output array with the difference between the two times. C DIFF(1) = DATE2(2) - DATE1(2) DIFF(2) = DATE2(3) - DATE1(3) C C Return to the calling routine. C RETURN END C*TIMNRM -- Return the normalized time of day. C+ SUBROUTINE TIMNRM (MSEC, TIME) INTEGER MSEC, TIME(4) C C This subroutine will convert the given number of milliseconds to C normalized time and return it in an array of integer numbers. C C Arguments: C MSEC (input) : Millisecond of day (0 - 86399999) C TIME (output) : Normalized time, as follows: C C Index Contents Range C ----- -------- -------- C 1 Hour 0 - 23 C 2 Minute 0 - 59 C 3 Second 0 - 59 C 4 Millisecond 0 - 999 C-- C Version 1.0 07-Feb-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- C C Convert the number of milliseconds to usable values. C TIME(1) = MSEC / 3600000 TIME(2) = MOD (MSEC / 60000, 60) TIME(3) = MOD (MSEC / 1000, 60) TIME(4) = MOD (MSEC, 1000) C C Return to the calling routine. C RETURN END C*TIMSTR -- Return a character string containing the time of day. C+ SUBROUTINE TIMSTR (MSEC, TIME) INTEGER MSEC CHARACTER TIME*12 C C This subroutine will convert the given number of milliseconds to a C normalized time string and return it in a 12 character string. C C Arguments: C MSEC (input) : Millisecond of day (0 - 86399999) C TIME (output) : Normalized time string (HH:MM:SS.MMM) C-- C Version 1.0 07-Feb-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- INTEGER TEMP(4) C C Convert the number of milliseconds to usable values. C CALL TIMNRM (MSEC, TEMP) C C Fill in the character string. C WRITE (TIME, 1000) TEMP(1), TEMP(2), TEMP(3), TEMP(4) C C Return to the calling routine. C 1000 FORMAT (I2.2, ':', I2.2, ':', I2.2, '.', I3.3) RETURN END C*VCROSS -- Calculate a vector cross product. C+ SUBROUTINE VCROSS (A, B, C) DOUBLE PRECISION A(3), B(3), C(3) C C This subroutine will calculate the vector cross product of the vectors C supplied by the user. C C Arguments: C A (input) : The first vector. C B (input) : The second vector. C C (output) : The vector cross product of A and B. C-- C Version 1.0 13-Jul-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- C C Calculate the quantity C = A x B. C C(1) = A(2) * B(3) - B(2) * A(3) C(2) = B(1) * A(3) - A(1) * B(3) C(3) = A(1) * B(2) - B(1) * A(2) C C Return to the calling program. C RETURN END C*VINNER -- Calculate a vector inner product. C+ DOUBLE PRECISION FUNCTION VINNER (A, B) DOUBLE PRECISION A(3), B(3) C C This function will calculate the vector inner product of the vectors C supplied by the user. C C Returns: C VINNER : The vector inner product of A and B. C C Arguments: C A (input) : The first vector. C B (input) : The second vector. C-- C Version 1.0 13-Jul-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- C C Calculate the quantity C = A dot B. C VINNER = A(1) * B(1) + A(2) * B(2) + A(3) * B(3) C C Return to the calling program. C RETURN END