PROGRAM EDRCHK C IMPLICIT NONE C ------------------- C | E D R C H K | C ------------------- C_TITLE EDRCHK Read and check NIMS EDR file, write report (portable version) C_USER INTEGER IOPT ! Print option: 1 header only, C 2 header + grand totals C 3 header + RIM totals + grand totals C 4 all of the above + data rec values CHARACTER*128 TO ! Output log file name CHARACTER*128 FROM ! Input file name C_VARS INCLUDE 'edrhdr.inc' ! EDR hdr rec defs for COMMON /EDRHDR/ INCLUDE 'edrdat.inc' ! EDR data rec defs for COMMON /EDRDAT/ INCLUDE 'edrhrec.inc' ! EDR for data from input record header INCLUDE 'edrdrec.inc' ! EDR for data from input record INCLUDE 'wrkdat.inc' ! Work data rec defs for COMMON /WRKDAT/ C_DESC Read and check NIMS EDR file. Write report containing header record C information and, optionally, time, status and validity items from C each data record, and totals of various items. C_FILE NIMS EDR file: 1024-byte records -- 2 header records, 1 data record C per minor frame, maximum 9102 records (100 RIMs). Preceded by C PDS/ISIS label (3 records). (Vicar label has been removed.) 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) C Output list file is an ordinary ASCII print file with Fortran C carriage control. C_LIMS This version uses Fortran I/O to read the EDR. Another version is C available which uses ISIS Table I/O. C_CALL DSPLAB, LREAD, FREAD (below) and U_MOVE1, U_FILL1, and NIMS_UNPK_ERT C_KEYS NIMS, EDR C_HIST 28aug91 R Mehlman, UCLA/IGPP, ORIGINAL VERSION C 17sep91 RMX revised to use altered variable names in EDRDAT.INC and C WRKDAT.INC, & to use variables from WRKDAT rather than EDRDAT C 23sep91 RMX added new modes, RIM printouts and final totals C 23sep91 RMX non-TAE version (for convenience) C 26sep91 RMX carriage control on RIM line made to vary with mode, C added IOUT unit for batch runs, computed LENF C 30sep91 RMX new RIM test made smarter, # fill records printed C 01oct91 RMX added simple PDS label printout, more fixes to RIM test, C added RSL printout, and header RIMSTAT table printout C 02oct91 RMX SNR and RSL scaled properly by dividing by 128 C 09feb92 RMX Fixed SNR Total Average computation. C 30apr92 RMX Temp version for EDR with Vicar label removed (NDRCHK) C Fortran I/O changed to read 512-byte records. C 20oct92 RMX Portable non-ISIS version for NIMS EDR CD. C 21oct92 RMX Added record printout of NIMS LRS hskpng and ENGR items. C 02nov92 RMX U_UNPK_ERT renamed NIMS_UNPK_ERT. C 01apr93 EME Modifications made for the SUN/UNIX environment C_END INTEGER RET ! Return code 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 LOGICAL EOF ! EDR EOF INTEGER LENREC /1024/ ! EDR rec length INTEGER IEDR /1/ ! EDR lun INTEGER IIN /5/ ! Terminal input lun INTEGER IOUT /6/ ! Terminal output lun INTEGER ILIST /7/ ! Report output lun C Non-TAE parameter input 10 WRITE (IOUT,910) 910 FORMAT (' Enter print option: 1: hdr only, 2: hdr + totals,'/ 1 ' 3: hdr + RIMs + totals, 4: all incl data recs') READ (IIN,911,ERR=10,END=80) IOPT 911 FORMAT (I5) IF (IOPT.LE.0.OR.IOPT.GT.4) GO TO 10 12 WRITE (IOUT,912) 912 FORMAT (' Enter output list file name, or EOF to exit') READ (IIN,913,END=80) TO 913 FORMAT (A) OPEN (ILIST,FILE=TO,STATUS='NEW') C Loop on EDR filename 14 WRITE (IOUT,914) 914 FORMAT (' Enter EDR filename, or EOF to exit') READ (IIN,915,ERR=14,END=80) LENF,FROM 915 FORMAT (Q,A) C Open EDR file, read PDS/ISIS label and 2 Header records OPEN (IEDR,FILE=FROM,STATUS='OLD',FORM='UNFORMATTED',READONLY, . access='direct',recl=512) EOF=.FALSE. IREC = 0 CALL LREAD (IEDR,IREC,LABEL,RET) ! PDS/ISIS label CALL FREAD (IEDR,IREC,HDREC1,RET) ! Header records CALL FREAD (IEDR,IREC,HDREC2,RET) C Print PDS label WRITE (ILIST,920) PROJ,INSTR,FROM(1:LENF) CALL DSPLAB(LABEL,3072,ILIST) C Print header info WRITE (ILIST,920) PROJ,INSTR,FROM(1:LENF) 920 FORMAT (' ',10A1,6A1,' EDR file ',A/) CALL REFHDR IRIM1 = 0 CALL U_MOVE1(3,ISCLK1,IRIM1) ! Unpack SCLKs CALL SWAPL(IRIM1) IRIM2 = 0 CALL U_MOVE1(3,ISCLK2,IRIM2) CALL SWAPL(IRIM2) WRITE (ILIST,921) IRIM1,MF1,IRIM2,MF2,SCLKPART 921 FORMAT (' SCLK range:',2(I10,'.',I2.2),' Partition',I3) CALL NIMS_UNPK_ERT(IERT1,IERT1X) ! Unpack ERTs CALL NIMS_UNPK_ERT(IERT2,IERT2X) WRITE (ILIST,922) IERT1X,IERT2X 922 FORMAT (' ERT range:',2(I4,'-',I3.3,'-',I2.2,':',I2.2)) WRITE (ILIST,923) NTOTAL,NFILL,NCMPLT,NVLRS,NVAACS 923 FORMAT (' Total recs',I5,' Fill',I5,' Complete',I5, 1 ' Valid NIMS LRS packets',I6,' Valid AACS LRS',I6) WRITE (ILIST,924) NREALT,NSDR,NIDR,NSFDU,NEDR 924 FORMAT (' RT recs',I5,' SDR',I5,' IDR',I5,' SFDU',I5, 1 ' EDR',I5) WRITE (ILIST,925) NGCFERR,NNGOLERR,NAGOLERR,NPNERR,NSCLKERR 925 FORMAT (' Error recs: GCF',I7,' NIMS LRS Golay',I7, 1 ' AACS LRS Golay',I7,' PN',I7,' SCLK',I7) C Print noise statistics per RIM from header WRITE (ILIST,927) 927 FORMAT (/,' RIM MinSNR MaxSNR MinRSL MaxRSL') LRIM = IRIM1 NRIM = IRIM2 - IRIM1 + 1 DO L=1,NRIM SNRMIN = RIMSTAT(1,L) / 128. SNRMAX = RIMSTAT(2,L) / 128. RSLMIN = RIMSTAT(3,L) / 128. RSLMAX = RIMSTAT(4,L) / 128. WRITE (ILIST,928) LRIM,SNRMIN,SNRMAX,RSLMIN,RSLMAX 928 FORMAT (1X,I10,4F9.3) LRIM = LRIM + 1 ENDDO C Set up for data record processing IF (IOPT.EQ.1) GO TO 50 ! Quit if header-only option ICCRIM = ' ' IF (IOPT.EQ.4) THEN WRITE (ILIST,929) 929 FORMAT (/,' REC SCLK ERT TLM Ob ', 1 '---------Valid Data---------- TIN DSN SNR RSL LRSFG' 2 ' ---LRS--- -ENGR-') ICCRIM = '0' ENDIF C Initialize Total stats NRTOT = 0 NRFILLT = 0 NRFLAWT = 0 IVSUMT = 0 ISNRSUMT = 0 MINSNRT = 999999 MAXSNRT = 0 C Initialize RIM stats NRRIM = 0 NRFILL = 0 NRFLAW = 0 IVSUM = 0 ISNRSUM = 0 MINSNR = 999999 MAXSNR = 0 LRIM = 0 NREXP = 91 - MF1 ! Expected records next RIM C Initialize row (frame) count IFRAME=8 ! (skipping header) C Read first data record CALL FREAD(IEDR,IREC,DATBUF,RET) CALL REFREC JREC=1 C ============================================================================= C Loop on EDR records 30 CONTINUE C Copy previous record to working buffer with 1 RTI offset for HRS data KDREC = IDREC KSCLK = ISCLK KERT = IERT KTLMFMT = ITLMFMT KOBSCUR = IOBSCUR CALL U_MOVE1(2,IRES1,KRES1) CALL U_MOVE1(10,IVALID,KVALID) KTLMIN = ITLMIN KDSN = IDSN KSNR = ISNR KRSL = IRSL KLRSF = ILRSF CALL U_MOVE1(2,IRES2,KRES2) CALL U_MOVE1(3,ILRS,KLRS) CALL U_MOVE1(2,IENGR,KENGR) CALL U_MOVE1(12,IAACS,KAACS) DO I=1,10 CALL U_MOVE1(6,IHRS(1,I),KHRS(1,I)) ! HRS hskpng, no offset ENDDO DO I=2,10 CALL U_MOVE1(90,IHRS(7,I),KHRS(7,I-1)) ! HRS data, 1 RTI offset ENDDO C Read data record KREC=JREC CALL FREAD(IEDR,IREC,DATBUF,RET) CALL REFREC IF (RET.EQ.1) GO TO 32 ! EOF JREC=JREC+1 C Copy first RTI of HRS data to last RTI of working buffer 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. 34 CONTINUE KRIM = 0 CALL U_MOVE1(3,KSCLK,KRIM) ! unpack SCLK CALL SWAPL(KRIM) C New RIM? IF (NRRIM.LT.NREXP) GO TO 38 C Yes. Print summary of previous RIM. PCMISS = 100.0 * (1.0 - IVSUM/(NRRIM*80.)) SNRAVE = FLOAT(ISNRSUM) / (NRRIM*128.) SNRMIN = MINSNR / 128. SNRMAX = MAXSNR / 128. IF (IOPT.GE.3) WRITE (ILIST,937) 1 LRIM,NRRIM,NRFILL,NRFLAW,PCMISS,SNRAVE,SNRMIN,SNRMAX 937 FORMAT (/,' RIM',I10,' Recs:',I5,' Fill:',I5,' Flawed:',I5, 1 ' Invalid mod8:',F8.4,'% SNR ave:',F9.3,' SNR range:',2F9.3) NRTOT = NRTOT + NRRIM NRFILLT = NRFILLT + NRFILL NRFLAWT = NRFLAWT + NRFLAW IVSUMT = IVSUMT + IVSUM ISNRSUMT = ISNRSUMT + ISNRSUM IF (MINSNR.LT.MINSNRT) MINSNRT = MINSNR IF (MAXSNR.GT.MAXSNRT) MAXSNRT = MAXSNR NREXP = 91 NRRIM = 0 NRFILL = 0 NRFLAW = 0 IVSUM = 0 ISNRSUM = 0 MINSNR = 999999 MAXSNR = 0 IF (IOPT.EQ.4) WRITE (ILIST,929) ! data record titles 38 NRRIM = NRRIM + 1 LRIM = KRIM C Is record fill? (All zeros in validity array) Flawed? (ANY zeros) C Also count invalid mod8 data and keep SNR statistics. IVCOUNT = 0 DO I=1,10 NVALID = 0 CALL U_MOVE1(1,KVALID(I),NVALID) CALL SWAPL(NVALID) DO J=1,8 IF (MOD(NVALID,2).NE.0) IVCOUNT = IVCOUNT + 1 NVALID = NVALID/2 ENDDO ENDDO IF (IVCOUNT.EQ.0) NRFILL = NRFILL + 1 IF (IVCOUNT.NE.80) NRFLAW = NRFLAW + 1 IVSUM = IVSUM + IVCOUNT ISNRSUM = ISNRSUM + KSNR IF (KSNR.LT.MINSNR) MINSNR = KSNR IF (KSNR.GT.MAXSNR) MAXSNR = KSNR C Detailed printout each record? IF (IOPT.LT.4) GO TO 45 C Yes, print data record info CALL NIMS_UNPK_ERT(KERT,KERTX) ! unpack ERT SNR = KSNR / 128. RSL = KRSL / 128. WRITE (ILIST,944) KDREC,KRIM,KMF,KERTX,KTLMFMT,KOBSCUR,KVALID, 1 KTLMIN,KDSN,SNR,RSL,KLRSF,KLRS,KENGR 944 FORMAT (I5,I10,'.',I2.2,I4,'-',I3.3,'-',I2.2,':',I2.2, 1 Z4,I3,10Z3,2Z4,2F9.3,Z6,1X,3Z3,1X,2Z3) C More records? 45 IF (.NOT.EOF) GO TO 30 ! Go for next record C ============================================================================= C End of file C Print grand totals C Yes. Print summary of previous RIM. PCMISS = 100.0*(1.0-IVSUM/(NRRIM*80.)) SNRAVE = FLOAT(ISNRSUM) / (NRRIM*128.) SNRMIN = MINSNR / 128. SNRMAX = MAXSNR / 128. WRITE (ILIST,937) 1 LRIM,NRRIM,NRFILL,NRFLAW,PCMISS,SNRAVE,SNRMIN,SNRMAX NRTOT = NRTOT + NRRIM NRFILLT = NRFILLT + NRFILL NRFLAWT = NRFLAWT + NRFLAW IVSUMT = IVSUMT + IVSUM ISNRSUMT = ISNRSUMT + ISNRSUM IF (MINSNR.LT.MINSNRT) MINSNRT = MINSNR IF (MAXSNR.GT.MAXSNRT) MAXSNRT = MAXSNR PCMISST = 100.0*(1.0-IVSUMT/(NRTOT*80.)) SNRAVET = FLOAT(ISNRSUMT) / (NRTOT*128.) SNRMINT = MINSNRT / 128. SNRMAXT = MAXSNRT / 128. WRITE (ILIST,948) NRTOT,NRFILLT,NRFLAWT,PCMISST,SNRAVET, 1 SNRMINT,SNRMAXT 948 FORMAT (/,' GRAND TOTALS: Recs:',I5,' Fill:',I5,' Flawed:', 1 I5,' Invalid mod8:',F8.4,'% SNR ave:',F9.3, 2 ' SNR range:',2F9.3) C Close files, terminate 50 CLOSE (IEDR) ! TEMP Fortran EDR GO TO 14 ! File loop 80 STOP END ! End of program EDRCHK SUBROUTINE DSPLAB(LABEL,LENLAB,ILIST) C_TITLE DSPLAB Simple display of PDS/ISIS label C_ARGS CHARACTER*(*) LABEL !I Label INTEGER LENLAB !I Max # characters in label INTEGER ILIST !I Output unit C_HIST 20aug87 Bob Mehlman UCLA/IGPP ORIGINAL VERSION (Char Var Version) C 30sep91 RMX Documentation added CHARACTER*1 CR,LF C CR=CHAR(13) LF=CHAR(10) C I1=1 K=I1 10 K=K+1 ! Next line IF (LABEL(K:K).NE.LF) GO TO 10 ! Search for line-feed WRITE (ILIST,910) LABEL(I1:K-2) ! Display line 910 FORMAT (1X,A) IF (LABEL(K-4:K-2).EQ.'END'.AND.LABEL(K-1:K-1).EQ.CR) RETURN ! END? I1=K+1 IF (I1.LT.LENLAB) GO TO 10 ! End of label? RETURN END SUBROUTINE LREAD(LUN,IREC,LAB,RET) C_TITLE LREAD Fortran READ of 6 512-byte records of PDS label of NIMS EDR C_ARGS INTEGER LUN !I Fortran logical unit INTEGER IREC !O Record counter for read statements CHARACTER*3072 LAB !O Label buffer INTEGER RET !O Return code: 0 = OK, 1 = EOF C_HIST 30apr92 R Mehlman, UCLA/IGPP, ORIGINAL VERSION C_END I2=0 DO K=1,6 I1=I2+1 I2=I2+512 IREC = IREC + 1 READ (LUN,END=50,REC=IREC) (LAB(I:I),I=I1,I2) ENDDO RET = 0 RETURN 50 RET = 1 RETURN END SUBROUTINE FREAD(LUN,IREC,BUF,RET) C_TITLE FREAD Fortran READ of 2 512-byte records comprising 1 1024-byte record C_ARGS INTEGER LUN !I Fortran logical unit INTEGER IREC !O Record counter BYTE BUF(1024) !O Buffer for 1024-byte record INTEGER RET !O Return code: 0 = OK, 1 = EOF C_HIST 30apr92 R Mehlman, UCLA/IGPP, ORIGINAL VERSION C_END IREC = IREC + 1 READ (LUN,END=50,REC=IREC) (BUF(I),I=1,512) IREC = IREC + 1 READ (LUN,END=50,REC=IREC) (BUF(I),I=513,1024) RET = 0 RETURN 50 RET = 1 RETURN END SUBROUTINE SWAPL(LWORD) C************************************************************************ C Swap bytes of a single long word passed to the routine C************************************************************************ BYTE LWORD(4) BYTE WORK WORK = LWORD(1) LWORD(1) = LWORD(4) LWORD(4) = WORK WORK = LWORD(2) LWORD(2) = LWORD(3) LWORD(3) = WORK RETURN END SUBROUTINE SWAPW(IWORD) C************************************************************************* C Swap bytes of a single short word passed to the routine C************************************************************************* BYTE IWORD(2) BYTE WORK WORK = IWORD(1) IWORD(1) = IWORD(2) IWORD(2) = WORK RETURN END SUBROUTINE REFHDR C************************************************************************ C Reformat the header record, swap bytes, etc. C************************************************************************* INCLUDE 'edrhrec.inc' INCLUDE 'edrhdr.inc' CALL U_MOVE1(2,B_IHREC,IHREC) CALL SWAPW(IHREC) CALL U_MOVE1(10,B_PROJ,PROJ) CALL U_MOVE1(6,B_INSTR,INSTR) CALL U_MOVE1(4,B_ISCLK1,ISCLK1) CALL U_MOVE1(4,B_ISCLK2,ISCLK2) CALL U_MOVE1(4,B_IERT1,IERT1) CALL SWAPL(IERT1) CALL U_MOVE1(4,B_IERT2,IERT2) CALL SWAPL(IERT2) CALL U_MOVE1(2,B_NTOTAL,NTOTAL) CALL SWAPW(NTOTAL) CALL U_MOVE1(2,B_NFILL,NFILL) CALL SWAPW(NFILL) CALL U_MOVE1(2,B_NCMPLT,NCMPLT) CALL SWAPW(NCMPLT) CALL U_MOVE1(2,B_NVLRS,NVLRS) CALL SWAPW(NVLRS) CALL U_MOVE1(2,B_NVAACS,NVAACS) CALL SWAPW(NVAACS) CALL U_MOVE1(2,B_NREALT,NREALT) CALL SWAPW(NREALT) CALL U_MOVE1(2,B_NSDR,NSDR) CALL SWAPW(NSDR) CALL U_MOVE1(2,B_NIDR,NIDR) CALL SWAPW(NIDR) CALL U_MOVE1(2,B_NSFDU,NSFDU) CALL SWAPW(NSFDU) CALL U_MOVE1(2,B_NEDR,NEDR) CALL SWAPW(NEDR) CALL U_MOVE1(2,B_NGCFERR,NGCFERR) CALL SWAPW(NGCFERR) CALL U_MOVE1(2,B_NNGOLERR,NNGOLERR) CALL SWAPW(NNGOLERR) CALL U_MOVE1(2,B_NAGOLERR,NAGOLERR) CALL SWAPW(NAGOLERR) CALL U_MOVE1(4,B_NGOLERR,NGOLERR) CALL SWAPL(NGOLERR) CALL U_MOVE1(4,B_NPNERR,NPNERR) CALL SWAPL(NPNERR) CALL U_MOVE1(4,B_NSCLKERR,NSCLKERR) CALL SWAPL(NSCLKERR) CALL U_MOVE1(1,B_SCLKPART,SCLKPART) CALL U_MOVE1(151,B_HDRRES1,B_HDRRES1) DO I = 1,100 DO J = 1,4 CALL U_MOVE1(2,B_RIMSTAT(1,J,I),RIMSTAT(J,I)) CALL SWAPW(RIMSTAT(J,I)) END DO END DO CALL U_MOVE1(2,B_IHREC1,IHREC1) CALL SWAPW(IHREC1) RETURN END SUBROUTINE REFREC INCLUDE 'edrdat.inc' INCLUDE 'edrdrec.inc' C************************************************************************** C reformat the header record C************************************************************************** CALL U_MOVE1(2,B_IDREC,IDREC) CALL SWAPW(IDREC) CALL U_MOVE1(4,B_ISCLK,ISCLK) CALL U_MOVE1(4,B_IERT,IERT) CALL SWAPL(IERT) CALL U_MOVE1(1,B_ITLMFMT,ITLMFMT) CALL U_MOVE1(1,B_IOBSCUR,IOBSCUR) CALL U_MOVE1(2,B_IRES1,IRES1) CALL U_MOVE1(10,B_IVALID,IVALID) CALL U_MOVE1(1,B_ITLMIN,ITLMIN) CALL U_MOVE1(1,B_IDSN,IDSN) CALL U_MOVE1(2,B_ISNR,ISNR) CALL SWAPW(ISNR) CALL U_MOVE1(2,B_IRSL,IRSL) CALL SWAPW(IRSL) CALL U_MOVE1(2,B_ILRSF,ILRSF) CALL SWAPW(ILRSF) CALL U_MOVE1(3,B_IRES2,IRES2) CALL U_MOVE1(3,B_ILRS,ILRS) CALL U_MOVE1(2,B_IENGR,IENGR) CALL U_MOVE1(2,B_IAACS,IAACS) CALL SWAPW(IAACS) CALL U_MOVE1(96*10,B_IHRS,IHRS) RETURN END