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