�      PROGRAM EDRDMP�C     IMPLICIT NONE����C			-------------------��C			|   E D R D M P   |��C			-------------------���N�C_TITLE  EDRDMP  Dump selected data and housekeeping from NIMS EDR or UDR file���C_USERB�      INTEGER       OMODE		! Output mode:  0 terminal, 1 dump file0�      CHARACTER*128 TO			! Output dump file name�C							      2 AACS, 3 both<�      INTEGER       ETYPE		! EDR/UDR type: 0 PDS label only,$�C						        1 Vicar & PDS labels, �C							2 Vicar label only (UDR)-�      CHARACTER*128 FROM		! EDR/UDR file name�.�      INTEGER       KRIM1		! Start RIM of dump<�      INTEGER       KMF1		! Start minor frame of dump (0-90)-�      INTEGER       KRIM2		! Stop RIM of dump�4�      INTEGER       KMF2		! Stop minor frame of dump>�      INTEGER       RSTAT		! RIM status: 0 none, 1 hskpng/engrB�      INTEGER       MSTAT		! Minor Frame status: 0 none, 1 hskpng,�C							2 AACS pointing, 3 both�A�      INTEGER       ITYPE		! Dump type (0 or 1: sensor vs det, mp��C					!		  2: sensor vs det, gp��C					!		  3: sensor vs mp, gp �C					!		 -1: bckgrnd vs det, gp�C					!		 -2: status only�:�      INTEGER       MINVAL		! Minimum printable dump value�C					!  (triggers search mode)�F�      INTEGER       IDT1,IDT2,IDTDEL	! Detector range (1-17) and deltaM�      INTEGER       IMP1,IMP2,IMPDEL	! Mirror position range (0-19) and delta�+�C					!  For type 2: IMP1 = single mir pos,�)�C					!   or -1 for average, -2 for sigma�>�      INTEGER       IGP1,IGP2		! Grating position range (0-25)-�C					!  Defaults to all non-mirror-rest data�*�C					!  Force display of mirror rest data!�C					!   by entering IGP2.GE.NGP�A�      INTEGER       INMODE		! Input mode (1-9, 16) (use 16 for 0)����C_VARSJ�      INCLUDE 'ISIS$INC:EDRHDR.INC'	! EDR hdr rec defs for COMMON /EDRHDR/K�      INCLUDE 'ISIS$INC:EDRDAT.INC'	! EDR data rec defs for COMMON /EDRDAT/�L�      INCLUDE 'ISIS$INC:WRKDAT.INC'	! Work data rec defs for COMMON /WRKDAT/��J�C_DESC  Dump selected data and housekeeping from NIMS EDR (with or withoutI�C	original Vicar label) or Vicar-labelled UDR file.  Mirror rest position�D�C	(or grating flyback) data printout is optional.  A search mode for@�C	data above a specified minimum is optional.  Access is direct;@�C	multiple time ranges (and EDRs) may be selected interactively.��
�C	Dump types:�B�C	  0 or 1: Sensor DN vs detector & mirror position (over selected,�C					     grating position range and delta)N�C              2: DN vs detector & grating position (selected mirror position,4�C				or average or sigma for selected range & delta)N�C              3: DN vs mirror position & grating position (selected detector)-�C             -1: Background data vs detector�-�C             -2: Null (for status info only)���F�C	Search mode is selected by entering nonzero minimum value:  Any dataE�C	value .GE. the minimum triggers printing of the line containing it.����C	Status info options:E�C	  RIM status is optional and includes housekeeping and temperatures�C�C	  Minor Frame status is optional and may include HRS housekeeping��C	   or AACS pointing or both.D�C	  Status info is interspersed with data dump lines except for dump/�C	   type -2 which results in status info only.���D�C       Instrument mode affects only displayed grating position, and@�C	identification of mirror-rest-position (grating flyback) data.��N�C_FILES NIMS EDR file, CD-ROM version:  1024-byte records -- 2 header records,A�C	1 data record per minor frame, maximum 9102 records (100 RIMs).�B�C	Preceded by the PDS/ISIS label (3 records).  The physical recordA�C	length is 512 bytes (VMS/ISIS standard) -- there are 2 physical�?�C	records per 1024-byte logical record.  The Vicar label of the�@�C	MIPL-generated EDR file has been removed, but is included in a/�C	separate directory for possible reattachment.���A�C	Reference:  NIMS EDR SIS, Number 232-08, Revision 2.0, Issue 2,�/�C	30 July 1991 (625-610: SIS 232-08, JPL D-296)���F�C	EDRs as supplied by MIPL have 2-block Vicar labels preceding the PDS8�C	label, and a VMS physical record length of 1024 bytes.��G�C	UDRs (essentially 2-RIM EDRs) have 2-block Vicar labels and 1024-byte��C	records but no PDS labels.��H�C	Output dump file is an ASCII print file with Fortran carriage control.��6�C_LIMS  This version uses Fortran I/O to read the EDR.��9�C_CALL  LREAD, FREAD (& BREAD), FOUND, MIRAVE (all below)��C	U_FILL1, U_MOVE1 (isislib)D�C	NIMS_UNPK_ERT, NIMS_EXPAND_HRS, NIMS_DET_MODE, NIMS_GET_MODE_INFO,"�C	NIMS_ENGR, NIMS_HSKPNG (nimslib)���C_KEYS  NIMS, EDR���N�C_HIST  31oct92  R Mehlman, UCLA/IGPP, ORIGINAL PORTABLE VERSION, adapted from>�C		  03may91 version of NIMSDUMP (NIMS SE file dump program of=�C		  R Mehlman and F Leader) and framework of 21oct92 version�/�C		  of EDRCHK (EDR report generation program).�L�C	02nov92  RMX  Renamed HRS_EXPAND, MODET and U_UNPK_ERT to NIMS_EXPAND_HRS,%�C		  NIMS_DET_MODE and NIMS_UNPK_ERT.�:�C	04nov92  RMX  Save up LRS and HRS housekeeping over RIM.@�C	19jan93  RMX  Corrected BREAD routine to detect EOF correctly.�C		  Added EOF message to user.�9�C	19feb93  RMX  Added ENGR (temps) option to RIM display.�I�C	26feb93  RMX  Added special HRS/LRS hskpng status items to RIM display.�E�C	01mar93  RMX  Modified to get RIM display at end-of-request or EOF.�?�C	10mar93  RMX  Added gain state and chopper mode parameters to�6�C			NIMS_HSKPNG, and added them to RIM status display.:�C			Restructured initial parameter requests.  Also allowed8�C			optional input of Vicar-labelled EDRs and UDRs, with:�C			physical record length added to LREAD and FREAD calls.9�C			Added complete SCLK and mirror scan direction to data�2�C			displays.  Corrected background value display.;�C			Modified NIMS_DET_MODE call.  Added NIMS_GET_MODE_INFO.�,�C	19mar93  RMX  Added version date printout.H�C	18aug93  RMX  Corrected start time computation for UDRs (added IREC1).G�C	01sep93  RMX  Check SCLK, compute from next record if zero (jailbars)�F�C	06oct93  RMX  Corrected dump type 2 code for alternating mirror dir,9�C			improved mirror rest position (grating flyback) print�7�C			option, now show MDIR = 0 for mirror rest position.�H�C	08oct93  RMX  Corrected dump type 1 bug (partial backward mirror scan))�C	13dec93  RMX  Corrected READ from IOUT.�5�C	21jun94  RMX  Added argument to NIMS_GET_MODE_INFO.�5�C	18jul94  RMX  Added ISIS$INC to INCLUDE statements.��C_END�(�      CHARACTER*10 VERDAT /'1994-07-18'/��/�      CHARACTER*3072 LABEL					! PDS/ISIS label�:�      INTEGER IRIM1/0/, IRIM2/0/, KRIM/0/			! Working RIMs<�      INTEGER IERT1X(4),IERT2X(4),KERTX(4)			! Unpacked ERTs,�      INTEGER NVALID /0/					! Valid packets!�      BYTE ICCRIM						! Car ctrl�$�      INTEGER RET						! Return code �      LOGICAL EOF						! EDR EOF%�      INTEGER MMF /0/						! INT*4 mf�%�      INTEGER IEDR /1/						! EDR lun�.�      INTEGER IIN /5/					! Terminal input lun0�      INTEGER IOUT /6/					! Terminal output lun-�      INTEGER ILIST /7/					! Dump output lun���.�      CHARACTER*6 TITLE(2) /'Sensor','Bkgrnd'/�      LOGICAL SEARCH, FOUND���+�      PARAMETER (NDET=17)					! # detectors�+�      PARAMETER (NMP=20)					! # mirror pos�I�      INTEGER*2 IDATA(NDET,2*NMP),JDATA(NDET,4,10)	! Expanded sensor data�>�      INTEGER*2 IBKG(4,10),JBKG(20,2)			! Expanded bkgrnd data+�      EQUIVALENCE (IDATA,JDATA),(IBKG,JBKG)�2�      BYTE IHSK(6,10)					! HRS hskpng for 1 frame2�      BYTE HHSK(6,10,91)				! HRS hskpng for 1 RIM0�      BYTE LHSK(3,91)					! LRS hskpng for 1 RIM/�      BYTE CMD(7,2)					! LRS/HRS command buffs�3�      BYTE HSKSTAT(10,2)				! LRS/HRS hskpng status�/�      INTEGER*2 DCHAN(2)				! LRS data channels�1�      INTEGER IGS(2)					! Gain states (LRS, HRS)�1�      INTEGER ICHM(2)					! Chopper modes (" , ")�9�      CHARACTER*4 CHMODE(4) /'REF ','63HZ','FREE','OFF '/�1�      BYTE ENGR(2,91)					! ENGR values for 1 RIM�/�      INTEGER TDN(7,6)					! Extracted TEMP DNs�)�      INTEGER ODN(4)					! Other ENGR DNs�)�      REAL TEMP(7,7)					! Computed TEMPs�1�      REAL RESIST(7,4)					! Computed resistances�/�      LOGICAL MIROP					! Mirror operation flag�@�      INTEGER*2 IAVE(NDET), ISIG(NDET)			! Ave & sigma in mirpos���C  Non-TAE parameter input� 10   WRITE (IOUT,910) VERDAT�F� 910  FORMAT (' << Galileo/NIMS EDRDMP program:  version of ',A,' >>'/<�     1 ' Enter output mode, [dumpfile name] (I5,A) or EOF ',A�     2 'to exit'/'  Output mode:  0 terminal,  1 printable file')�+�      READ (IIN,911,ERR=10,END=89) OMODE,TO�� 911  FORMAT (I5,A)��      IF (OMODE.NE.0) THEN)�        OPEN (ILIST,FILE=TO,STATUS='NEW')�
�      ELSE �	ILIST=IOUT� �      ENDIF����C  Loop on EDRs�7�C   Request file type and name, set record length, etc.�� 14   WRITE (IOUT,914)E� 914  FORMAT (' Enter EDR type, EDR filename (I5,A), or EOF to exit'/�6�     1 '  EDR type: 0 PDS label only (CDROM version)'/G�     2 '            1 Vicar label preceding, 2 Vicar label only (UDR)')�4� 15   READ (IIN,915,ERR=14,END=80) ETYPE, LENF, FROM� 915  FORMAT (I5,Q,A)�,�      IF (ETYPE.LT.0.OR.ETYPE.GT.2) GO TO 14�      IF (ETYPE.EQ.0) THEN �	LPHREC=512��	JHEAD=6�      ELSE IF (ETYPE.EQ.1) THEN� �	LPHREC=1024�	JHEAD=7
�      ELSE �	LPHREC=1024�	JHEAD=3 �      END IF�C  Open EDR fileD�      OPEN (IEDR,FILE=FROM,STATUS='OLD',FORM='UNFORMATTED',READONLY,%�     1 ACCESS='DIRECT',RECL=LPHREC/4)� �      IREC=1�C  Skip Vicar label if present�      IF (ETYPE.GT.0) THEN)�	CALL FREAD (IEDR,LPHREC,IREC,HDREC1,RET)��	IF (RET.LT.0) GO TO 70� �	IREC=IREC+1 �      END IF!�C  Read PDS/ISIS label if present��      IF (ETYPE.LE.1) THEN5�	CALL LREAD (IEDR,LPHREC,LABEL,RET)		! PDS/ISIS label�"�	IF (RET.LT.0) GO TO 70				! Error �	IREC=IREC+3 �      END IF�C...display label?�C  Read 2 Header records@�      CALL FREAD (IEDR,LPHREC,IREC,HDREC1,RET)		! Header records'�      IF (RET.NE.0) GO TO 70				! Error�0�      CALL FREAD (IEDR,LPHREC,IREC+1,HDREC2,RET)�      IF (RET.NE.0) GO TO 70-�      JFRONT=IREC+1					! Records before data��C  Print header info0�      WRITE (ILIST,9152) PROJ,INSTR,FROM(1:LENF),� 9152 FORMAT ('1',10A1,6A1,' EDR file  ',A/)3�      CALL U_MOVE1(3,ISCLK1,IRIM1)			! Unpack SCLKs�"�      CALL U_MOVE1(3,ISCLK2,IRIM2)
�      IREC1=1�=�      IREC2=IRIM2*91+MF2-(IRIM1*91+MF1)+1		! Last data record�(�      IF (ETYPE.EQ.2) THEN				! UDR only%�	IREC1=MF1+1					!  skip empty frames��	IREC2=IREC2+MF1 �      ENDIF�5�      WRITE (ILIST,9154) IRIM1,MF1,IRIM2,MF2,SCLKPART�>� 9154 FORMAT (' SCLK range:',2(I10,'.',I2.2),'  Partition',I3)6�      CALL NIMS_UNPK_ERT(IERT1,IERT1X)			! Unpack ERTs&�      CALL NIMS_UNPK_ERT(IERT2,IERT2X)&�      WRITE (ILIST,9156) IERT1X,IERT2X=� 9156 FORMAT (' ERT range:',2(I4,'-',I3.3,'-',I2.2,':',I2.2))�9�      WRITE (ILIST,9158) NTOTAL,NFILL,NCMPLT,NVLRS,NVAACS�;� 9158 FORMAT (' Total recs',I5,'  Fill',I5,'  Complete',I5,�;�     1 '  Valid NIMS LRS packets',I6,'  Valid AACS LRS',I6)�4�      WRITE (ILIST,9160) NREALT,NSDR,NIDR,NSFDU,NEDR>� 9160 FORMAT (' RT recs',I5,'  SDR',I5,'  IDR',I5,'  SFDU',I5,�     1 '  EDR',I5)B�      WRITE (ILIST,9162) NGCFERR,NNGOLERR,NAGOLERR,NPNERR,NSCLKERR:� 9162 FORMAT (' Error recs: GCF',I7,'  NIMS LRS Golay',I7,3�     1 '  AACS LRS Golay',I7,'  PN',I7,'  SCLK',I7)���H�C ----------------------------------------------------------------------=�C  Request SCLK range, apply defaults, calculate record range�*� 18   WRITE (IOUT,918) IRIM1,MF1,IRIM2,MF21� 918  FORMAT ('0EDR SCLK range:',2(I10,'.',I2.2)/�@�     1 ' Enter start (RIM, mf) & stop (RIM, mf) to dump (4I10)'/?�     2 ' or EOF for new EDR file.  Default:  dump entire file')�8�      READ (IIN,919,ERR=18,END=50) KRIM1,KMF1,KRIM2,KMF2� 919  FORMAT (8I10)��      IF (KRIM1.EQ.0) THEN �	KRIM1=IRIM1	�	KMF1=MF1� �      ENDIF��      IF (KMF1.LT.0) KMF1=0��      IF (KMF1.GT.90) KMF1=90��      IF (KRIM2.EQ.0) THEN �	KRIM2=IRIM2	�	KMF2=MF2� �      ENDIF �      IF (KMF2.LT.0) KMF2=0��      IF (KMF2.GT.90) KMF2=90�?�      JREC1=KRIM1*91+KMF1-(IRIM1*91+MF1)+1		! Start data record�>�      JREC2=KRIM2*91+KMF2-(IRIM1*91+MF1)+1		! Stop data record(�      IF (ETYPE.EQ.2) THEN				! UDR only)�	JREC1=JREC1+MF1					!  skip empty frames��	JREC2=JREC2+MF1	� �      ENDIF�#�      WRITE (IOUT,9195) JREC1,JREC2�:� 9195 FORMAT (' Requested data record range:',I5,' to',I5)0�      IF (JREC1.LT.IREC1.OR.JREC2.GT.IREC2) THEN�	WRITE (IOUT,9196)6� 9196	FORMAT (' Invalid range requested.  Try again.')	�	GO TO 18� �      END IF9�      CALL U_FILL1(0,3*91,LHSK)				! Zero RIM save arrays�"�      CALL U_FILL1(0,6*10*91,HHSK)�      CALL U_FILL1(0,2*91,ENGR)�#�      JREC=JREC1					! Set to begin��      EOF=.FALSE.���H�C ----------------------------------------------------------------------�C  Request status types�� 20   WRITE (IOUT,920)F� 920  FORMAT (' Enter RIM status type, Minor Frame status type (2I5)'/)�     1 '  RIM status:  0 none, 1 hskpng'/�A�     2 '  Minor Frame status:  0 none, 1 hskpng, 2 AACS, 3 both')�/�      READ (IIN,9202,ERR=20,END=18) RSTAT,MSTAT�� 9202 FORMAT (16I5)� �C  Request dump type, parameters� 205  WRITE (IOUT,9205)�8� 9205 FORMAT (' Enter dump type, [minimum value] (2I5)'/C�     1 '   0 or 1: sensor vs detector & mirror position for range',��     2 ' of grating positions'/�>�     3 '        2: sensor vs detector & grating position for',#�     4 ' selected mirror position'/�E�     5 '        3: sensor vs mirror position & grating position for',��     6 ' selected detector'/@�     7 '       -1: background vs detector and grating position'/7�     8 '       -2: RIM and/or minor frame status only')�2�      READ (IIN,9202,ERR=205,END=20) ITYPE, MINVAL�      SEARCH=.FALSE.$�      IF (MINVAL.GT.0) SEARCH=.TRUE..�      IF (ITYPE.LT.-2.OR.ITYPE.GT.3) GO TO 205�      IF (ITYPE.LT.-1) GO TO 25��      IF (ITYPE.EQ.0) ITYPE=1�
�      IT=1�      IF (ITYPE.EQ.-1) IT=2�&� 21   IF (ITYPE.NE.3) WRITE (IOUT,921)C� 921  FORMAT (' Enter detector range & delta (3I10)  Default: all')�'�      IF (ITYPE.EQ.3) WRITE (IOUT,9211)� � 9211 FORMAT (' Enter detector')4�      READ (IIN,9202,ERR=21,END=20) IDT1,IDT2,IDTDEL�      IF (IDTDEL.EQ.0) IDTDEL=1�C�      IF ((IDT1.EQ.0.AND.IDT2.EQ.0.AND.ITYPE.NE.3).OR.IDT2.GT.NDET)��     1 IDT2=NDET�      IF (IDT1.LE.0) IDT1=1�0�      IF (IDT2.LT.IDT1.AND.ITYPE.NE.3) IDT2=IDT1�      IF (ITYPE.LT.0) GO TO 23&� 22   IF (ITYPE.NE.2) WRITE (IOUT,922)<� 922  FORMAT (' Enter mirror position range & delta (3I10)',�     1 '  Default:  all')�'�      IF (ITYPE.EQ.2) WRITE (IOUT,9221)�F� 9221 FORMAT (' Enter mirror position, or -1/-2 for ave/sig over all')4�      READ (IIN,9202,ERR=22,END=21) IMP1,IMP2,IMPDEL�      IF (IMPDEL.EQ.0) IMPDEL=1�A�      IF ((IMP1.EQ.0.AND.IMP2.EQ.0.AND.ITYPE.NE.2).OR.IMP2.GT.19)��     1 IMP2=19*�      IF (IMP1.LT.0.AND.ITYPE.NE.2) IMP1=00�      IF (IMP2.LT.IMP1.AND.ITYPE.NE.2) IMP2=IMP1� 23   WRITE (IOUT,923)=� 923  FORMAT (' Enter grating position range, (mode) (3I10)',�E�     1 '  Default:  all'/'  Mode (1 full, 3 long, 5 short, 7 fixed)',�D�     2 ' will override data value'/'  Mode affects only display of',H�     3 ' grating position and of flyback data'/'  Use grating position',A�     4 ' max >= NGP to display mirror_rest/grating_flyback data')�4�      READ (IIN,9202,ERR=23,END=22) IGP1,IGP2,INMODE.�      IF (INMODE.LT.0.OR.INMODE.GT.9) INMODE=0�      IF (IGP1.LT.0) IGP1=0�!�      IF (IGP2.LT.IGP1) IGP2=IGP1�C� 24   WRITE (ILIST,924) TITLE(IT),ITYPE,IDT1,IDT2,IDTDEL,IMP1,IMP2,��     1 IMPDEL,IGP1,IGP2,INMODE3� 924  FORMAT ('0NIMS ',A,' Data Display, Type ',I2/�/�     1 '0 Detectors   ',I2,' to ',I2,' by ',I2/�/�     2 '  Mirror pos  ',I2,' to ',I2,' by ',I2/�;�     3 '  Grating pos ',I2,' to ',I2,'  Override mode ',I3)���� 25   LRIM = 06�      NREXP = 91 - KMF1				! Expected records next RIM�      NRRIM = 0�#�C  Read first data record requested�4�      CALL FREAD(IEDR,LPHREC,JREC+JFRONT,DATBUF,RET)&�      IF (RET.LT.0) GO TO 70			! Error0�      IF (RET.GT.0) THEN			! Record out of range�	WRITE (IOUT,928)�B� 928	FORMAT (' Starting (RIM,mf) out of range of file, try again')	�	GO TO 18� �      END IF��O�C =============================================================================�%�C  Loop on EDR records (minor frames)�� 30   CONTINUEH�C  Copy previous record to working buffer with 1 RTI offset for HRS data0�      CALL U_MOVE1(64,DATBUF,WRKBUF)			! Non-HRS�      DO I=1,10�=�	CALL U_MOVE1(6,IHRS(1,I),KHRS(1,I))		! HRS hskpng, no offset� �      ENDDO��      DO I=2,10GA�	CALL U_MOVE1(90,IHRS(7,I),KHRS(7,I-1))		! HRS data, 1 RTI offset  �      ENDDO %�C  Read next data record (read ahead)L�      KREC=JRECe�      JREC=JREC+1s4�      CALL FREAD(IEDR,LPHREC,JREC+JFRONT,DATBUF,RET)&�      IF (RET.LT.0) GO TO 70			! Error9�      IF (RET.GT.0) GO TO 32			! Out of range, assume EOFf;�C  Copy first RTI of HRS data to last RTI of working bufferT+�      CALL U_MOVE1(90,IHRS(7,1),KHRS(7,10))	�      GO TO 34<�C  End of EDR, set to process last record (zero last packet)#� 32   CALL U_FILL1(0,96,KHRS(1,10)) �      EOF=.TRUE.%�      WRITE (IOUT,932) JREC,IRIM2,MF2E?� 932  FORMAT (' End-of-file encountered at EDR data record',I6, �     1 '  SCLK',I10,'.',I2.2)�� 34   CONTINUEP�C  Expand HRS packets (background & data) from 10 to 16 bits. Save housekeeping.$�      DO I=1,10							! \ over 1 RIM>�        CALL NIMS_EXPAND_HRS(KHRS(7,I),IBKG(1,I),JDATA(1,1,I))+�        CALL U_MOVE1(6,KHRS(1,I),IHSK(1,I))	 �      ENDDO()�      LRIM = KRIM					! Save previous RIMe4�      CALL U_MOVE1(3,KSCLK,KRIM)			! Unpack SCLK RIMD�C  Check for zero SCLK; if so, compute from next (read-ahead) record<�      IF (KSCLK.EQ.0) THEN		! SCLK of current working record9�	IF (ISCLK.NE.0) THEN		! SCLK of next (read-ahead) recordD=�          CALL U_MOVE1(3,ISCLK,KRIM)	! Get RIM of next recordM)�	  KMF = MF - 1			! Decrement minor framet/�	  IF (KMF.LT.0) THEN		! Check for RIM rollover��	    KRIM = KRIM - 1
�	    KMF = 90i�	  ENDIF�	ENDIF �      ENDIFI1�      CALL U_MOVE1(1,KMF,MMF)				! Unpack SCLK mfu �C  New RIM?n4�      IF (NRRIM.LT.NREXP.AND.KREC.GT.JREC1) GO TO 40'�C  Print status items from previous RIMGC�      IF (KREC.GT.JREC1.AND.RSTAT.GT.0) THEN		! ENGR data requested�,�	CALL NIMS_HSKPNG( LHSK, HHSK, CMD, HSKSTAT,2�     1					DCHAN, IGS, ICHM) !Extract status itemsG�	CALL NIMS_ENGR( ENGR, TDN, ODN, TEMP, RESIST)	! Extract, compute TEMPs �	WRITE (ILIST,9345) LRIM,C>�     1   ((HSKSTAT(I,J),I=1,10),IGS(J),CHMODE(ICHM(J)),J=1,2),>�     2   CMD, DCHAN, ODN, (J,(TDN(J,I),TEMP(J,I),I=1,6),J=1,7)C� 9345	FORMAT (' RIM',I10,'  NIMS Status and Engineering'/5X,'(X) ',�E�     1   'H/W   S/W  XBus  ABus Power  Grat   Mir  RefV OpCal Chksm',	D�     2   ' Gain Chop'/'  LRS:',10Z6,I5,1X,A4/'  HRS:',10Z6,I5,1X,A4/8�     3   '  Command buffer (X):  LRS>',7Z3,'  HRS>',7Z3/*�     4   '  LRS data:  Si',I5,'  InSb',I5/1�     5   '  FlexTemp DN',I4,'  RCT PtTemp DN',I4, )�     6   '  NiTemp DN',I4,'  RefR DN',I4/ 5�     7   '         FPA       Radiator   Telescope  ', 4�     8        '  Grating     Chopper   Electronics'/1�     9   3X,6('   DN   TEMP')/(I2,1X,6(I5,F7.2)))s �      ENDIFn�C  Begin new RIMP�      CALL NIMS_DET_MODE(KHRS,LHSK,KLRS(2),MMF,       !Find mode from HRS hskpng0�     1 MRPT,MIROP,MGSTART,MGDELTA,MGSTEPS,KMODE)�      IMODE=KMODEo%�      IF (INMODE.GT.0) IMODE = INMODE *�      IF (IMODE.LT.0.AND.ITYPE.NE.-2) THEN� 349	WRITE (IOUT,9349)E� 9349	FORMAT (' Mode could not be determined -- enter override (I5)')i&�	READ (IIN,9202,ERR=349,END=80) INMODE+�	IF (INMODE.LT.0.OR.INMODE.GT.9) INMODE = 7p�	IMODE = INMODES �      ENDIFbO�      CALL NIMS_GET_MODE_INFO(IMODE,NGP,NITS,IGRDEL) ! Get # gr pos, nits/cycletG�      IF (NGP.EQ.1) NGP=NITS-1		! If fixed mode, default to no rest pose-�      IF (IGP1.EQ.0.AND.IGP2.EQ.0) IGP2=NGP-1n�      IF (KREC.GT.JREC1) THENi �	NREXP = 91l
�	NRRIM = 0 �      ENDIFI>�      WRITE (ILIST,935) KRIM,KMODE,IMODE		! Add more items ???>� 935  FORMAT (//' RIM',I10,'  Mode found',I3,'  Mode used',I3)�      IF (ITYPE.LT.-1) GO TO 39S.�C  Print headers for type 2 & 3 & bkgrnd dumpsC� 36   IF (ITYPE.EQ.2) WRITE (ILIST,936) IMP1,(I,I=IDT1,IDT2,IDTDEL)o-� 936  FORMAT ('0  NIMS Sensor Data,  MP ',I2/b-�     1 '0      SCLK     GP MD \ Det',I2,16I5)rC�      IF (ITYPE.EQ.3) WRITE (ILIST,937) IDT1,(J,J=IMP1,IMP2,IMPDEL)a.� 937  FORMAT ('0  NIMS Sensor Data,  Det ',I2/,�     1 '0      SCLK     GP MD \ MP',I2,19I5)>�      IF (ITYPE.LT.0) WRITE (ILIST,938) (I,I=IDT1,IDT2,IDTDEL)C� 938  FORMAT ('0NIMS Background Data'/'0      SCLK     GP MD',17I5)i�      WRITE (ILIST,9388)� 9388 FORMAT (1X)s;�C  Header for minor frame stats, if no other data requested�� 39   IF (ITYPE.EQ.-2) THEN.0�	IF (MSTAT.EQ.1.OR.MSTAT.EQ.3) WRITE (ILIST,939)F� 939    FORMAT ('0LSEQ       SCLK         ERT     TLM Ob ',           F�     1 '---------Valid Data---------- TIN DSN      SNR      RSL LRSFG'�     2 ' --LRS(X)-- ENGR(X)'))-�	IF (MSTAT.GE.2) WRITE (ILIST,9392)				! AACSD� 9392   FORMAT (12X,'SCLK  '<�     1   '     RRA    RDEC     RTW     PRA    PDEC     PTW',<�     1   '     PCR    PCCR    RSMD    RSPA    CONE     CLK') �      ENDIF '�C  Process data in record (minor frame)e2� 40   NRRIM = NRRIM + 1					! count records in RIMA�      CALL U_MOVE1(3,KLRS,LHSK(1,MMF+1))		! Save LRS hsk over RIM ?�      CALL U_MOVE1(2,KENGR,ENGR(1,MMF+1))		! Save ENGR over RIME�      DO I=1,10_B�	CALL U_MOVE1(6,IHSK(1,I),HHSK(1,I,MMF+1))	! Save HRS hsk over RIM �      ENDDO E�C  Is record fill? (All zeros in validity array)  Flawed? (ANY zeros)c8�C  Also count invalid mod8 data and keep SNR statistics.�      IVCOUNT = 0R�      DO I=1,10o!�	CALL U_MOVE1(1,KVALID(I),NVALID)e	�	DO J=1,8R0�	  IF (MOD(NVALID,2).NE.0) IVCOUNT = IVCOUNT + 1�	  NVALID = NVALID/2	   �	ENDDO �      ENDDO-3�      CALL NIMS_UNPK_ERT(KERT,KERTX)			! unpack ERTd�      SNR = KSNR / 128.t�      RSL = KRSL / 128.a6�      IF (ITYPE.EQ.-2) GO TO 45				! Housekeeping onlyO�C .............................................................................n��5�C  Loop on stripes (grating positions) in minor framen�      DO 449 K=1,2'�C   Test grating position for inclusiont�      IGP=MOD(2*MMF+K-1,NITS)r/�      IF (IGP.LT.IGP1.OR.IGP.GT.IGP2) GO TO 449M;�      MDIR=MOD(IGP,2)+1			! Mirror direction: 1 down, 2 up, 2�      IF (IGP.GE.NGP) MDIR = 0		!  0 rest position�C   Dump type?�      IF (ITYPE.LT.0) GO TO 44�      GO TO (41,42,43),ITYPEB�C   Print data versus detector (across) and mirror position (down)� 41   CONTINUE�      IMPBAS=(K-1)*NMP�      IMPLAS=IMPBAS+NMPm�      KMP1=IMP1+IMPBAS�      KMP2=IMP2+IMPBAS*�      WRITE (ILIST,941) KRIM,KMF,IGP,MDIR,�     1 (I,I=IDT1,IDT2,IDTDEL)r:� 941  FORMAT ('0SCLK ',I10,'.',I2.2,'  GP',I3,'  MDIR',I3,�     1 '  NIMS Sensor Data'/�     2 '0 MP \ DET',I2,16I5)�      WRITE (ILIST,9388) �      GO TO (412,412,414),MDIR+1>�C    Forward mirror scan (down in instrument) or rest position#� 412  DO 413 J=KMP1+1,KMP2+1,IMPDEL2�      JMP=J-IMPBAS-15�      IF (FOUND(MINVAL,IDATA,IDT1,IDT2,IDTDEL,J,J,1))o=�     1 WRITE (ILIST,9413) JMP,(IDATA(I,J),I=IDT1,IDT2,IDTDEL)c� 9413 FORMAT (2X,I2,3X,17I5)� 413  CONTINUE�      GO TO 449Y>�C    Backward mirror scan (up in instrument) reversed for dump.� 414  DO 415 J=IMPLAS-IMP1,IMPLAS-IMP2,-IMPDEL�      JMP=IMPLAS-J5�      IF (FOUND(MINVAL,IDATA,IDT1,IDT2,IDTDEL,J,J,1))N=�     1 WRITE (ILIST,9413) JMP,(IDATA(I,J),I=IDT1,IDT2,IDTDEL)	� 415  CONTINUE�      GO TO 449N� 42   J0=NMP*(K-1)�      IF (IMP1.LT.0) GO TO 425-�C   Print data for a selected mirror positionI9�C    versus detector (across) and grating position (down)e �      IF (MDIR.LE.1) J=J0+IMP1+1"�      IF (MDIR.EQ.2) J=J0+NMP-IMP15�      IF (FOUND(MINVAL,IDATA,IDT1,IDT2,IDTDEL,J,J,1))t+�     1 WRITE (ILIST,942) KRIM,KMF,IGP,MDIR, '�     2  (IDATA(I,J),I=IDT1,IDT2,IDTDEL)I,� 942  FORMAT (1X,I10,'.',I2.2,I4,I3,3X,17I5)�      GO TO 449gC�C   Compute and print either average or sigma over mirror positions 9�C    versus detector (across) and grating position (down)D*� 425  CALL MIRAVE(IDATA(1,J0+1),IAVE,ISIG)9�      IF (IMP1.EQ.-1) WRITE (ILIST,942)KRIM,KMF,IGP,MDIR,*#�     1 (IAVE(I),I=IDT1,IDT2,IDTDEL) 9�      IF (IMP1.EQ.-2) WRITE (ILIST,942)KRIM,KMF,IGP,MDIR,E#�     1 (ISIG(I),I=IDT1,IDT2,IDTDEL)"�      GO TO 449E&�C   Print data for a selected detector@�C    versus mirror position (across) and grating position (down)� 43   IMPBAS=(K-1)*NMP�      IMPLAS=IMPBAS+NMPN�      KMP1=IMP1+IMPBAS�      KMP2=IMP2+IMPBAS�      IF (MDIR.LE.1) THENPA�        IF (FOUND(MINVAL,IDATA,IDT1,IDT1,1,KMP1+1,KMP2+1,IMPDEL))A0�     1      WRITE (ILIST,943) KRIM,KMF,IGP,MDIR,3�     2       (IDATA(IDT1,J),J=KMP1+1,KMP2+1,IMPDEL)� �      ENDIFp�      IF (MDIR.EQ.2) THEN C�        IF (FOUND(MINVAL,IDATA,IDT1,IDT1,1,IMPLAS-IMP1,IMPLAS-IMP2,v@�     1            -IMPDEL)) WRITE (ILIST,943) KRIM,KMF,IGP,MDIR,9�     2	 (IDATA(IDT1,J),J=IMPLAS-IMP1,IMPLAS-IMP2,-IMPDEL)n �      ENDIFb,� 943  FORMAT (1X,I10,'.',I2.2,I4,I3,2X,20I5)�      GO TO 449 �C   Print backgroundH� 44   WRITE (ILIST,944) KRIM,KMF,IGP,MDIR,(JBKG(I,K),I=IDT1,IDT2,IDTDEL))� 944  FORMAT (1X,I10,'.',I2.2,I4,I3,17I5)n� 449  CONTINUE�C  End loop on stripes��O�C .............................................................................D���C  Write minor frame statusi(� 45   IF (MSTAT.EQ.1.OR.MSTAT.EQ.3) THEN/�	IF (ITYPE.NE.-2) WRITE (ILIST,939)				! HeaderaP�        WRITE (ILIST,945) KDREC,KRIM,KMF,KERTX,KTLMFMT,KOBSCUR,KVALID,  ! Status-�     1   KTLMIN,KDSN,SNR,RSL,KLRSF,KLRS,KENGRF>� 945    FORMAT (I5,I10,'.',I2.2,I4,'-',I3.3,'-',I2.2,':',I2.2,/�     1   Z4,I3,10Z3,2Z4,2F9.3,Z6,1X,3Z3,1X,2Z3).6�	WRITE (ILIST,9455) ((KHRS(I,J),I=1,6),J=1,10)			! HRSI� 9455   FORMAT (11X,'H0-4(X)',5(6Z3,1X)/11X,'H5-9(X)',5(6Z3,1X))	! hskpngA �      ENDIFM�      IF (MSTAT.GE.2) THEN0�	IF (ITYPE.NE.-2) WRITE (ILIST,9392)				! Header+�	WRITE (ILIST,946) KRIM,KMF,KAACS				! AACST"� 946	FORMAT (5X,I10,'.',I2.2,12I8) �      ENDIFE�C  More records?D�      IF (JREC.LE.JREC2.AND..NOT.EOF) GO TO 30		! Go for next record8�C  NO, end of request or end of file.  Print RIM status?�      IF (RSTAT.EQ.0) GO TO 18�C  Yes1�      CALL NIMS_HSKPNG( LHSK, HHSK, CMD, HSKSTAT, 2�     1					DCHAN, IGS, ICHM) !Extract status itemsL�      CALL NIMS_ENGR( ENGR, TDN, ODN, TEMP, RESIST)	! Extract, compute TEMPs�      WRITE (ILIST,9345) LRIM,<�     1 ((HSKSTAT(I,J),I=1,10),IGS(J),CHMODE(ICHM(J)),J=1,2),<�     2 CMD, DCHAN, ODN, (J,(TDN(J,I),TEMP(J,I),I=1,6),J=1,7))�      GO TO 18						! Go for next requestI��O�C ============================================================================= �C  End of file�C  Close files, terminateC)� 50   CLOSE (IEDR)					! TEMP Fortran EDR �      GO TO 14						! File loop1	�C  Errors*� 70   WRITE (IOUT,970)$� 970  FORMAT (' I/O or other error')(�      STOP 'EDRDMP abnormal termination'��� 80   WRITE (ILIST,980)�!� 980  FORMAT ('0End of EDR dump')5�      CLOSE (ILIST)2
� 89   STOP&�      END						! End of program EDRCHK����%�	SUBROUTINE LREAD(LUN,LPHREC,LAB,RET)K��5�C_TITLE  LREAD  Fortran READ of PDS label of NIMS EDRE���C_ARGS+�	INTEGER        LUN	!I Fortran logical unitX>�	INTEGER        LPHREC	!I Physical record length (512 or 1024)#�	CHARACTER*3072 LAB	!O Label bufferL6�	INTEGER        RET	!O Return code: 0 = OK, -1 = error��7�C_HIST  30apr92  R Mehlman, UCLA/IGPP, ORIGINAL VERSIONeC�C	08mar93  RMX  Adapted to work on both 512- and 1024-byte records.N�C_ENDD���	N=3072/LPHREC�	I2=0T	�	DO K=1,N
�	  I1=I2+1�	  I2=I2+LPHRECI-�	  READ (LUN,REC=K,ERR=50) (LAB(I:I),I=I1,I2))�	ENDDO�	RET = 0�	RETURNN�� � 50	RET = -1�	RETURNM�	END����*�	SUBROUTINE FREAD(LUN,LPHREC,MREC,BUF,RET)��L�C_TITLE  FREAD  Fortran READ of EDR logical record (1 or 2 physical records)���C_ARGS%�	INTEGER LUN		!I Fortran logical unitR>�	INTEGER LPHREC		!I Physical record length (512 or 1024 bytes))�	INTEGER MREC		!I 1024-byte-record number8/�	BYTE BUF(1024)		!O Buffer for 1024-byte record :�	INTEGER RET		!O Return code: 0 = OK, 1 = rec out of range5�C				     2 = illegal rec len,  -1 I/O or other errorn��
�C_CALL  BREAD ��7�C_HIST  30apr92  R Mehlman, UCLA/IGPP, ORIGINAL VERSION >�C	30oct92  RMX  Calls block-reading subroutine for efficiency.>�C	08mar93  RMX  Allow both 512- and 1024-byte physical records���C_ENDM���      IF (LPHREC.EQ.512) THENN�	MBLK1 = 2*MREC-1F(�	CALL BREAD(LUN, MBLK1,   BUF(  1), RET)(�	CALL BREAD(LUN, MBLK1+1, BUF(513), RET)#�      ELSE IF (LPHREC.EQ.1024) THENF+�	READ (LUN,REC=MREC,ERR=50,IOSTAT=IERR) BUF*�	RET = 0	�	GO TO 80)7� 50	IF (IERR.EQ.36) THEN	! FOR$ATTACCNON in VMS FortranD
�	  RET = 1�	ELSE1 �	  RET = -1k�	ENDIF
�      ELSE�	RET = 2 �      END IF � 80   RETURN	�      END,����#�	SUBROUTINE BREAD(LUN,MBLK,BUF,RET)s��/�C_TITLE  BREAD  Fortran READ of 512-byte recordC���C_ARGS%�	INTEGER LUN		!I Fortran logical unit9,�	INTEGER MBLK		!I Number of block to be read#�	BYTE BUF(512)		!O Buffer for block ;�	INTEGER RET		!O Return code: 0 = OK, 1 = rec out of range,��C				!		-1 I/O or other errorH��7�C_HIST  30oct92  R Mehlman, UCLA/IGPP, ORIGINAL VERSION	(�C	19jan93  RMX  Corrected EOF test value���C_END-��+�	READ (LUN,REC=MBLK,ERR=50,IOSTAT=IERR) BUF-�	RET = 0�	RETURNq��7� 50	IF (IERR.EQ.36) THEN	! FOR$ATTACCNON in VMS Fortran
�	  RET = 1�	ELSEp �	  RET = -1e�	ENDIF�	RETURN)�	END����(�      SUBROUTINE MIRAVE(IDATA,IAVE,ISIG)��M�C_TITLE MIRAVE  Compute average & sigma over all mirror pos. in each detector2���C_ARGS=�      INTEGER*2 IDATA(17,20)		!I One minor frame of NIMS datae>�      INTEGER*2 IAVE(17)		!O Average over mirror pos, each det>�      INTEGER*2 ISIG(17)		!O Std dev over mirror pos, each det��6�C_HIST	14nov84  R Mehlman, UCLA/IGPP  ORIGINAL VERSION�C	30oct92  RMX  Documented. ���C_ENDo#�      INTEGER*4 ISUM(17),ISS(17),ID,�      REAL*4 DIFF �      REAL*8 DSS,DS �C5�      DO 5 I=1,17 �       ISUM(I)=0�       ISS(I)=0o�       DO 3 J=1,20�        ID=IDATA(I,J) �        ISUM(I)=ISUM(I)+ID�        ISS(I)=ISS(I)+ID*IDn� 3     CONTINUE �       IAVE(I)=ISUM(I)/20.+.5t� 4     DS=ISUM(I)E�       DSS=ISS(I)5�       DIFF=DSS-DS*DS/20.  �       ISIG(I)=SQRT(DIFF/19.)+.5� 5    CONTINUE �      RETURN	�      END-����@�      LOGICAL FUNCTION FOUND(MINVAL,IDATA,I1,I2,IDEL,J1,J2,JDEL)��N�C_TITLE FOUND  Search for values .GE. MINVAL in specified values of NIMS array���C_ARGS3�      INTEGER   MINVAL		!I Minimum value for searchd=�      INTEGER*2 IDATA(17,40)	!I NIMS data for one minor frame,%�      INTEGER   I1		!I Start detector)$�      INTEGER   I2		!I Stop detector'�      INTEGER   IDEL		!I Delta detectorI,�      INTEGER   J1		!I Start mirror position+�      INTEGER   J2		!I Stop mirror position=.�      INTEGER   JDEL		!I Delta mirror positionD�C     LOGICAL   FOUND		!O TRUE if search successful, FALSE otherwise��6�C_HIST	03jan91  R Mehlman, UCLA/IGPP  ORIGINAL VERSION6�C	30oct92  RMX  Cut from 3 to 2 dimensions, documented���C_ENDl��7�      IF (MINVAL.LE.0) GO TO 50		! 0 MINVAL:  NO SEARCHT�      FOUND=.FALSE.t�      DO J=J1,J2,JDELi�	DO I=I1,I2,IDEL%�	  IF (IDATA(I,J).GE.MINVAL) GO TO 50P�	ENDDO �      ENDDOM �      RETURN� 50   FOUND=.TRUE. �      RETURN	�      ENDD