3�      SUBROUTINE NIMS_CDS2OHMS(ICHNL,NDATA,OHMS,IR)���O�C_TITLE NIMS_CDS2OHMS  Compute resistance for given CDS channel and data number����C_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:��8�C     ICHNL  CDS CHANNEL  LOCATION  SENSOR  SE TERMINALS8�C     =====  ===========  ========  ======  ============4�C       1       E-1911      Shield   15319     L - M4�C       2       E-1912    Telescope  15322     F - G4�C       3       E-1913    Gr. Mech.  15323     D - E4�C       4       E-1914      Chopper    ?       B - C4�C       5       E-1915  Electronics  UA-75     N - d��6�C   Values for E-1910 and E-1916, both of which relateB�C   to the FPA temperature, are handled in subroutine NIMS_FPATMP.:�C   In this routine, we use the given CDS coefficients to 9�C   determine a resistance.  In the first four cases, the�6�C   answer is found by solving a cubic equation.  The :�C   electronics temperature is linearly related to the DN
�C   value.��C�C   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_ROOT3��2�C_HIST	16-AUG-88  R Carlson  JPL  ORIGINAL VERSIONI�C	20-FEB-93  R Mehlman  UCLA/IGPP  Renamed from CDS2OHMS, renamed U_ROOT3�6�C			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 5�G�      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	�      END�4�      SUBROUTINE NIMS_DET_MODE(KHRS,LPTAB,KPTAB,KMF,0�     1 MRPT,MIROP,MGSTART,MGDELTA,MGSTEPS,KMODE)��P�C_TITLE NIMS_DET_MODE  Determine NIMS instrument mode, etc. from HRS hskpng, etc���C_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 delta�2�      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, spectrometer�C					      -1: undetermined��O�C_DESC  Extract current PTAB, determine NIMS mode and grating cycle parameters,�>�C	using HRS housekeeping and possibly LRS housekeeping values.��3�C	References:  NIMS instrument paper, and GLL 3-280���+�C_LIMS  LRS input not yet used in analysis.����C_CALLS U_MOVE1 (ISISLIB)���L�C_HIST	03nov92  R Mehlman, UCLA/IGPP  Entirely rewritten from 31aug84 MODET.O�C	06dec92  RMX  Added more output arguments: MRPT,MIROP,MGSTART,MGDELTA,MGSTEPS�=�C	08feb92  RMX  Corrected test for bandedge modes (PTAB(4)=1)�D�C	09mar93  RMX  Changed from function to 	subroutine, input override6�C			mode removed, parameters renamed, LRS input added.�C_END���>�C  Instrument mode tables:  position n corresponds to mode n-17�C	Actual # grating positions (to be used in cube label)�D�C	Nits per mirror cycle (fixed grating cycles use full mirror cycle)!�C  Entries for modes 10-15 <tbd>.�0�C  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 80�C  Undetermined�� 50   KMODE=-1� 80   CONTINUE@�C      WRITE (6,90) ((KHRS(I,J),I=3,6),J=2,7,5),LPTAB,KPTAB,KMF,1�C     1  MRPT,MIROP,MGSTART,MGDELTA,MGSTEPS,KMODE�4�C 90   FORMAT (' * NIMS_MODE in: ',8Z3,2X,8Z3,Z5,I3/0�C     1        '            out: ',I3,1X,L1,4I3) �      RETURN	�      END�4�      SUBROUTINE NIMS_ENGR(ENGR,TDN,ODN,TEMP,RESIST)��K�C_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 Assembly��C					     2 Radiator Shield�C					     3 Telescope�C					     4 Grating�C					     5 Chopper�C					     6 Electronics8�      INTEGER ODN(4)			!O  Other 4 items, DNs, 1 per RIM"�C					     1 Flexprint temperature�C					     2 RCT-Pt temperature��C					     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,a�C					     2 RHPRK: RH + RK�,�C					     3 RHK:   R across H,K (RH+RK+Rpt)"�C					     4 RPT:   R of Pt sensor��J�C_DESC  Extract NIMS Engineering DNs from RIM's worth of the 2 EngineeringG�C	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 RIM2�C	  E-1911  Radiator Shield Temperature		7 per RIM-�C	  E-1912  Telescope Temperature			7 per RIM�4�C	  E-1913  Grating Mechanism Temperature		7 per RIM2�C	  E-1914  Optical Chopper Temperature		7 per RIM5�C	  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 RIM5�C	  E-1947  RCT-NIMS Reference R(esistance)	1 per RIM�>�C	Reference: GLL 3-280 Table A2.2.8 (Engineering Measurements)A�C	See NIMS_* subroutines for details of temperature computations.���"�C_CALLS U_FILL1, U_MOVE1 (isislib)5�C	NIMS_FPATMP, NIMS_CDS2OHMS, NIMS_OHMS2TMP (nimslib)���6�C_HIST	20feb93, R Mehlman, UCLA/IGPP  ORIGINAL VERSION���C_END���M�      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 bytes�3�      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's�F�     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)���F�C_TITLE NIMS_FPATMP  Compute FPA temperature from CDS engineering data���C_ARGS;�      INTEGER	N1910		!I  Data number for CDS channel E-1910�4�      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 + RK�9�      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)��G�C_DESC	Computes FPA temperature from CDS engineering data for P/F unit.���B�C	The principal output FPA temperature is TPT, which uses just theC�C	platinum sensor after subtracting out the simultaneously measured�A�C	flexprint resistance.  The other output FPA temperature, TPTSS,�@�C	assumes the flexprint resistance is also temperature sensitiveH�C	(slightly).  The combination of the two is a "resistance thermometer".<�C	TPT and TPTSS should agree, providing the optics are cold.��4�C	References: Appendix A, B OF calibration document,>�C                   GLL Telemetry Conversion Handbook, 625-308���C_CALLS U_FIND_ROOT3��2�C_HIST	04-SEP-85  R Carlson  JPL  ORIGINAL VERSIONG�C	20-FEB-93  R Mehlman  UCLA/IGPP  Renamed from FPATMP, renamed U_ROOT3�:�C			and changed argument order, internal documentation put�C			in ISIS format.��C_END���6�      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+00�9�      RF = 413.91                  ! Ohms, fixed R in FPA�8�      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-05�C�:�      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 800��C     DATA IOLU /6/��C     WRITE(IOLU,200) �C     WRITE(IOLU,201) RKA��C     WRITE(IOLU,202) RHPRK��C     WRITE(IOLU,203) RHK��C     WRITE(IOLU,204) RPT��C     WRITE(IOLU,205) TPTSS��C     WRITE(IOLU,206) TPT��C     WRITE(IOLU,207) N1910��C     WRITE(IOLU,208) N1916��C     WRITE(IOLU,209)�?�C 200 FORMAT(1H1,5X,'NIMS P/F FPA Temperature From CDS Values')�A�C 201 FORMAT(1H0,5X,'R(K-a)...............................',F7.2)�A�C 202 FORMAT(1H ,5X,'R(H) + R(K)..........................',F7.2)�A�C 203 FORMAT(1H ,5X,'R(H-K)...............................',F7.2)�A�C 204 FORMAT(1H ,5X,'R(Pt)................................',F7.2)�A�C 205 FORMAT(1H ,5X,'Temperature(Pt+SS)...................',F7.2)�A�C 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)��I�C_TITLE NIMS_GET_MODE_INFO  Get grating & mirror cycle info for NIMS mode����C_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, spectrometer�C					    10-15: <tbd><�      INTEGER KNGP			!O  Actual # grating positions in cycle:�      INTEGER KNITS			!O  Number of nits in "mirror" cycle5�      INTEGER KGRDEL			!O  Grating increment for mode���G�C_DESC  This routine returns the number of grating positions, length of�E�C	mirror cycle and grating increment of a given NIMS instrument mode.���5�C_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-17�C	Actual # grating positions (to be used in cube label)�D�C	Nits per mirror cycle (fixed grating cycles use full mirror cycle)!�C  Entries for modes 10-15 <tbd>.�0�C  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/CYCLE�M�      INTEGER NITSPC(16) /13,13,13,26,26,7,7,13,4,4,0,0,0,0,0,0/ ! NITS/CYCLE�O�      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)���M�C_TITLE NIMS_HSKPNG  Extract NIMS housekeeping items from LRS and HRS for RIM����C_ARGS2�	BYTE LHSK(3,91)			!I  LRS bytes, 3/frame over RIM;�	BYTE HHSK(6,10,91)		!I  HRS hskpng items, 6/mod10 over RIM�5�	BYTE CMD(7,2)			!O  NIMS command (7 bytes: LRS, HRS)�=�	BYTE HSKSTAT(10,2)		!O  Housekeeping status bytes (LRS, HRS)��C					   1 Hardware status�C					   2 Software status(�C					   3 Transaction bus parity errors �C					   4 All bus parity errors�C					   5 Power supply input�$�C					   6 Ave grating drive current#�C					   7 Ave mirror drive current��C					   8 Reference voltage�C					   9 Optics cal source�C					  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 off���G�C_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 status�4�	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 status�4�	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-4��1�C_CALLS U_MOVE1 (isislib), NIMS_EXPAND4 (nimslib)r��6�C_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.E���C_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) ��N�C_TITLE NIMS_OHMS2TMP  Compute NIMS P/F temperatures from measured resistances���C_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 channel��G�C_DESC	This routine is for the shield, telescope, grating, chopper, andr?�C	electronics.  (Use NIMS_FPATMP for focal plane temperatures.)pB�C	Uses measured resistance and corresponding Callander - van DusenB�C	coefficients to figure out temperatures.  Channel identificationD�C	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       153238�C    4  Opt. Chopper     B - C          E-1914         ?:�C    5  Electronics      N - d          E-1915        UA75���C_CALLS NIMS_PT_RES_THERMH��5�C_HIST	25-AUG-88  R Carlson  JPL  Adapted from INSTMP A�C	01-FEB-93  R Mehlman  UCLA/IGPP  Renamed from OHMS2TMP, renamed�/�C			subroutine, error parameter added, internal=%�C			documentation put in ISIS format.'���C_ENDE��B�      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	�      END�C�      SUBROUTINE NIMS_PT_RES_THERM(R,RZ,ALPHA,DELTA,BETA,TCEN,TKEL) ��I�C_TITLE NIMS_PT_RES_THERM  Compute Pt resistance thermometer temperatures6���C_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 Kelvine��G�C_DESC	Computes NIMS Platinum resistance thermometer temperatures from nE�C	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 determineTH�C	temperature in Centigrade and Kelvin (TCEN,TKEL).  For TAU = TCEN/100,2�C	the empirical Callandar - van Dusen equation is:��6�C         R/RZ = 1 + ALPHA[100*TAU - DELTA*TAU*(TAU-1)9�C                                  - BETA*(TAU-1)*TAU**3]b��E�C   	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 theE�C	temperatures.  For RHO < 1, the BETA term gives a quartic equation, @�C	and the above-derived TAU is used as a starting point to solve�C	this quartic.S���C_CALLS U_FIND_ROOT4��2�C_HIST	24-APR-87  R Carlson  JPL  ORIGINAL VERSIONH�C	20-FEB-93  R Mehlman  UCLA/IGPP  Renamed from PRT, renamed U_ROOT4 and9�C			changed argument order, internal documentation put inH�C			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)��D�C_TITLE NIMS_UNPK_ERT  Unpack ERT from NIMS EDR into component parts���C_ARGS5�	INTEGER*4 IERT		!I  Packed ERT:  bits 0-6  year-1900s�C						      7-15 day-of-year �C						     16-31 minute-of-day 2�	INTEGER*4 KERT(4)	!O  Unpacked ERT: (1) year-1900�C						  (2) day-of-year�C						  (3) hour-of-day�C						  (4) minute-of-hour(��8�C_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)	��4�C_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� I�C_KEYS	UTILITY, BYTE, L1, ARRAY	��5�C_HIST	09feb93  RMX  PORTABLE VERSION of ISIS routiner���C_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)9��D�C_TITLE U_FIND_ROOT3  Find root of cubic equation by Newton's method�C_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  Result��E�C_DESC	Find root of cubic equation: 0 = A3*X**3 + A2*X**2 + A1*X + A0i�C	using Newton's method.��2�C_HIST	??-JUL-85  R Carlson  JPL  ORIGINAL VERSIONE�C	01-FEB-93  R Mehlman  UCLA/IGPP  Renamed from ROOT3, argument order�0�C			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)��F�C_TITLE U_FIND_ROOT4  Find root of quartic equation by Newton's method���C_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.��5�C_HIST	22-APR-87  R Carlson  JPL  Adapted from ROOT3.uE�C	01-FEB-93  R Mehlman  UCLA/IGPP  Renamed from ROOT4, argument orderp0�C			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� n�C_ARGS*�	INTEGER*4 N	! I  Length of array in bytes�	BYTE	  IA(*)	! I  Source array�$�	BYTE	  JA(*)	! O  Destination array� 5A�C_DESC	Move bytes from source array to destination array.  Sourceu"�C	and destination must not overlap��(�C_KEYS	UTILITY, BYTE, L1, ARRAY, SYSTEM,��5�C_HIST	16oct92  RMX  PORTABLE VERSION of ISIS routine ���C_ENDt���      DO I=1,N �	JA(I)=IA(I) �      END DO �      RETURN	�      END