      PROGRAM EPHEMER
C     THIS PROGRAM STRIPS OUT AND DISPLAYS DATA FROM THE CRRES HEADER
C     AND EPHEMERIS FILES 
C     LAST UPDATE 10-8-92
      INTEGER*2 ICONV,PRSCR,PRFLE,JPAUZ,NHED,NEPH,IOPEN1,IOPEN3,IOPEN4
      INTEGER*4 KTIM1,KTIM2,IHDR(60)
      DIMENSION EPHM(60),DATHED(28)
C     IHDR HOLDS THE HEADER RECORD FROM ONE ORBIT OF DATA, EPHM HOLDS 
C     ONE SET OF PACKED EPHEMERIS DATA (1 OR 5 MINUTE INTERVALS)
C     WE DON'T REALLY NEED THESE FOR THE DPU57 STRIPOUT
      CHARACTER*30 EPHFIL,HEDFIL,DATFIL,FILNAM
      CHARACTER*1 ANS
      CHARACTER*3 CSV,EPH,HED,BIN
      DATA CSV,EPH,HED,BIN/'CSV','EPH','HED','BIN'/

C     FILE CONVENTIONS:
C     UNIT 1     EPHEMERIS
C     UNIT 3     OUTPUT DATA FILE
C     UNIT 4     HEADER FILE

      DATA NEPH,NHED/1,4/
      CALL TIMER(KTIM1)                      !FOR TIMING PURPOSES


      VER=1.01
      WRITE(*,1000)VER
1000  FORMAT(///,25X,'CRRES EPHEMERIS PROGRAM VER. ',F4.2,///)

      print*,' This version of ephemer requires EORs in th .EPH file'
C     OPEN THE FILES
C     GET THE INPUT DATA FILE NAME
      IOPEN1=0
      IOPEN3=0
      IOPEN4=0
      PRINT*,' INPUT FILE NAME?   '
      READ(*,1004)FILNAM
1004  FORMAT(A)
C     GET THE HEADER FILE
      HEDFIL=FILNAM
      CALL SUFIX(HEDFIL,HED)
      CALLOPENOLD(HEDFIL,NHED,IOPEN4)
      IF(IOPEN4.EQ.1)CALL READHED(NHED,DATHED,IOPEN4)

C     GET THE EPHEMERIS FILE
      EPHFIL=FILNAM
      CALL SUFIX(EPHFIL,EPH)
      CALLOPENOLD(EPHFIL,NEPH,IOPEN1)
      ATIME=-1.
      BTIME=150000.

C     GET THE OUTPUT DATA FILE NAME
150   PRINT*,' WRITE OUTPUT TO THE SCREEN (1), FILE (2), OR BOTH (3)   '
      READ(*,1011)ICONV
      PRSCR=0
      PRFLE=0
      JPAUZ=1
      IF(ICONV.LT.1.OR.ICONV.GT.3.)GO TO 150
      IF(ICONV.EQ.1)PRSCR=1
      IF(ICONV.GE.2)PRFLE=1
      IF(ICONV.EQ.2)JPAUZ=2
      IF(ICONV.EQ.3)PRSCR=1
      IF(PRSCR.EQ.1)PRINT,' PAUSE DISPLAY BETWEEN FRAMES? (YES=1,NO=2) '
1011  FORMAT(I1)
      IF(PRSCR.EQ.1)READ(*,1011)JPAUZ
      IF(PRFLE.EQ.0)GO TO 1029
      PRINT*,' DO YOU WANT THE PLOT FORMAT FILE? (Y,N)   '
      CALL PAUZ(ANS)
      IF(ANS.EQ.'Y'.OR.ANS.EQ.'y')PRFLE=2
      PRINT*,' OUTPUT FILE NAME?   '
      READ(*,1004)DATFIL
      IF(PRFLE.EQ.2)THEN
        CALLSUFIX(DATFIL,CSV)
        OPEN(UNIT=3,FILE=DATFIL,STATUS='NEW',FORM='FORMATTED')
      ELSE
        CALL SUFIX(DATFIL,BIN)
        OPEN(UNIT=3,FILE=DATFIL,STATUS='NEW',FORM='UNFORMATTED')
      ENDIF
      IOPEN3=1

1029  IPAUSE=0
      IF(PRSCR.EQ.0)WRITE(*,1988)
1988  FORMAT(3X,'UT      ALT    LAT   LONG     B      L     B0',/)
1     CALL READEPH(IHDR,ATIME,BTIME,EPHM,IFLG)
      IF(IFLG.EQ.1)GO TO 50
      IF(EPHM(12).LT.0.)EPHM(12)=EPHM(12)+360.
      IF(PRSCR.EQ.1)WRITE(*,2)EPHM(2),EPHM(10),EPHM(11),EPHM(12),
     1 EPHM(24),EPHM(35),EPHM(36)
      IF(PRSCR.EQ.0)WRITE(*,222)EPHM(2),EPHM(10),EPHM(11),EPHM(12),
     1 EPHM(24),EPHM(35),EPHM(36)
2     FORMAT(1X,F7.0,1X,F6.0,1X,F6.2,1X,F6.2,1X,F7.1,1X,F5.2,1X,F7.1)
222   FORMAT('+',F7.0,1X,F6.0,1X,F6.2,1X,F6.2,1X,F7.1,1X,F5.2,1X,F7.1)

      IF(JPAUZ.EQ.2)GO TO 17
      IPAUSE=IPAUSE+1
      IF (IPAUSE.LT.20)GO TO 17
      CALL PAUZ(ANS)
      IPAUSE=0
17    IF(PRFLE.EQ.2)WRITE(3,3)EPHM(2),EPHM(10),EPHM(11),EPHM(12),
     1 EPHM(24),EPHM(35),EPHM(36)
3     FORMAT(F7.0,',',F6.0,',',F6.2,',',F6.2,',',F7.1,',',F5.2,',',F7.1)
      IF(PRFLE.EQ.1)WRITE(3)EPHM(1),EPHM(2),EPHM(10),EPHM(11),EPHM(12),
     1 EPHM(14),EPHM(24),EPHM(28),EPHM(30),EPHM(35),EPHM(36)
      GO TO 1
50    WRITE(*,1012)
1012  FORMAT(' JOB COMPLETED')
70    CALL TIMER(KTIM2)
      TME=.01*FLOAT(KTIM2-KTIM1)
      PRINT*,' ELAPSED TIME = ',TME
      IF(IOPEN1.EQ.1)CLOSE(UNIT=1)
      IF(IOPEN3.EQ.1)CLOSE(UNIT=3)
      IF(IOPEN4.EQ.1)CLOSE(UNIT=4)
      STOP
      END


      SUBROUTINE SWAP4(IN,IOUT)
      LOGICAL*1 IN(4),IOUT(4)
      IOUT(1)=IN(4)
      IOUT(2)=IN(3)
      IOUT(3)=IN(2)
      IOUT(4)=IN(1)
      RETURN
      ENTRY SWAP2
      IOUT(1)=IN(2)
      IOUT(2)=IN(1)
      RETURN
      END


      SUBROUTINE PAUZ(ANS)
      CHARACTER*1 ANS
      READ(*,1)ANS
1     FORMAT(A)
      RETURN
      END


      SUBROUTINE SUFIX(NAME,INC)
      CHARACTER*1 NAME(51),INC(3),INC1
      DATA INC1/'.'/
      DO 1 I=1,51
      IF(NAME(I).EQ.'.')GOTO4
1     IF(NAME(I).EQ.' ')GOTO3
      WRITE(*,2)NAME
2     FORMAT(' ***** ERROR ***** ERROR ***** ERROR *****',//,
     1 A,//,' exceeds the limit on file names (50 characters)')
      STOP
3     NAME(I)=INC1
4     NAME(I+1)=INC(1)
      NAME(I+2)=INC(2)
      NAME(I+3)=INC(3)
      RETURN
      END


      SUBROUTINE READEPH(JATA,T1,T2,DATA,IFLAG)
      INTEGER*4 JATA(60),ICON,ITMP
      INTEGER*2 IFLAG,INDFYL,IEOR
      DIMENSION DATA(60),FACTOR(60)
      DATA INDFYL/0/
      DATA FACTOR/1.,.001,3*.0001,3*1.E-7,2*.0001,2*1.0E-6,
     1 3*1.E-7,2*1.E-6,1.E-7,1.E-6,2*1.E-7,1.E-6,1.E-7,4*.0001,
     2 1.E-7,6*1.E-6,1.E-7,.0001,2*1.E-6,.0001,2*1.E-6,.0001,6*1.,
     3 1.E-6,8*.0001,3*1./
C     1 JULIAN DATE (DAYS)
C     2 UT, Milliseconds
C     3 X, ECI, km
C     4 Y, ECI, km
C     5 Z, ECI, km
C     6 VX, ECI, km/SEC
C     7 VY, ECI, km/SEC
C     8 VZ, ECI, km/SEC
C     9 RADIUS, EARTH CENTER TO SATELLITE, km
C    10 Altitude, km
C    11 Latitude, Deg
C    12 Longitude, Deg
C    13 Velocity, km/sec
C    14 Local Time, hr
C    15 Radius, Mag, EMR (6371.2 km)
C    16 Latitude. Mag, Deg
C    17 Longitude, Mag, Deg
C    18 Radius, SM, EMR
C    19 Latitude, SM, Deg
C    20 Local Time, SM, hr
C    21 Radius, GSM, EMR
C    22 Latitude, GSM, Deg
C    23 Local Time, GSM, hr
C    24 B, nT
C    25 BX, ECI, nT
C    26 BY, ECI, nT
C    27 BZ, ECI, nT
C    28 Mag Local Time, hr
C    29 Solar Zenith Angle, Deg
C    30 Invariant Latitude, Deg
C    31 B100N latitude, Deg
C    32 B100N longitude, Deg
C    33 B100S latitude, Deg
C    34 B100S longitude, Deg
C    35 L-shell, EMR
C    36 Bmin, nT
C    37 Bmin Latitude, Deg
C    38 Bmin Longitude, Deg
C    39 Bmin Altitude, km
C    40 Bconj Latitude, Deg
C    41 Bconj Longitude, Deg
C    42 Bconj Altitude, km
C    43 X Sun Position, ECI, km
C    44 Y Sun Position, ECI, km
C    45 Z Sun Position, ECI, km
C    46 X Moon Position, ECI, km
C    47 Y Moon Position, ECI, km
C    48 Z Moon Position, ECI, km
C    49 Right Ascension of Greenwich
C    50 B100N, nT
C    51 B100S, nT
C    52 Mx dipole moment, ECI, nT
C    53 My dipole moment, ECI, nT
C    54 Mz dipole moment, ECI, nT
C    55 Dx dipole offset, ECI, nT
C    56 Dy dipole offset, ECI, nT
C    57 Dz dipole offset, ECI, nT
C    58 Vacant
C    59 Vacant
C    60 Vacant
C    

      IF(INDFYL.EQ.1.AND.IFLAG.EQ.1)RETURN
      ICON=2**30
      IFLAG=0
1     READ(UNIT=1,END=1000)JATA
      READ(UNIT=1,END=1000)IEOR
      CALL SWAP4(JATA(2),ITMP)
      TIME=.001*FLOAT(ITMP-ICON)
      IF(TIME.LT.(T1-60.))GO TO 1
      IF(TIME.GT.(T2+300.))RETURN
      DO 2 I=1,57
      CALL SWAP4(JATA(I),ITMP)
2     DATA(I)=FLOAT(ITMP-ICON)*FACTOR(I)
      RETURN
1000  WRITE(*,1001)
1001  FORMAT(' HIT THE END OF THE EPHEMERIS FILE',/,
     1 ' PROCESSING OF EPHEMERIS STOPPED')
      IFLAG=1
      INDFYL=1
      RETURN
      END

      SUBROUTINE OPENOLD(FILNAM,NUNIT,NOPEN)
      CHARACTER*30 FILNAM
      CHARACTER*1 ANS
      INTEGER*2 NUNIT,NOPEN
      INTEGER*4 LEN,NLEN
      LOGICAL OPEND,EXST
1     INQUIRE(FILE=FILNAM,EXIST=EXST,OPENED=OPEND)
      IF(EXST)GOTO5
      NOPEN=0
      WRITE(*,2)CHARNB(FILNAM)
2     FORMAT(' FILE ',A,' DOES NOT EXIST',/,' DO YOU NEED IT? (Y,N)')
      CALL PAUZ(ANS)
      IF(ANS.EQ.'N'.OR.ANS.EQ.'n')RETURN
      WRITE(*,3)
3     FORMAT(' ENTER FILE NAME, INCLUDING FULL PATH',/)
      READ(*,4)FILNAM
4     FORMAT(A)
      GO TO 1
5     IF(OPEND)GO TO 6
      OPEN (UNIT=NUNIT,FILE=FILNAM,STATUS='OLD',ACCESS='TRANSPARENT',
     1 FORM='UNFORMATTED')
      NOPEN=1
C     GET THE FILE LENGTH IN BYTES
6     INQUIRE(FILE=FILNAM,FLEN=LEN)
      NLEN=LEN/512
      WRITE(*,7)CHARNB(FILNAM),LEN,NLEN
7     FORMAT(' FILE ',A,' IS ',I8,' BYTES (',I5,'+ SECTORS) LONG')
      RETURN
      END

      SUBROUTINE READHED(NHED,DATHED,IOPEN)
      INTEGER*2 IOPEN,NHED
      INTEGER*4 JATA(30)
      LOGICAL*1 KATA(120)
      DIMENSION DATHED(28)
      IF(IOPEN.EQ.0)RETURN
5     READ(UNIT=NHED,END=1000)KATA
      IGG=1
      DO 20 IG=1,30
      CALL SWAP4(KATA(IGG),JATA(IG))
20    IGG=IGG+4
      DO 21 I=1,28
21    DATHED(I)=FLOAT(JATA(I))
      DATHED(7)=.001*DATHED(7)
      DATHED(8)=.001*DATHED(8)
      DATHED(9)=.001*DATHED(9)
      DATHED(15)=.001*DATHED(15)
      DATHED(16)=.001*DATHED(16)
      DATHED(17)=.001*DATHED(17)
      DATHED(18)=.001*DATHED(18)
      DATHED(19)=.001*DATHED(19)
      DATHED(20)=.001*DATHED(20)
      DATHED(21)=.001*DATHED(21)
      DATHED(22)=.001*DATHED(22)
      DATHED(24)=.001*DATHED(24)
      DATHED(26)=.001*DATHED(26)
      DATHED(28)=.001*DATHED(28)
C
      WRITE(*,100)(JATA(I),I=1,6),(DATHED(J),J=7,9),(JATA(K),K=10,14)
100   FORMAT(' Vehicle ID    =    ',I9,20X,'Experiment ID =    ',I9,/,
     1 ' Orbit Number  =    ',I9,20X,'Julian Date   =    ',I9,/,
     2 ' Year          =    ',I9,20X,'Day of Year   =    ',I9,/,
     3 ' UT Start of Data = ',F9.3,20X,'UT End of Data =   ',F9.3,/,
     4 ' UT First Perigee = ',F9.3,20X,'VTCW at Start =     ',Z8,/,
     5 ' VTCW at End   =     ',Z8,20X,'Agency Tape Date = ',I9,/,
     6 ' Missing Maj Frames ',I9,20X,'Filled Minor Frms  ',I9,/)

      WRITE(*,101)(DATHED(J),J=15,22),JATA(23),DATHED(24),JATA(25),
     1 DATHED(26),JATA(27),DATHED(28)
101   FORMAT(' Penumbra Start =   ',F9.3,20X,
     1 'Penumbra Stop =    ',F9.3,/,
     2 ' Umbra Start   =    ',F9.3,20X,'Umbra Stop    =    ',F9.3,/,
     3 ' Penumbra Start =   ',F9.3,20X,'Penumbra Stop =    ',F9.3,/,
     4 ' Umbra Start   =    ',F9.3,20X,'Umbra Stop    =    ',F9.3,/,
     5 ' VTCW',10X,'=     ',Z8,20X,'UT',12X,'=    ',F9.3,/,
     6 ' VTCW',10X,'=     ',Z8,20X,'UT',12X,'=    ',F9.3,/,
     7 ' VTCW',10X,'=     ',Z8,20X,'UT',12X,'=    ',F9.3,/)
      GO TO 1001
1000  PRINT*,' ERROR IN READING THE HEADER FILE'
1001  IOPEN=0
      CLOSE(UNIT=NHED)
      RETURN
      END

