3 SUBROUTINE NIMS_CDS2OHMS(ICHNL,NDATA,OHMS,IR)OC_TITLE NIMS_CDS2OHMS Compute resistance for given CDS channel and data numberC_ARGS8 INTEGER ICHNL !I Channel number (see DESC below)D INTEGER NDATA !I Data number for channel ICHNL (range 0-255)C REAL OHMS !O Resistance corresponding to ICHNL and NDATA: INTEGER IR !O Return code: 0 OK, -1 ICHNL invalid>C_DESC This subroutine applies to the following CDS channels:8C ICHNL CDS CHANNEL LOCATION SENSOR SE TERMINALS8C ===== =========== ======== ====== ============4C 1 E-1911 Shield 15319 L - M4C 2 E-1912 Telescope 15322 F - G4C 3 E-1913 Gr. Mech. 15323 D - E4C 4 E-1914 Chopper ? B - C4C 5 E-1915 Electronics UA-75 N - d6C Values for E-1910 and E-1916, both of which relateBC to the FPA temperature, are handled in subroutine NIMS_FPATMP.:C In this routine, we use the given CDS coefficients to 9C determine a resistance. In the first four cases, the6C answer is found by solving a cubic equation. The :C electronics temperature is linearly related to the DN C value.CC Temperature may be computed from OHMS by routine NIMS_OHMS2TMP.%C NOTE: We are solving the equation.C DN = C3*OHMS^3 + C2*OHMS^2 + C1*OHMS + C0 C The C's are from GLL 625-308:C REFERENCES: GLL Telemetry Conversion Handbook, 625-308<C Appendices A,B of NIMS calibration document.C_CALLS U_FIND_ROOT32C_HIST 16-AUG-88 R Carlson JPL ORIGINAL VERSIONIC 20-FEB-93 R Mehlman UCLA/IGPP Renamed from CDS2OHMS, renamed U_ROOT36C and changed argument order, error parameter added,.C internal documentation put in ISIS format.C_END> DIMENSION C0(5), C1(5), C2(5), C3(5) ! CDS coefficients8 DATA C0/ -53.2668, -52.8356, -51.8332, -51.1541, & -209.424/7 DATA C1/ 0.745103, 0.742733, 0.737517, 0.746692, & 0.719420/: DATA C2/-0.537878E-03, -0.525888E-03, -0.512928E-03,+ & -0.520592E-03, -0.000000E-03/: DATA C3/ 0.251498E-06, 0.237182E-06, 0.226003E-06,+ & 0.204892E-06, 0.000000E-06/$ EPS = 0.001 ! Error parameter/ IF(ICHNL.LT.1) GO TO 750 ! Out of range/ IF(ICHNL.GT.5) GO TO 750 ! Out of range DN = FLOAT(NDATA)? RTRY = (DN - C0(ICHNL))/C1(ICHNL) ! Linear approximation? IF(ICHNL.EQ.5) GO TO 800 ! Linear is adequate for chnl 5G CALL U_FIND_ROOT3(C3(ICHNL),C2(ICHNL),C1(ICHNL),C0(ICHNL)-DN,EPS, 1 RTRY,OHMS) GO TO 900 750 IR = -1"C 750 TYPE *,'ICHNL out of range' RETURN# 800 OHMS = RTRY ! For channel 5 900 IR = 0 RETURN END4 SUBROUTINE NIMS_DET_MODE(KHRS,LPTAB,KPTAB,KMF,0 1 MRPT,MIROP,MGSTART,MGDELTA,MGSTEPS,KMODE)PC_TITLE NIMS_DET_MODE Determine NIMS instrument mode, etc. from HRS hskpng, etcC_ARGS INPUT:? BYTE KHRS(96,10) !I 10 packets of NIMS HRS data: PTABs C are in (3-6,p), p=2,7: BYTE LPTAB(4,2) !I LRS PTABs (acquired in mf 0-2)5 BYTE KPTAB !I Current PTAB: '00'X=1, '80'X=2.C from LRS. Good in mf 11-65 & 68-902 INTEGER KMF !I Current minor frame (0-90)"C OUTPUT FROM CURRENT PTAB:* INTEGER MRPT !O Mode repeat count5 LOGICAL MIROP !O Mirror scan (True or False)< INTEGER MGSTART !O (Logical) grating start position) INTEGER MGDELTA !O Grating delta2 INTEGER MGSTEPS !O Steps in grating cycle$C OUTPUT MODE INTERPRETATION:4 INTEGER KMODE !O Mode determined by routine&C 1,2: full map, spectrometer&C 3,4: long map, spectrometer'C 5,6: short map, spectrometer.C 7,0: fixed map, spectrometer (safe)*C 8,9: bandedge map, spectrometerC -1: undeterminedOC_DESC Extract current PTAB, determine NIMS mode and grating cycle parameters,>C using HRS housekeeping and possibly LRS housekeeping values.3C References: NIMS instrument paper, and GLL 3-280+C_LIMS LRS input not yet used in analysis.C_CALLS U_MOVE1 (ISISLIB)LC_HIST 03nov92 R Mehlman, UCLA/IGPP Entirely rewritten from 31aug84 MODET.OC 06dec92 RMX Added more output arguments: MRPT,MIROP,MGSTART,MGDELTA,MGSTEPS=C 08feb92 RMX Corrected test for bandedge modes (PTAB(4)=1)DC 09mar93 RMX Changed from function to subroutine, input override6C mode removed, parameters renamed, LRS input added.C_END>C Instrument mode tables: position n corresponds to mode n-17C Actual # grating positions (to be used in cube label)DC Nits per mirror cycle (fixed grating cycles use full mirror cycle)!C Entries for modes 10-15 .0C For modes 0-9, mirror moving iff mode is odd. BYTE IBYTE2!C Determine mode from HRS hskpng MIROP=.FALSE. MGSTEPS=KHRS(6,2) IF (MGSTEPS.EQ.0) THEN MGSTEPS=KHRS(6,7) IF (MGSTEPS.EQ.0) GO TO 50 MRPT=KHRS(3,7)! IF (KHRS(4,7).LT.0) MIROP=.TRUE.! CALL U_MOVE1(1,KHRS(4,7),IBYTE2) MGDELTA=KHRS(5,7) ELSE MRPT=KHRS(3,2)! IF (KHRS(4,2).LT.0) MIROP=.TRUE.! CALL U_MOVE1(1,KHRS(4,2),IBYTE2) MGDELTA=KHRS(5,2) END IF MGSTART=IBYTE2.AND.'3F'X IF (MGSTEPS.EQ.24) KMODE=3 IF (MGSTEPS.EQ.12) THEN KMODE=1 IF (MGDELTA.EQ.0) KMODE=7 END IF IF (MGSTEPS.EQ.6) KMODE=5 IF (MGSTEPS.EQ.1) KMODE=8 IF (.NOT.MIROP) THEN KMODE=KMODE+1 IF (MGDELTA.EQ.0) KMODE=0 END IF GO TO 80C Undetermined 50 KMODE=-1 80 CONTINUE@C WRITE (6,90) ((KHRS(I,J),I=3,6),J=2,7,5),LPTAB,KPTAB,KMF,1C 1 MRPT,MIROP,MGSTART,MGDELTA,MGSTEPS,KMODE4C 90 FORMAT (' * NIMS_MODE in: ',8Z3,2X,8Z3,Z5,I3/0C 1 ' out: ',I3,1X,L1,4I3) RETURN END4 SUBROUTINE NIMS_ENGR(ENGR,TDN,ODN,TEMP,RESIST)KC_TITLE NIMS_ENGR Extract NIMS Engineering DNs, compute temperatures, etc.C_ARGS? BYTE ENGR(2,91) !I Engineering items, 2/frame over RIM@ INTEGER TDN(7,6) !O Temperature DNs, 6 kinds, 7 per RIM!C 1 Focal Plane AssemblyC 2 Radiator ShieldC 3 TelescopeC 4 GratingC 5 ChopperC 6 Electronics8 INTEGER ODN(4) !O Other 4 items, DNs, 1 per RIM"C 1 Flexprint temperatureC 2 RCT-Pt temperatureC 3 RCT-Ni temperature%C 4 RCT-reference resistance? REAL*4 TEMP(7,7) !O Temperatures (deg K) corresponding,C to TDN, plus alternate TFPA (from*C composite Pt + Flexprint (SS)),C 7 per RIM; REAL*4 RESIST(7,4) !O Resistances (ohms), 7 per RIM*C 1 RKA: R across terminals K,aC 2 RHPRK: RH + RK,C 3 RHK: R across H,K (RH+RK+Rpt)"C 4 RPT: R of Pt sensorJC_DESC Extract NIMS Engineering DNs from RIM's worth of the 2 EngineeringGC bytes on the EDR; compute corresponding temperatures and resistances.'C Item ID's, names and frequencies are:.C E-1910 Focal Plane Temperature 7 per RIM2C E-1911 Radiator Shield Temperature 7 per RIM-C E-1912 Telescope Temperature 7 per RIM4C E-1913 Grating Mechanism Temperature 7 per RIM2C E-1914 Optical Chopper Temperature 7 per RIM5C E-1915 Electronics Chassis Temperature 7 per RIM-C E-1916 Flexprint Temperature 1 per RIM.C E-1945 RCT-NIMS Temperature-Pt 1 per RIM.C E-1946 RCT-NIMS Temperature-Ni 1 per RIM5C E-1947 RCT-NIMS Reference R(esistance) 1 per RIM>C Reference: GLL 3-280 Table A2.2.8 (Engineering Measurements)AC See NIMS_* subroutines for details of temperature computations."C_CALLS U_FILL1, U_MOVE1 (isislib)5C NIMS_FPATMP, NIMS_CDS2OHMS, NIMS_OHMS2TMP (nimslib)6C_HIST 20feb93, R Mehlman, UCLA/IGPP ORIGINAL VERSIONC_ENDM INTEGER TFRAME(6) /0,0,1,1,2,2/ ! Temperature DN frames (mod 13, 7/RIM)< INTEGER TBYTE(6) /1,2,1,2,1,2/ ! Temperature DN bytesH INTEGER OFRAME(4) /56,29,58,85/ ! Other item DN frames (of 0-90)= INTEGER OBYTE(4) / 1, 1, 1, 1/ ! Other item DN bytes3 REAL EPS /.001/ ! Epsilon for NIMS_FPATMP DO J=1,6 ! Temp. DNs IFRAME = TFRAME(J) + 1 DO I=1,7 CALL U_FILL1( 0, 4, TDN(I,J))7 CALL U_MOVE1( 1, ENGR( TBYTE(J), IFRAME), TDN(I,J) ) IFRAME = IFRAME + 13 ENDDO ENDDO DO I=1,4 ! Other DNs CALL U_FILL1( 0, 4, ODN(I)): CALL U_MOVE1( 1, ENGR( OBYTE(I), OFRAME(I) + 1), ODN(I) ) ENDDO DO I=1,7 ! Compute:G CALL NIMS_FPATMP( TDN(I,1), ODN(1), EPS, RESIST(I,1), ! FPA temp, R'sF 1 RESIST(I,2), RESIST(I,3), RESIST(I,4), TEMP(I,7), TEMP(I,1) ) DO J=2,6 ! Other temps/ CALL NIMS_CDS2OHMS( J-1, TDN(I,J), TOHM, IR)6 CALL NIMS_OHMS2TMP( J-1, TOHM, TCEN, TEMP(I,J), IR) ENDDO ENDDO RETURN END? SUBROUTINE NIMS_FPATMP(N1910,N1916,EPS,RKA,RHPRK,RHK,RPT, 1 TPTSS,TPT)FC_TITLE NIMS_FPATMP Compute FPA temperature from CDS engineering dataC_ARGS; INTEGER N1910 !I Data number for CDS channel E-19104 INTEGER N1916 !I Same for E-1915 (flexprint): REAL EPS !I Error parameter for cubic root routine3 REAL RKA !O Resistance across terminals K,a REAL RHPRK !O RH + RK9 REAL RHK !O Resistance across H,K (RH + RK _ RPt)= REAL RPT !O Resistance of Pt sensor (#15604, FPA 002)9 REAL TPTSS !O FPA temperature from composite Pt +C flexprint (SS), in K< REAL TPT !O FPA temperature from Pt, in K (USE THIS)GC_DESC Computes FPA temperature from CDS engineering data for P/F unit.BC The principal output FPA temperature is TPT, which uses just theCC platinum sensor after subtracting out the simultaneously measuredAC flexprint resistance. The other output FPA temperature, TPTSS,@C assumes the flexprint resistance is also temperature sensitiveHC (slightly). The combination of the two is a "resistance thermometer".<C TPT and TPTSS should agree, providing the optics are cold.4C References: Appendix A, B OF calibration document,>C GLL Telemetry Conversion Handbook, 625-308C_CALLS U_FIND_ROOT32C_HIST 04-SEP-85 R Carlson JPL ORIGINAL VERSIONGC 20-FEB-93 R Mehlman UCLA/IGPP Renamed from FPATMP, renamed U_ROOT3:C and changed argument order, internal documentation putC in ISIS format.C_END6 C01910 = -0.100047619E+03 ! CDS coeff, E-1910 C11910 = 0.680503115E+00 C21910 = -0.342859039E-03 C31910 = 0.925943766E-07/ C01916 = -0.246681101E+03 ! For E-1916 C11916 = 0.721500002E+009 RF = 413.91 ! Ohms, fixed R in FPA8 ETA = 0.98698 ! (RH + RK)/(RK + Ra)D A0PT = -76.64005 ! For Pt R, R=A0 + A1*T + A2*T**2 A1PT = 2.265692 A2PT = -5.6604762E-04@ A0SS = 70.83 ! For SS flexprint resistance A1SS = 0.41932 A2SS = -1.8061E-03D B0 = 34.20093 ! For PT, T = B0 + B1*R + B2*R**2 B1 = 0.4473015 B2 = 6.119418E-05C: A0 = A0PT + A0SS ! For composite Pt + SS A1 = A1PT + A1SS A2 = A2PT + A2SS DN1910 = FLOAT(N1910) DN1916 = FLOAT(N1916)8 RKA = (DN1916 - C01916)/C11916 ! E-1916 is linearF RHPRK = ETA*(RKA - RF) ! from least squares linear fit< RTRY = (DN1910 - C01910)/C11910 ! Initial guess at RHKH CALL U_FIND_ROOT3(C31910,C21910,C11910,C01910-DN1910,EPS,RTRY,RHK)? C = A0 - RHK ! For quadratic equation A B = A1 ! For composite RSS + RPt A = A2- TPTSS = (-B + SQRT(B**2-4.*A*C))/(2.*A) RPT = RHK - RHPRK# TPT = B0 + B1*RPT + B2*RPT**2 GO TO 800C DATA IOLU /6/C WRITE(IOLU,200) C WRITE(IOLU,201) RKAC WRITE(IOLU,202) RHPRKC WRITE(IOLU,203) RHKC WRITE(IOLU,204) RPTC WRITE(IOLU,205) TPTSSC WRITE(IOLU,206) TPTC WRITE(IOLU,207) N1910C WRITE(IOLU,208) N1916C WRITE(IOLU,209)?C 200 FORMAT(1H1,5X,'NIMS P/F FPA Temperature From CDS Values')AC 201 FORMAT(1H0,5X,'R(K-a)...............................',F7.2)AC 202 FORMAT(1H ,5X,'R(H) + R(K)..........................',F7.2)AC 203 FORMAT(1H ,5X,'R(H-K)...............................',F7.2)AC 204 FORMAT(1H ,5X,'R(Pt)................................',F7.2)AC 205 FORMAT(1H ,5X,'Temperature(Pt+SS)...................',F7.2)AC 206 FORMAT(1H ,5X,'Temperature(Pt)......................',F7.2)?C 207 FORMAT(1H ,5X,'DN (E-1910)..........................',I4)?C 208 FORMAT(1H ,5X,'DN (E-1916)..........................',I4)C 209 FORMAT(1H) 800 CONTINUE RETURN END< SUBROUTINE NIMS_GET_MODE_INFO(KMODE,KNGP,KNITS,KGRDEL)IC_TITLE NIMS_GET_MODE_INFO Get grating & mirror cycle info for NIMS modeC_ARGS. INTEGER KMODE !I NIMS instrument mode&C 1,2: full map, spectrometer&C 3,4: long map, spectrometer'C 5,6: short map, spectrometer.C 7,0: fixed map, spectrometer (safe)*C 8,9: bandedge map, spectrometerC 10-15: < INTEGER KNGP !O Actual # grating positions in cycle: INTEGER KNITS !O Number of nits in "mirror" cycle5 INTEGER KGRDEL !O Grating increment for modeGC_DESC This routine returns the number of grating positions, length ofEC mirror cycle and grating increment of a given NIMS instrument mode.5C_HIST 10mar93 R Mehlman UCLA/IGPP ORIGINAL VERSION<C 21jun94 RMX Added grating increment as output parameter./C 08jul94 RMX Minor changes to documentation.C_END>C Instrument mode tables: position n corresponds to mode n-17C Actual # grating positions (to be used in cube label)DC Nits per mirror cycle (fixed grating cycles use full mirror cycle)!C Entries for modes 10-15 .0C For modes 0-9, mirror moving iff mode is odd.K INTEGER NGPOS(16) / 1,12,12,24,24,6,6, 1,2,2,0,0,0,0,0,0/ ! GP/CYCLEM INTEGER NITSPC(16) /13,13,13,26,26,7,7,13,4,4,0,0,0,0,0,0/ ! NITS/CYCLEO INTEGER IGRDEL(16) / 0, 2, 2, 1, 1,4,4, 0,0,0,0,0,0,0,0,0/ ! GRATING INCR* IF (KMODE.GE.0.AND.KMODE.LE.15) THEN KNGP=NGPOS(KMODE+1) KNITS=NITSPC(KMODE+1) KGRDEL=IGRDEL(KMODE+1) ELSE KNGP=0 KNITS=0 KGRDEL=0 END IF RETURN END= SUBROUTINE NIMS_HSKPNG(LHSK,HHSK,CMD,HSKSTAT,DCHAN,IGS,ICHM)MC_TITLE NIMS_HSKPNG Extract NIMS housekeeping items from LRS and HRS for RIMC_ARGS2 BYTE LHSK(3,91) !I LRS bytes, 3/frame over RIM; BYTE HHSK(6,10,91) !I HRS hskpng items, 6/mod10 over RIM5 BYTE CMD(7,2) !O NIMS command (7 bytes: LRS, HRS)= BYTE HSKSTAT(10,2) !O Housekeeping status bytes (LRS, HRS)C 1 Hardware statusC 2 Software status(C 3 Transaction bus parity errors C 4 All bus parity errorsC 5 Power supply input$C 6 Ave grating drive current#C 7 Ave mirror drive currentC 8 Reference voltageC 9 Optics cal sourceC 10 ROM checksum= INTEGER*2 DCHAN(2) !O Si & InSb channels (10-bit LRS only)/ INTEGER IGS(2) !O Gain state (LRS, HRS) 1-4: INTEGER ICHM(2) !O Chopper mode (LRS, HRS) 1 reference'C 2 63-hz 3 free-run 4 offGC_DESC Extract NIMS housekeeping from both LRS and HRS hskpng streams.@C Names and locations are (frames 0-90, packets 0-9, bytes 1-*):C INTEGER LCFRAME(7) / 3, 3, 3, 4, 4, 4, 5/ ! LRS command buffer* INTEGER LCBYTE(7) / 1, 2, 3, 1, 2, 3, 1/C INTEGER HCFRAME(7) / 0, 0, 0, 0, 0, 0, 0/ ! HRS command buffer* INTEGER HCPACKET(7)/ 8, 8, 8, 8, 8, 8, 9/* INTEGER HCBYTE(7) / 1, 2, 3, 4, 5, 6, 6/A INTEGER LSFRAME(10) /10,10, 5, 6, 7, 8, 7, 8,16,90/ ! LRS status4 INTEGER LSBYTE(10) / 1, 2, 2, 2, 1, 1, 2, 2, 1, 1/A INTEGER HSFRAME(10) / 1, 1, 2, 4, 8,16,16,32,48,64/ ! HRS status4 INTEGER HSPACKET(10)/ 8, 8, 8, 8, 8, 8, 8, 8, 8, 8/4 INTEGER HSBYTE(10) / 5, 6, 6, 6, 6, 5, 6, 6, 6, 6/H INTEGER LDFRAME(2) /66,67/ ! Data channels, LS 10-bits of bytes 1 & 2? INTEGER IGAIN(4) /2,4,3,1/ ! Gain state of (status bits + 1) A INTEGER ICHOP(4) /2,1,4,3/ ! Chopper mode of (status bits + 1)S&C Reference: GLL 3-280 Tables A2.8.1-41C_CALLS U_MOVE1 (isislib), NIMS_EXPAND4 (nimslib)r6C_HIST 26feb93 R Mehlman, UCLA/IGPP ORIGINAL VERSION=C 08mar93 RMX Added gain state and chopper mode parameters, -C corrected some LRS status item locations.EC_ENDs BYTE ITEMP1(5), IHW INTEGER*2 ITEMP2(4) DO I=1,7 ! Command buffersA, CMD(I,1) = LHSK( LCBYTE(I), LCFRAME(I)+1); CMD(I,2) = HHSK( HCBYTE(I), HCPACKET(I)+1, HCFRAME(I)+1)1 ENDDO DO I=1,10 ! Status items 0 HSKSTAT(I,1) = LHSK( LSBYTE(I), LSFRAME(I)+1)? HSKSTAT(I,2) = HHSK( HSBYTE(I), HSPACKET(I)+1, HSFRAME(I)+1)- ENDDO! DO I=1,2 ! LRS data channels > CALL U_MOVE1( 2, LHSK(1, LDFRAME(I)+1), ITEMP1(4)) ! expand3 CALL NIMS_EXPAND4(ITEMP1, ITEMP2) ! 10-bitt( DCHAN(I) = ITEMP2(4) ! values ENDDO DO J=1,2 / IHW = HSKSTAT(1,J) ! Hardware status I = (IHW.AND.'30'X)/16I+ IGS(J) = IGAIN(I+1) ! Gain stateo I = IHW.AND.'03'X. ICHM(J) = ICHOP(I+1) ! Chopper mode END DO RETURNt END7 SUBROUTINE NIMS_OHMS2TMP(ICHNL,OHMS,TCEN,TKEL,IR) NC_TITLE NIMS_OHMS2TMP Compute NIMS P/F temperatures from measured resistancesC_ARGS8 INTEGER ICHNL !I Channel number (see DESC below)1 REAL OHMS !I Resistance for channel ICHNLo5 REAL TCEN !O Temperature (degrees Centigrade)b1 REAL TKEL !O Temperature (degrees Kelvin)1< INTEGER IR !O Return code: 0 OK, -1 invalid channelGC_DESC This routine is for the shield, telescope, grating, chopper, andr?C electronics. (Use NIMS_FPATMP for focal plane temperatures.)pBC Uses measured resistance and corresponding Callander - van DusenBC coefficients to figure out temperatures. Channel identificationDC given below. The identity of the chopper sensor was not recorded@C by Bulova, so we use parameters for 15323 (grating mechanism).:C NO. LOCATION TERMINALS CDS CHANNEL SENSOR:C === ======== ========= =========== ======:C 1 Shield L - M E-1911 15319:C 2 Telescope F - G E-1912 15322:C 3 Grating Mech. D - E E-1913 153238C 4 Opt. Chopper B - C E-1914 ?:C 5 Electronics N - d E-1915 UA75C_CALLS NIMS_PT_RES_THERMH5C_HIST 25-AUG-88 R Carlson JPL Adapted from INSTMP AC 01-FEB-93 R Mehlman UCLA/IGPP Renamed from OHMS2TMP, renamed/C subroutine, error parameter added, internal=%C documentation put in ISIS format.'C_ENDEB DIMENSION RZ(5), ALPHA(5), DELTA(5), BETA(5) ! COEFFICIENTS DATA RZ/ 497.793,I & 498.235,, & 498.434,O & 498.434,M & 500.089/D DATA ALPHA/0.0038896874, & 0.0038918771, & 0.0038922303, & 0.0038922303, & 0.0038830074/ DATA DELTA/1.386378, & 1.403585, & 1.396086, & 1.396086, & 1.386402/ DATA BETA/ 0.2247264,i & 0.2131825,E & 0.2143358,r & 0.2143358,R & 0.2327845/E 100 I = ICHNLe, IF(I.LT.(1)) GO TO 900 ! Out of range, IF(I.GT.(5)) GO TO 900 ! Out of range R = OHMS? CALL NIMS_PT_RES_THERM(R,RZ(I),ALPHA(I),DELTA(I),BETA(I), 1 TCEN,TKEL)P IR = 0 RETURN 900 IR = -1T RETURN ENDC SUBROUTINE NIMS_PT_RES_THERM(R,RZ,ALPHA,DELTA,BETA,TCEN,TKEL) IC_TITLE NIMS_PT_RES_THERM Compute Pt resistance thermometer temperatures6C_ARGS REAL R !I Measured resistance' REAL RZ !I Resistance at 0 degrees C REAL ALPHA !I | Constants of% REAL DELTA !I | equation described REAL BETA !I | in DESC belowI1 REAL TCEN !O Temperature in degrees Centigrade - REAL TKEL !O Temperature in degrees KelvineGC_DESC Computes NIMS Platinum resistance thermometer temperatures from nEC measured resistance. Uses Callandar - van Dusen equation, measured0>C value of resistance (R), and previously determined constants?C (RZ - resistance at 0 deg C, ALPHA, DELTA, BETA) to determineTHC temperature in Centigrade and Kelvin (TCEN,TKEL). For TAU = TCEN/100,2C the empirical Callandar - van Dusen equation is:6C R/RZ = 1 + ALPHA[100*TAU - DELTA*TAU*(TAU-1)9C - BETA*(TAU-1)*TAU**3]bEC with BETA = 0 if TCEN > 0. (Note that the value of BETA suppliedo>C to this routine is finite and for TCEN < 0; it is ignored as@C appropriate.) The program first solves the quadratic equation>C (BETA = 0). For RHO = R/RZ > 1, the resulting TAU gives theEC temperatures. For RHO < 1, the BETA term gives a quartic equation, @C and the above-derived TAU is used as a starting point to solveC this quartic.SC_CALLS U_FIND_ROOT42C_HIST 24-APR-87 R Carlson JPL ORIGINAL VERSIONHC 20-FEB-93 R Mehlman UCLA/IGPP Renamed from PRT, renamed U_ROOT4 and9C changed argument order, internal documentation put inHC ISIS format.C_ENDA RHO = R/RZ: A = -ALPHA*DELTA ! Coeff in A*X**2 + B*X + C3 B = ALPHA*(100.+DELTA) ! Linear coefficient" C = 1. - RHO ! C> TAU = (-B + SQRT(B**2-4.*A*C))/(2.*A) ! Quadratic sol'n; IF(RHO.GE.(1.00)) GO TO 800 ! for TCEN > 0DC TAUS = TAU ! Initial approximation for TCEN < 052 D = ALPHA*BETA ! Cubic coefficient6 E = -D ! Coefficient of TAU**47 EPS = 0.0001 ! Iterate to 0.01 degree*/ CALL U_FIND_ROOT4(E,D,A,B,C,EPS,TAUS,TAU) . 800 TCEN = 100.*TAU ! In Centigrade? TKEL = TCEN + 273.15 ! Ice point = 0 deg C = 273.15 K) RETURN ENDt$ SUBROUTINE NIMS_UNPK_ERT(IERT,KERT)DC_TITLE NIMS_UNPK_ERT Unpack ERT from NIMS EDR into component partsC_ARGS5 INTEGER*4 IERT !I Packed ERT: bits 0-6 year-1900sC 7-15 day-of-year C 16-31 minute-of-day 2 INTEGER*4 KERT(4) !O Unpacked ERT: (1) year-1900C (2) day-of-yearC (3) hour-of-dayC (4) minute-of-hour(8C_HIST 28aug91 R. Mehlman UCLA/IGPP ORIGINAL VERSION (C 02nov92 RMX Renamed from U_UNPK_ERT.C_END INTEGER*4 JERT INTEGER*2 JMIN,JYD BYTE LERT(4)n+ EQUIVALENCE (JERT,LERT,JYD),(JMIN,LERT(3))T JERT = IERT$ KERT(1) = IAND(JYD,'007F'X) ! year KERT(2) = ISHFT(JYD,-7) ! day KERT(3) = JMIN/60 ! hour & KERT(4) = JMIN - 60*KERT(3) ! minute RETURN, END# SUBROUTINE U_FILL1(IVAL,N,IA) 4C_TITLE U_FILL1 Fill byte array with constant value C_ARGS' BYTE IVAL ! I Value to be inserted+* INTEGER*4 N ! I Length of array in bytes% BYTE IA(*) ! O Array to be filledo IC_KEYS UTILITY, BYTE, L1, ARRAY 5C_HIST 09feb93 RMX PORTABLE VERSION of ISIS routinerC_ENDs IF (N.LE.0) RETURN DO I=1,N IA(I)=IVAL END DO RETURN END 5 SUBROUTINE U_FIND_ROOT3(A3,A2,A1,A0,EPS,XTRY,X)9DC_TITLE U_FIND_ROOT3 Find root of cubic equation by Newton's methodC_ARGS1 REAL A3 !I Coefficients of cubic equationr REAL A2 !I- REAL A1 !Ih REAL A0 !I " REAL EPS !I Rough accuracy4 REAL XTRY !I First guess as to where root is REAL X !O ResultEC_DESC Find root of cubic equation: 0 = A3*X**3 + A2*X**2 + A1*X + A0iC using Newton's method.2C_HIST ??-JUL-85 R Carlson JPL ORIGINAL VERSIONEC 01-FEB-93 R Mehlman UCLA/IGPP Renamed from ROOT3, argument order0C and internal documentation to ISIS standard.C_END_ XNEW = XTRYM 100 XOLD = XNEWI0 Y = A3*XOLD**3 + A2*XOLD**2 + A1*XOLD + A0* YP = 3.*A3*XOLD**2 + 2.*A2*XOLD + A1 XNEW = XOLD - (Y/YP)) IF(ABS(XNEW-XOLD).GT.EPS) GO TO 100) X = XNEW RETURN END 8 SUBROUTINE U_FIND_ROOT4(A4,A3,A2,A1,A0,EPS,XTRY,X)FC_TITLE U_FIND_ROOT4 Find root of quartic equation by Newton's methodC_ARGS3 REAL A4 !I Coefficients of quartic equation REAL A3 !IT REAL A2 !I REAL A1 !I REAL A0 !II" REAL EPS !I Rough accuracy4 REAL XTRY !I First guess as to where root is REAL X !O Result%C_DESC Find root of quartic equation:D/C 0 = A4*X**4 + A3*X**3 + A2*X**2 + A1*X + A0 C using Newton's method.5C_HIST 22-APR-87 R Carlson JPL Adapted from ROOT3.uEC 01-FEB-93 R Mehlman UCLA/IGPP Renamed from ROOT4, argument orderp0C and internal documentation to ISIS standard.C_ENDE XNEW = XTRY 100 XOLD = XNEW = Y = A4*XOLD**4 + A3*XOLD**3 + A2*XOLD**2 + A1*XOLD + A0: YP = 4.*A4*XOLD**3 + 3.*A3*XOLD**2 + 2.*A2*XOLD + A1 XNEW = XOLD - (Y/YP)) IF(ABS(XNEW-XOLD).GT.EPS) GO TO 100T X = XNEW RETURN END ! SUBROUTINE U_MOVE1(N,IA,JA)A C_TITLE U_MOVE1 Move byte array nC_ARGS* INTEGER*4 N ! I Length of array in bytes BYTE IA(*) ! I Source array$ BYTE JA(*) ! O Destination array 5AC_DESC Move bytes from source array to destination array. Sourceu"C and destination must not overlap(C_KEYS UTILITY, BYTE, L1, ARRAY, SYSTEM,5C_HIST 16oct92 RMX PORTABLE VERSION of ISIS routine C_ENDt DO I=1,N JA(I)=IA(I) END DO RETURN END