PROGRAM EDRDMPC IMPLICIT NONEC -------------------C | E D R D M P |C -------------------NC_TITLE EDRDMP Dump selected data and housekeeping from NIMS EDR or UDR fileC_USERB INTEGER OMODE ! Output mode: 0 terminal, 1 dump file0 CHARACTER*128 TO ! Output dump file nameC 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 dump4 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 bothA INTEGER ITYPE ! Dump type (0 or 1: sensor vs det, mpC ! 2: sensor vs det, gpC ! 3: sensor vs mp, gp C ! -1: bckgrnd vs det, gpC ! -2: status only: INTEGER MINVAL ! Minimum printable dump valueC ! (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.NGPA 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/JC_DESC Dump selected data and housekeeping from NIMS EDR (with or withoutIC original Vicar label) or Vicar-labelled UDR file. Mirror rest positionDC (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:BC 0 or 1: Sensor DN vs detector & mirror position (over selected,C grating position range and delta)NC 2: DN vs detector & grating position (selected mirror position,4C or average or sigma for selected range & delta)NC 3: DN vs mirror position & grating position (selected detector)-C -1: Background data vs detector-C -2: Null (for status info only)FC Search mode is selected by entering nonzero minimum value: Any dataEC value .GE. the minimum triggers printing of the line containing it.C Status info options:EC RIM status is optional and includes housekeeping and temperaturesCC Minor Frame status is optional and may include HRS housekeepingC or AACS pointing or both.DC Status info is interspersed with data dump lines except for dump/C type -2 which results in status info only.DC Instrument mode affects only displayed grating position, and@C identification of mirror-rest-position (grating flyback) data.NC_FILES NIMS EDR file, CD-ROM version: 1024-byte records -- 2 header records,AC 1 data record per minor frame, maximum 9102 records (100 RIMs).BC Preceded by the PDS/ISIS label (3 records). The physical recordAC 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.AC Reference: NIMS EDR SIS, Number 232-08, Revision 2.0, Issue 2,/C 30 July 1991 (625-610: SIS 232-08, JPL D-296)FC EDRs as supplied by MIPL have 2-block Vicar labels preceding the PDS8C label, and a VMS physical record length of 1024 bytes.GC UDRs (essentially 2-RIM EDRs) have 2-block Vicar labels and 1024-byteC records but no PDS labels.HC Output dump file is an ASCII print file with Fortran carriage control.6C_LIMS This version uses Fortran I/O to read the EDR.9C_CALL LREAD, FREAD (& BREAD), FOUND, MIRAVE (all below)C U_FILL1, U_MOVE1 (isislib)DC NIMS_UNPK_ERT, NIMS_EXPAND_HRS, NIMS_DET_MODE, NIMS_GET_MODE_INFO,"C NIMS_ENGR, NIMS_HSKPNG (nimslib)C_KEYS NIMS, EDRNC_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).LC 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.9C 19feb93 RMX Added ENGR (temps) option to RIM display.IC 26feb93 RMX Added special HRS/LRS hskpng status items to RIM display.EC 01mar93 RMX Modified to get RIM display at end-of-request or EOF.?C 10mar93 RMX Added gain state and chopper mode parameters to6C NIMS_HSKPNG, and added them to RIM status display.:C Restructured initial parameter requests. Also allowed8C optional input of Vicar-labelled EDRs and UDRs, with:C physical record length added to LREAD and FREAD calls.9C Added complete SCLK and mirror scan direction to data2C displays. Corrected background value display.;C Modified NIMS_DET_MODE call. Added NIMS_GET_MODE_INFO.,C 19mar93 RMX Added version date printout.HC 18aug93 RMX Corrected start time computation for UDRs (added IREC1).GC 01sep93 RMX Check SCLK, compute from next record if zero (jailbars)FC 06oct93 RMX Corrected dump type 2 code for alternating mirror dir,9C improved mirror rest position (grating flyback) print7C option, now show MDIR = 0 for mirror rest position.HC 08oct93 RMX Corrected dump type 1 bug (partial backward mirror scan))C 13dec93 RMX Corrected READ from IOUT.5C 21jun94 RMX Added argument to NIMS_GET_MODE_INFO.5C 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 posI 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 buffs3 BYTE HSKSTAT(10,2) ! LRS/HRS hskpng status/ INTEGER*2 DCHAN(2) ! LRS data channels1 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 TEMPs1 REAL RESIST(7,4) ! Computed resistances/ LOGICAL MIROP ! Mirror operation flag@ INTEGER*2 IAVE(NDET), ISIG(NDET) ! Ave & sigma in mirposC Non-TAE parameter input 10 WRITE (IOUT,910) VERDATF 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 ENDIFC Loop on EDRs7C 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 IFC Open EDR fileD OPEN (IEDR,FILE=FROM,STATUS='OLD',FORM='UNFORMATTED',READONLY,% 1 ACCESS='DIRECT',RECL=LPHREC/4) IREC=1C 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 IFC...display label?C Read 2 Header records@ CALL FREAD (IEDR,LPHREC,IREC,HDREC1,RET) ! Header records' IF (RET.NE.0) GO TO 70 ! Error0 CALL FREAD (IEDR,LPHREC,IREC+1,HDREC2,RET) IF (RET.NE.0) GO TO 70- JFRONT=IREC+1 ! Records before dataC 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 ENDIF5 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)HC ----------------------------------------------------------------------=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.HC ----------------------------------------------------------------------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=1C IF ((IDT1.EQ.0.AND.IDT2.EQ.0.AND.ITYPE.NE.3).OR.IDT2.GT.NDET) 1 IDT2=NDET IF (IDT1.LE.0) IDT1=10 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=1A 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=IGP1C 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 requested4 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 IFOC =============================================================================%C Loop on EDR records (minor frames) 30 CONTINUEHC 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 CONTINUEPC 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 RIMDC 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 ENDIFnC 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 EC Is record fill? (All zeros in validity array) Flawed? (ANY zeros)c8C 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 onlyOC .............................................................................n5C 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 positionC Dump type? IF (ITYPE.LT.0) GO TO 44 GO TO (41,42,43),ITYPEBC 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 positionI9C 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 449gCC Compute and print either average or sigma over mirror positions 9C 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 CONTINUEC End loop on stripesOC .............................................................................DC 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) ENDIFEC More records?D IF (JREC.LE.JREC2.AND..NOT.EOF) GO TO 30 ! Go for next record8C NO, end of request or end of file. Print RIM status? IF (RSTAT.EQ.0) GO TO 18C 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 requestIOC ============================================================================= C End of fileC 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)K5C_TITLE LREAD Fortran READ of PDS label of NIMS EDREC_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 = error7C_HIST 30apr92 R Mehlman, UCLA/IGPP, ORIGINAL VERSIONeCC 08mar93 RMX Adapted to work on both 512- and 1024-byte records.NC_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)LC_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 range5C 2 = illegal rec len, -1 I/O or other errorn C_CALL BREAD 7C_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 recordsC_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 recordCC_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 errorH7C_HIST 30oct92 R Mehlman, UCLA/IGPP, ORIGINAL VERSION (C 19jan93 RMX Corrected EOF test valueC_END-+ READ (LUN,REC=MBLK,ERR=50,IOSTAT=IERR) BUF- RET = 0 RETURNq7 50 IF (IERR.EQ.36) THEN ! FOR$ATTACCNON in VMS Fortran RET = 1 ELSEp RET = -1e ENDIF RETURN) END( SUBROUTINE MIRAVE(IDATA,IAVE,ISIG)MC_TITLE MIRAVE Compute average & sigma over all mirror pos. in each detector2C_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 det6C_HIST 14nov84 R Mehlman, UCLA/IGPP ORIGINAL VERSIONC 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)NC_TITLE FOUND Search for values .GE. MINVAL in specified values of NIMS arrayC_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 positionDC LOGICAL FOUND !O TRUE if search successful, FALSE otherwise6C_HIST 03jan91 R Mehlman, UCLA/IGPP ORIGINAL VERSION6C 30oct92 RMX Cut from 3 to 2 dimensions, documentedC_ENDl7 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