PROGRAM EDRCLEAN C C EDR RECORD SORTER C C This routine reads formatted EDR records in a variable length record. C file. Records are checked for sensible time tags, ie., # hours does not C exceed 24, # minutes does not exceed 59, etc. Bad records are skipped. C C written by Sandy Kramer Code 690 - 04/27/2005 c C mod for speed taking advantage of Fortran column major order C of array storage to drop array reassignment. Sandy Kramer 02/24/2006 C C mod to change precision of decimal year calculation from real*4 to C real*8. Sandy Kramer 03/15/2006 C C mod to calculate decimal year to second precision (previously only C to minute. Sandy Kramer 03/15/2006 C C Notes: C Internal storage of data multi-indexed arrays is by column C LOGICAL*1 REC(12000) CHARACTER TFLAG*4,DSN*50,CLEN*4 INTEGER*2 BLEN,RECLEN,RLEN INTEGER*2 EDRTIME(6),SCETIME(6),SERTIME(6),EERTIME(6) INTEGER*4 LEAP, ORDER(30000) REAL*8 DECYEAR C INCLUDE 'UNPACK.INC' C C CREATE BIT FLIP TRANSLATION TABLE FOR LOGICAL*1 WORDS. C ASSIGN FLIP(0:255) THE BIT FLIP INVERSE OF VALUES 0 TO 255. C NECESSARY TO ACCOUNT FOR BIT ENDIAN DIFFERENCES BETWEEN C ORGINAL DATA PRODUCTION PLATFORM AND CURRENT VMS PROCESSING C SYSTEM. C DO J=0,255 DO I=0,7 CALL MOVBIT(J, I, 1, FLIP(J), 7-I) END DO END DO C C OPEN BINARY IBM BIT-MAPPED EDR . 512 BYTE LENGTH RECORD EXPECTED. C READ AS SPANNED RECORD WITH EBCIDC STRING 'MJS' DENOTING THE START C OF EACH RECORD. SORT INTO TIME ORDER THEN WRITE REBLOCKED RECORDS. C WRITE(6,*) WRITE(6,*) 'ENTER INPUT DSN' READ(5,'(A)') DSN OPEN(50,FILE=DSN,STATUS='OLD',FORM='FORMATTED', & RECORDTYPE='VARIABLE',RECL=8191,READONLY) C WRITE(6,*) WRITE(6,*) 'ENTER OUTPUT DSN' READ(5,'(A)') DSN OPEN(51,FILE=DSN,STATUS='NEW',FORM='UNFORMATTED', & RECORDTYPE='VARIABLE',RECL=8191) C WRITE(6,*) WRITE(6,*) 'Reading records...' WRITE(6,*) TFLAG = 'SCET' IBYTE = 0 NREC = 0 10 CONTINUE C Read data into a byte array grabbing record length with "Q" specifier READ(50,'(Q,A1)',END=100,ERR=10) & RECLEN,(REC(I),I=1,RECLEN) CALL UNHEAD(REC) CALL GETTIME(TFLAG,SERTIME,EERTIME,SCETIME,EDRTIME) if ( edrtime(3).ge.24 .or. edrtime(4).ge.60 .or. & edrtime(5).ge.60 .or. edrtime(6).ge.999 ) goto 10 WRITE(51) (REC(IBYTE),IBYTE=1,RECLEN) CALL DISPLAY(RECLEN,NREC,TFLAG,EDRTIME) NREC = NREC + 1 GOTO 10 100 CONTINUE CLOSE(50) WRITE(6,*) WRITE(6,'(1X,I5.5,'' TOTAL RECORDS READ'')') NREC C CLOSE(51) STOP C 800 FORMAT('CLEN'A1) C END ****************************************************************** C C DISPLAY KEY VALUES FROM UNPACKED EDR C SUBROUTINE DISPLAY(RECLEN,NCNT,TFLAG,TIME) INTEGER*2 RECLEN,TIME(6) CHARACTER*4 TFLAG,EX(0:15) CHARACTER*6 DM(0:31) CHARACTER*7 DDT(32:48) C INCLUDE 'UNPACK.INC' C DATA EX/'***','CRS','IRIS','LECP','MAG','PLS','PPS','PRA','PWS', & 'UVS','RSS','ENG','***','ISR','MR','DMR'/ DATA DM/'ENG','CR-2','CR-3','CR-4','CR-5','CR-6','CR-7','CR-1', & 'GS-10A','***','GS-3','***','GS-7','***','GS-6','GS-4', & '***','GS-2','***','***','***','***','OC-2','OC-1', & 'CR-5A','GS-10','GS-8','***','***','UV-5A','***','***'/ DATA DDT/'IRIS','CRS','LECP','MAG','PLS','PPS','PRA','PWS','UVS', & 'ISR','DCOM','MON 5-8','ENGS','ENGE','DCMS','ENGC', & 'MON 5-9'/ C WRITE(6,900) NCNT,RECNUM,RECLEN,PROJID,EX(RECID),SCID, & TFLAG,TIME,DM(DATMOD),DDT(DRSDAT) RETURN 900 FORMAT(1X,I6,1X,I6,1X,I5,' BYTES',1X,A3,1X,A4,1X,I2,1X,A4, & 1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,1X,A6,1X,A7) END ****************************************************************** * * TITLE: UNPACK VOYAGER 60 WORD EDR HEADER * * FILE NAME: UNHEAD.FOR * * PURPOSE: TO UNPACK THE HEADER BLOCK * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------ * S. J. KEMPLER 8/12/85 ORIGINAL CODE * S. B. KRAMER 9/27/92 MODIFIED FOR VIM-5 MODE * S. B. KRAMER 10/26/93 MODIFIED FOR ALL MODES * * CALLING SEQUENCE: SUBROUTINE UNHEAD(INBUF) * * MODULES REFERENCED: * * MOVBIT * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * PDL: * * GET HEADER BLOCK FROM EDR RECORD * CALL MOVBIT TO LOAD DATMOD WITH DATA MODE * CALL MOVBIT TO LOAD MOD60 WITH MOD 60 COUNT WORD * LOAD PROJID WITH THE 3 CHARACTER PROJECT ID * CALL MOVBIT TO LOAD ALL OTHER ITEMS OF THE HEADER FIELD * INTO INDIVIDUAL I*2 VARIABLES * RETURN * ******************************************************************* C SUBROUTINE UNHEAD(INBUF) C LOGICAL*1 INBUF(11280),LPROJ(3) C INCLUDE 'UNPACK.INC' C EQUIVALENCE (PROJID,LPROJ(1)) C C ASSIGN FIRST 240 BYTES OF EDR RECORD TO HEADER ARRAY (ALL MODES) C DO I = 1,240 HEAD(I) = INBUF(I) END DO C C LPROJ(1) = HEAD(1) C LPROJ(2) = HEAD(2) C LPROJ(3) = HEAD(3) C C ISTAT = LIB$TRA_EBC_ASC(PROJID,PROJID) C C IDENTIFY MARINER JUPITER SATURN (MJS) PROJECT ID C C IF (PROJID.NE.'MJS') RETURN C C SEARCH FOR DECIMAL EQUIVALENT OF EBCDIC 'MJS' C IF ( ZEXT(HEAD(1)).EQ.212 .AND. & ZEXT(HEAD(2)).EQ.209 .AND. & ZEXT(HEAD(3)).EQ.226 ) THEN PROJID = 'MJS' ELSE RETURN END IF C C ERROR IN KEMPLER'S DECOMMUTATION REVERSES RECID AND SCID C CORRECTED FOR VIM-5 PROCESSING (SBK - 10/8/92) C HEAD(4) = FLIP(ZEXT(HEAD(4))) RECID = 0 CALL MOVBIT( HEAD, 24, 1, RECID, 3) CALL MOVBIT( HEAD, 25, 1, RECID, 2) CALL MOVBIT( HEAD, 26, 1, RECID, 1) CALL MOVBIT( HEAD, 27, 1, RECID, 0) SCID = 0 CALL MOVBIT( HEAD, 28, 1, SCID, 3) CALL MOVBIT( HEAD, 29, 1, SCID, 2) CALL MOVBIT( HEAD, 30, 1, SCID, 1) CALL MOVBIT( HEAD, 31, 1, SCID, 0) C RECNUM = 0 CALL MOVBIT( HEAD, 40, 8, RECNUM, 0) CALL MOVBIT( HEAD, 32, 8, RECNUM, 8) DATMOD = 0 CALL MOVBIT( HEAD, 48, 8, DATMOD, 0) C HEAD(8) = FLIP(ZEXT(HEAD(8))) EEXTFL = 0 CALL MOVBIT( HEAD, 56, 1, EEXTFL, 1) CALL MOVBIT( HEAD, 57, 1, EEXTFL, 0) SCPLAB = 0 CALL MOVBIT( HEAD, 58, 1, SCPLAB, 0) RECTIM = 0 CALL MOVBIT( HEAD, 59, 1, RECTIM, 4) CALL MOVBIT( HEAD, 60, 1, RECTIM, 3) CALL MOVBIT( HEAD, 61, 1, RECTIM, 2) CALL MOVBIT( HEAD, 62, 1, RECTIM, 1) CALL MOVBIT( HEAD, 63, 1, RECTIM, 0) C ERTSHR = 0 CALL MOVBIT( HEAD, 72, 8, ERTSHR, 0) CALL MOVBIT( HEAD, 64, 8, ERTSHR, 8) ERTSSC = 0 CALL MOVBIT( HEAD, 88, 8, ERTSSC, 0) CALL MOVBIT( HEAD, 80, 8, ERTSSC, 8) ERTSML = 0 CALL MOVBIT( HEAD, 104, 8, ERTSML, 0) CALL MOVBIT( HEAD, 96, 8, ERTSML, 8) YEAR1 = 0 CALL MOVBIT( HEAD, 112, 8, YEAR1, 0) C HEAD(16) = FLIP(ZEXT(HEAD(16))) DATSRC = 0 CALL MOVBIT( HEAD, 120, 1, DATSRC, 1) CALL MOVBIT( HEAD, 121, 1, DATSRC, 0) GOLAY = 0 CALL MOVBIT( HEAD, 122, 1, GOLAY, 1) CALL MOVBIT( HEAD, 123, 1, GOLAY, 0) SEGNUM = 0 CALL MOVBIT( HEAD, 124, 1, SEGNUM, 3) CALL MOVBIT( HEAD, 125, 1, SEGNUM, 2) CALL MOVBIT( HEAD, 126, 1, SEGNUM, 1) CALL MOVBIT( HEAD, 127, 1, SEGNUM, 0) C ERTEHR = 0 CALL MOVBIT( HEAD, 136, 8, ERTEHR, 0) CALL MOVBIT( HEAD, 128, 8, ERTEHR, 8) ERTESC = 0 CALL MOVBIT( HEAD, 152, 8, ERTESC, 0) CALL MOVBIT( HEAD, 144, 8, ERTESC, 8) ERTEML = 0 CALL MOVBIT( HEAD, 168, 8, ERTEML, 0) CALL MOVBIT( HEAD, 160, 8, ERTEML, 8) YEAR2 = 0 CALL MOVBIT( HEAD, 176, 8, YEAR2, 0) SWVERS = 0 CALL MOVBIT( HEAD, 184, 8, SWVERS, 0) SCETHR = 0 CALL MOVBIT( HEAD, 200, 8, SCETHR, 0) CALL MOVBIT( HEAD, 192, 8, SCETHR, 8) SCETSC = 0 CALL MOVBIT( HEAD, 216, 8, SCETSC, 0) CALL MOVBIT( HEAD, 208, 8, SCETSC, 8) SCETML = 0 CALL MOVBIT( HEAD, 232, 8, SCETML, 0) CALL MOVBIT( HEAD, 224, 8, SCETML, 8) YEAR3 = 0 CALL MOVBIT( HEAD, 240, 8, YEAR3, 0) C HEAD(32) = FLIP(ZEXT(HEAD(32))) SCEVFL = 0 CALL MOVBIT( HEAD, 248, 1, SCEVFL, 3) CALL MOVBIT( HEAD, 249, 1, SCEVFL, 2) CALL MOVBIT( HEAD, 250, 1, SCEVFL, 1) CALL MOVBIT( HEAD, 251, 1, SCEVFL, 0) CORRFL = 0 CALL MOVBIT( HEAD, 252, 1, CORRFL, 3) CALL MOVBIT( HEAD, 253, 1, CORRFL, 2) CALL MOVBIT( HEAD, 254, 1, CORRFL, 1) CALL MOVBIT( HEAD, 255, 1, CORRFL, 0) C MOD216 = 0 CALL MOVBIT( HEAD, 264, 8, MOD216, 0) CALL MOVBIT( HEAD, 256, 8, MOD216, 8) MOD60 = 0 CALL MOVBIT( HEAD, 272, 8, MOD60, 0) LINCNT = 0 CALL MOVBIT( HEAD, 288, 8, LINCNT, 0) CALL MOVBIT( HEAD, 280, 8, LINCNT, 8) TELRAT = 0 CALL MOVBIT( HEAD, 296, 8, TELRAT, 0) EFFRAT = 0 CALL MOVBIT( HEAD, 304, 8, EFFRAT, 0) FORMID = 0 CALL MOVBIT( HEAD, 312, 8, FORMID, 0) BERTOL = 0 CALL MOVBIT( HEAD, 320, 8, BERTOL, 0) DSNCON = 0 CALL MOVBIT( HEAD, 328, 8, DSNCON, 0) RECAGC = 0 CALL MOVBIT( HEAD, 344, 8, RECAGC, 0) CALL MOVBIT( HEAD, 336, 8, RECAGC, 8) DSNNUM = 0 CALL MOVBIT( HEAD, 352, 8, DSNNUM, 0) EBEC = 0 CALL MOVBIT( HEAD, 376, 8, EBEC, 0) CALL MOVBIT( HEAD, 368, 8, EBEC, 8) SYMSNR = 0 CALL MOVBIT( HEAD, 392, 8, SYMSNR, 0) CALL MOVBIT( HEAD, 384, 8, SYMSNR, 8) DECSNR = 0 CALL MOVBIT( HEAD, 408, 8, DECSNR, 0) CALL MOVBIT( HEAD, 400, 8, DECSNR, 8) PHYSRN = 0 CALL MOVBIT( HEAD, 424, 8, PHYSRN, 0) CALL MOVBIT( HEAD, 416, 8, PHYSRN, 8) C C 8 BIT DATA QUALITY STATUS WORD//8 BIT DATA QUALITY INDICATOR C DO 10 I=1,10 J = (I-1) * 16 DQSW(I) = 0 CALL MOVBIT( HEAD, 432+J, 8, DQSW(I), 0) DQI(I) = 0 CALL MOVBIT( HEAD, 440+J, 8, DQI(I), 0) 10 CONTINUE C C UNPACK 4 BIT DATA PRESENCE INDICATORS (80 MF MAX) C CR-7 AND VIM-5 MODES C IF ( MODE(IMODE).NE.13 .AND. MODE(IMODE).NE.9 ) GOTO 20 DO I=1,40 J = (I-1) * 8 K = I*2 - 1 L = I*2 DPI(K) = 0 DPI(L) = 0 CALL MOVBIT( HEAD, 592+J, 4, DPI(L), 0) CALL MOVBIT( HEAD, 596+J, 4, DPI(K), 0) END DO 20 CONTINUE C C UNPACK 8 BIT DATA PRESENCE INDICATORS (150 MF MAX) C CR-1 THROUGH CR-6 MODES C IF ( MODE(IMODE).LT.1 .OR. MODE(IMODE).GT.6 ) GOTO 30 DO I=1,150 J = (I-1)*8 DPI(I) = 0 CALL MOVBIT( HEAD, 592+J, 8, DPI(I), 0) END DO 30 CONTINUE C C UNPACK 8 BIT DATA PRESENCE INDICATORS AND 8 BIT GOLAY CORRECTION C INDICATORS (80 MF MAX) C GS-3 MODE C IF ( MODE(IMODE).NE.0 ) GOTO 40 DO I=1,80 J = (I-1)*16 DPI(I) = 0 CALL MOVBIT( HEAD, 592+J, 8, DPI(I), 0) GCI(I) = 0 CALL MOVBIT( HEAD, 600+J, 8, GCI(I), 0) END DO 40 CONTINUE C C FIELDS GCI, DPIRIS, GPIRIS ARE NOT USED IN VIM-5 MODE. C THEREFORE BITS 892 - 1887 ARE SPARES. C DRSDAT = 0 CALL MOVBIT( HEAD, 1888, 8, DRSDAT, 0) GCBEC = 0 CALL MOVBIT( HEAD, 1896, 8, GCBEC, 0) GBITES = 0 CALL MOVBIT( HEAD, 1912, 8, GBITES, 0) CALL MOVBIT( HEAD, 1904, 8, GBITES, 8) C RETURN END ****************************************************************** SUBROUTINE CONSEC(SOH,TIME) C C CONVERT I*2 SECONDS OF HOUR INTO MINUTES AND SECONDS. C INTEGER*2 SOH,TIME(6) TIME(4) = INT(SOH/60.0) TIME(5) = NINT(((SOH/60.0)-TIME(4))*60.0) RETURN END ****************************************************************** SUBROUTINE CONHOUR(HOY,TIME) C C CONVERT I*2 HOUR OF YEAR INTO DAYS AND HOURS. C INTEGER*2 HOY,TIME(6) TIME(2) = INT(HOY/24.0) TIME(3) = NINT(((HOY/24.0)-TIME(2))*24.0) RETURN END ****************************************************************** SUBROUTINE GETTIME(TFLAG,SERTIME,EERTIME,SCETIME,EDRTIME) C C CONVERT EDR TIME TAGS TO CALENDAR UNITS C CHARACTER*4 TFLAG INTEGER*2 SERTIME(6),EERTIME(6),SCETIME(6),EDRTIME(6) C INCLUDE 'UNPACK.INC' C SERTIME(1) = YEAR1 CALL CONHOUR(ERTSHR,SERTIME) CALL CONSEC(ERTSSC,SERTIME) SERTIME(6) = ERTSML C EERTIME(1) = YEAR2 CALL CONHOUR(ERTEHR,EERTIME) CALL CONSEC(ERTESC,EERTIME) EERTIME(6) = ERTEML C SCETIME(1) = YEAR3 CALL CONHOUR(SCETHR,SCETIME) CALL CONSEC(SCETSC,SCETIME) SCETIME(6) = SCETML C C SELECT TIME TYPE FOR EDR TIME C IF (TFLAG.EQ.'ERTS') THEN DO I = 1,6 EDRTIME(I) = SERTIME(I) END DO ELSE IF (TFLAG.EQ.'ERTE') THEN DO I = 1,6 EDRTIME(I) = EERTIME(I) END DO ELSE IF (TFLAG.EQ.'SCET') THEN DO I = 1,6 EDRTIME(I) = SCETIME(I) END DO END IF C RETURN END ****************************************************************** C C ROUTINE TO EXTRACT N BITS FROM ARRAY DATA STARTING AT BIT POSITION IOFF C AND PLACE THESE BITS INTO WORD VAL STARTING AT BIT POSITION IBEG. C SUBROUTINE MOVBIT(DATA,POS,NBITS,VAL,IBEG) C C DATA INPUT DATA ARRAY C POS STARTING BIT POSISTION WITHIN ARRAY DATA (0 = FIRST BIT) C NBITS NUMBER OF BITS TO BE MOVED C VAL OUTPUT WORD C IBEG STARTING BIT FOR INSERTION OF COPIED BITS C INTEGER*4 VAL INTEGER*4 DATA(1),POS LOGICAL*4 IVAL C IWORD = INT(POS/32) + 1 IOFF = MOD(POS,32) DO I=0,NBITS-1 IVAL = BTEST(DATA(IWORD),IOFF+I) IF (IVAL) VAL = (IBSET(VAL,IBEG+I)) IF (.NOT.IVAL) VAL = (IBCLR(VAL,IBEG+I)) END DO C RETURN END INTEGER FUNCTION MODE(ISTAT) C C THIS FUNCTION IDENTIFIES THE APPROPRIATE TELEMETRY MODE FOR PROCESSING C C CR-1 = 1 C CR-2 = 2 C CR-3 = 3 C CR-4 = 4 C CR-5 = 5 C CR-6 = 6 C CR-7 = 9 C GS = 0 C ENG = 8 C VIM-5 = 13 C N/A = -1 C INCLUDE 'UNPACK.INC' C ISTAT = 0 C IF (DATMOD.EQ.0) MODE = 8 IF (DATMOD.EQ.1) MODE = 2 IF (DATMOD.EQ.2) MODE = 3 IF (DATMOD.EQ.3) MODE = 4 IF (DATMOD.EQ.4) MODE = 5 IF (DATMOD.EQ.5) MODE = 6 IF (DATMOD.EQ.6) MODE = 9 IF (DATMOD.EQ.7) MODE = 1 IF (DATMOD.EQ.8) MODE = -1 IF (DATMOD.EQ.9) MODE = -1 IF (DATMOD.EQ.10) MODE = 0 IF (DATMOD.EQ.11) MODE = -1 IF (DATMOD.EQ.12) MODE = 0 IF (DATMOD.EQ.13) MODE = -1 IF (DATMOD.EQ.14) MODE = 0 IF (DATMOD.EQ.15) MODE = 0 IF (DATMOD.EQ.16) MODE = -1 IF (DATMOD.EQ.17) MODE = -1 IF (DATMOD.EQ.18) MODE = -1 IF (DATMOD.EQ.19) MODE = -1 IF (DATMOD.EQ.20) MODE = -1 IF (DATMOD.EQ.21) MODE = -1 IF (DATMOD.EQ.22) MODE = 0 IF (DATMOD.EQ.23) MODE = 0 IF (DATMOD.EQ.24) MODE = 13 IF (DATMOD.EQ.25) MODE = -1 IF (DATMOD.EQ.26) MODE = 0 IF (DATMOD.EQ.27) MODE = -1 IF (DATMOD.EQ.28) MODE = -1 IF (DATMOD.EQ.29) MODE = 13 IF (DATMOD.EQ.30) MODE = -1 IF (DATMOD.EQ.31) MODE = -1 C IF (DATMOD.LT.0.OR.DATMOD.GT.31) THEN WRITE(6,*) WRITE(6,*) '***INVALID DATMOD VALUE***' ISTAT = 1 MODE = -1 END IF C C WRITE(6,*) 'DATMOD,MODE ',DATMOD,MODE C RETURN END C INTEGER *2 FUNCTION RLEN(ISTAT) C C THIS FUNCTION RETURNS THE EXPECTED RECORD LENGTH GIVEN RECORD ID AND C DATA MODE VALUES RETURNED FROM THE EDR HEADER BLOCK. C C GS = General Science mode telemetry format C OC = Occultation mode telemetry format C CR = Cruise mode telemetry format C VIM = Voyager Interstellar Mission mode telemetry format C INCLUDE 'UNPACK.INC' C ISTAT = 0 IF ( RECID.EQ.15 ) THEN RLEN = 716 ! Decommutation Map Record ELSE IF ( RECID.EQ.11 .OR. DATMOD.EQ.0 ) THEN RLEN = 3860 ! Engineering Record ELSE IF ( DATMOD.EQ.22 ) THEN RLEN = 6512 ! OC-2 ELSE IF ( DATMOD.EQ.23 ) THEN RLEN = 6512 ! OC-1 ELSE IF ( DATMOD.EQ.17 ) THEN RLEN = 6512 ! GS-2 ELSE IF ( DATMOD.EQ.10 ) THEN RLEN = 6512 ! GS-3 ELSE IF ( DATMOD.EQ.15 ) THEN RLEN = 6512 ! GS-4 ELSE IF ( DATMOD.EQ.14 ) THEN RLEN = 6512 ! GS-6 ELSE IF ( DATMOD.EQ.12 ) THEN RLEN = 6512 ! GS-7 ELSE IF ( DATMOD.EQ.26 ) THEN RLEN = 6512 ! GS-8 ELSE IF ( DATMOD.EQ.25 ) THEN RLEN = 6512 ! GS-10 ELSE IF ( DATMOD.EQ.7 ) THEN RLEN = 11280 ! CR-1 ELSE IF ( DATMOD.EQ.1 ) THEN RLEN = 6536 ! CR-2 ELSE IF ( DATMOD.EQ.2 ) THEN RLEN = 3704 ! CR-3 ELSE IF ( DATMOD.EQ.3 ) THEN RLEN = 3992 ! CR-4 ELSE IF ( DATMOD.EQ.4 ) THEN RLEN = 5848 ! CR-5 ELSE IF ( DATMOD.EQ.5 ) THEN RLEN = 6512 ! CR-6 ELSE IF ( DATMOD.EQ.24 ) THEN RLEN = 1712 ! VIM-5 (CR-5A) ELSE IF ( DATMOD.EQ.29 ) THEN RLEN = 1712 ! VIM-5 (UV-5A) ELSE RLEN = 240 ! header block length ISTAT = 1 ENDIF C RETURN END REAL*8 FUNCTION DECYEAR(EDRTIME) INTEGER*2 EDRTIME(6) INTEGER*4 LEAP IF ( MOD(EDRTIME(1),4) .EQ. 0 ) THEN LEAP = 366 ELSE LEAP = 365 END IF DECYEAR = (EDRTIME(2)+(EDRTIME(3)+EDRTIME(4)/60.0)/24.0)/LEAP DECYEAR = DECYEAR + (((EDRTIME(5)/60.0)/60)/24.0)/LEAP DECYEAR = DECYEAR + EDRTIME(1) RETURN END