      PROGRAM CRRESPLT
C     THIS PROGRAM WAS MODIFIED TO PERMIT EPHEMERIS PARAMETERS
C     OTHER THAN THE ONES ON THE MEA FILE TO BE LISTED
C     IT ALLOWS THE USER TO SELECT THE ENERGY SPECTRUM
C     THIS PROGRAM WAS LAST UPDATED ON 1-4-95
C     NADD ARE THE N EPHEMERIS PARAMETER ADDRESS (1 TO 60)
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
      INTEGER*2 NANGL,NSEPH,NEPHZ,NEAD(60),NORBIT
      INTEGER*2 INUNIT,OUTUNIT,IOPEN1,IOPEN7,IGEF,IBKGD
      INTEGER*4 HEDAT(30),ATITUD(128)
      CHARACTER*30 INFILE,OUTFILE
      CHARACTER*1 ANS,CSV(3)
      CHARACTER*10 PAR(60)
      DIMENSION AMEAS(18),AMEAVE(18),EPH(6),AEPH(6),ENGY(17)
      DIMENSION EFEM(60,250),AEFF(60)
C     THE EPHEMERIS PARAMETERS ARE L,B,B0,LONG, LAT,ALT
      DIMENSION COEF(18),PINNER(17),POUTER(17),DATHED(30)
      EQUIVALENCE(HEDAT,DATHED)
      DATA ENGY/148.,214.,272.,341.,417.,509.,604.,692.,782.,876.,976.,
     11090.,1178.,1288.,1368.,1472.,1581./
      DATA COEF/.332,.344,.379,.404,.426,.466,.502,.546,.592,
     1 .634,.676,.734,.784,.824,.876,.913,1.953,.962/
      DATA AMEAS/18*0./
C     BACKGROUND COEFFICIENTS

C     INNER ZONE  (CHECKED AT L=1.56, EQUATOR)
      DATA PINNER/5*.4,.55,.57,.73,.79,.95,1.04,1.22,1.15,1.16,1.31,
     1 1.43,1.58/

C      DATA PINNER/8*1.,1.01,1.1,1.16,1.27,1.22,1.22,1.32,1.4,1.49/
C     OUTER ZONE                     
      DATA POUTER/1.09,1.18,1.21,1.21,1.16,1.25,.8,.76,.82,.81,.9,.84,
     1 .86,.84,.85,.86,.94/
      DATA CSV/'C','S','V'/
C     THESE ARE THE PARAMETERS IN THE EPHEMERIS FILE
      DATA PAR/'JULIAN DAY','UT  msecs ','X  ECI  km','Y  ECI  km',
     1         'Z  ECI  km','Xdot  km/s','Ydot  km/s','Zdot  km/s',
     2         'Radius  km','Altitude  ','Latitude  ','Longitude ',
     3         'Vel  km/s ','LT  hours ','Radius Mag','Lat  Mag  ',
     4         'Long  Mag ','Radius  SM','Lat  SM   ','LT  SM    ',
     5         'Radius GSM','Lat  GSM  ','LT  GSM   ','B  nTesla ',
     6         'BX  ECI nT','BY  ECI nT','BZ  ECI nT','Mag LT hr ',
     7         'Solar Zen ','Invar Lat ','B100N Lat ','B100N Long',
     8         'B100S Lat ','B100S Long','L  EMR    ','Bmin  nT  ',
     9         'Bmin  Lat ','Bmin  Long','Bmin  Alt ','Bconj Lat ',
     9         'Bconj Long','Bconj Alt ','X Sun  ECI','Y Sun  ECI',
     1         'Z Sun  ECI','X Moon ECI','Y Moon ECI','Z Moon ECI',
     2         'Rt Asc GRW','B100N  nT ','B100S  nT ','My, Dipole',
     3         'My  Dipole','Mz  Dipole','Dx  Offset','Dy  Offset',
     4         'Dz  Offset','VACANT    ','VACANT    ','VACANT    '/
      THETMIN=0.
      THETMAX=180.
      INUNIT=1
      OUTUNIT=7
      MOUTS=0
      NOUTS=100
C     **********   OPEN THE INPUT FILE   ************
      CALL SYSTEM('CLS')
      WRITE(*,1)
1     FORMAT(//,24x,'CRRES MEA Data Stripout Program',///,' Floating-poi
     1nt MEA data file name?',/,' (Must have UT,MEA(18),PA, and 6 EPH pa
     2ram in INTEL floating-point in that order)',//)
      READ(*,7)INFILE
84    IF(IOPEN1.EQ.1)CLOSE(UNIT=INUNIT)
      iopen1=0
      OPEN(UNIT=INUNIT,FILE=INFILE,FORM='UNFORMATTED',STATUS='OLD',
     1 ACCESS='TRANSPARENT')
      IOPEN1=1
      PRINT*,' OPENED ',CHARNB(INFILE)
C      HERE WE HAVE TO STRIP OFF THE HEADER, EPHEMERIS, AND ATTITUDE RECORDS
      READ(UNIT=1,END=120)DATHED
C     AT THIS POINT WE HAVE STRIPPED OFF THE HEADER, EPHEMERIS, AND
C     ATTITUDE DATA FROM THE FRONT OF THE MEA FILE.  PRINT OUT SOME OF
C     THE HEADER DATA TO THE SCREEN:

      WRITE(*,1001)(HEDAT(I),I=1,6),(DATHED(J),J=7,9),(HEDAT(K),K=10,14)
1001  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.2,20X,'UT End of Data =   ',F9.2,/,
     4 ' UT First Perigee = ',F9.2,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(*,1002)(DATHED(J),J=15,22),HEDAT(23),DATHED(24),HEDAT(25),
     1 DATHED(26),HEDAT(27),DATHED(28)
1002   FORMAT(' Penumbra Start =   ',F9.3,20X,
     1 'Penumbra Stop =    ',F9.2,/,
     2 ' Umbra Start   =    ',F9.2,20X,'Umbra Stop    =    ',F9.2,/,
     3 ' Penumbra Start =   ',F9.2,20X,'Penumbra Stop =    ',F9.2,/,
     4 ' Umbra Start   =    ',F9.2,20X,'Umbra Stop    =    ',F9.2,/,
     5 ' VTCW',10X,'=     ',Z8,20X,'UT',12X,'=    ',F9.2,/,
     6 ' VTCW',10X,'=     ',Z8,20X,'UT',12X,'=    ',F9.2,/,
     7 ' VTCW',10X,'=     ',Z8,20X,'UT',12X,'=    ',F9.2,/)
      IF(HEDAT(2).EQ.1001)PRINT*,'THIS DATA FILE IS FOLDOVER CORRECTED'
      IF(HEDAT(2).NE.1001)THEN
         PRINT*,'This file is not fold-over corrected. Program ended.'
         STOP
      ENDIF
      NORBIT=HEDAT(3)
      DO 21 I=1,250
      READ(UNIT=1,END=120)(EFEM(K,I),K=1,60)
C      WRITE(*,6408)EFEM(2,I)
C6408  FORMAT(' UT= ',F10.3)
21    IF(EFEM(1,I).EQ.-99999.)GO TO 22
      PRINT*,' DID NOT FIND END OF EPHEMERIS DATA'
      PRINT*,' PROGRAM HALTED'
      STOP
22    PRINT*,' STRIPPED OFF EPHEMERIS DATA'
      DO 23 I=1,30
      READ(UNIT=1,END=120)ATITUD
23    IF(ATITUD(1).EQ.-9999)GO TO 5555
      PRINT*,' DID NOT FIND END OF ATTITUDE DATA'
      PRINT*,' PROGRAM HALTED'
      STOP
5555  PRINT*,' STRIPPED OFF THE ATTITUDE DATA'
C     **********   OPEN THE OUTPUT FILE   ************
5     IF(IOPEN7.EQ.1)GO TO 98
      WRITE(*,6)
6     FORMAT(' OUTPUT FILE NAME?',/)
      READ(*,7)OUTFILE
7     FORMAT(A)
777   CALL SUFIX(OUTFILE,CSV)
      OPEN(UNIT=OUTUNIT,FILE=OUTFILE,STATUS='NEW',FORM='FORMATTED')
      IOPEN7=1
C     **********   GET PROCESSING INFORMATION   ************
8     PRINT*,' NUMBER OF DATA SAMPLES TO AVERAGE ? (I3)   '
      READ(*,9)NSMPL
9     FORMAT(I3)
      NANGL=0
      IF(NORBIT.GT.50)THEN
          PRINT*,' DO YOU WANT A LIMITED ANGLE SPAN? (N,Y)  '
          READ(*,7)ANS
          IF(ANS.EQ.'y'.OR.ANS.EQ.'Y')NANGL=1
          IF(NANGL.EQ.0)GO TO 7339
          PRINT*,' MINIMUM ANGLE?   '
          READ*,THETMIN
          PRINT*,' MAXIMUM ANGLE?   '
          READ*,THETMAX
        ELSE
          PRINT*,'Pitch angle data is not available for this orbit.'
      ENDIF
7339  IBKGD=0
      IGEF=0
      PRINT*,'DO YOU WANT SIMPLE ERROR CHECKING? (Y,N)   '
      NROR=0
      READ(*,7)ANS
      IF(ANS.EQ.'Y'.OR.ANS.EQ.'y')NROR=1
      PRINT*,' DO YOU WANT A SIMPLE BACKGROUND CORRECTION? (Y,N)   '
      READ(*,7)ANS
      IF(ANS.EQ.'Y'.OR.ANS.EQ.'y')IBKGD=1
      PRINT*,' DO YOU WANT FLUXES (INSTEAD OF COUNTS)? (Y,N)   '
      READ(*,7)ANS
      IF(ANS.EQ.'N'.OR.ANS.EQ.'n')GO TO 7334
      IGEF=1
      PRINT*,'Enter spectral coefficient (flat spectrum = 0)  '
      READ(*,9)NEXP
      IF(NEXP.EQ.0.AND.ENGY(1).EQ.148.)GO TO 7334
      CALL MEAGEFS(ENGY,COEF,NEXP)
7334  PRINT*,' DO YOU WANT NON-STANDARD EPHEMERIS PARAMETERS? (Y,N)   '
      NSEPH=0
      READ(*,7)ANS
      IF(ANS.EQ.'n'.OR.ANS.EQ.'N')GO TO 98
      PRINT*,'Do you want a listing of the ephemeris parameters? (Y,N) '
      READ(*,7)ANS
      IF(ANS.EQ.'N'.OR.ANS.EQ.'n')GO TO 569
      WRITE(*,567)
567   FORMAT('  1 JULIAN DATE (DAYS)',17x,'25 BX, ECI, nT',/,'  2 UT, Mi
     1lliseconds',19x,'26 BY, ECI, nT',/,'  3 X, ECI, km',25x,'27 BZ, EC
     2I, nT',/,'  4 Y, ECI, km',25x,'28 Mag Local Time, hr',/,'  5 Z, EC
     3I, km',25x,'29 Solar Zenith Angle, Deg',/,'  6 VX, ECI, km/SEC',20
     4x,'30 Invariant Latitude, Deg',/,'  7 VY, ECI, km/SEC',20x,'31 B10
     50N latitude, Deg',/,'  8 VZ, ECI, km/SEC,'19x,'32 B100N longitude, 
     6Deg',/,'  9 RADIUS, EARTH CENTER TO SATELLITE, km',/,' 10 Altitude
     7, km',23x,'33 B100S latitude, Deg',/,' 11 Latitude, Deg',22x,'34 B
     8100S longitude, Deg',/,' 12 Longitude, Deg',21x,'35 L-shell, EMR',
     9/,' 13 Velocity, km/sec',19x,'36 Bmin, nT',/,' 14 Local Time, hr',
     121x,'37 Bmin Latitude, Deg',/,' 15 Radius, Mag, EMR (6371.2 km)',7
     2x,'38 Bmin Longitude, Deg',/,' 16 Latitude. Mag, Deg',17x,'39 Bmin 
     3Altitude, km',/,' 17 Longitude, Mag, Deg',16x,'40 Bconj Latitude, 
     4Deg',/,' 18 Radius, SM, EMR',20x,'41 Bconj Longitude, Deg',/,' 19 
     5Latitude, SM, Deg',18x'42 Bconj Altitude, km',/,' 20 Local Time, S
     6M, hr',17x,'43 X Sun Position, ECI, km',/,' 21 Radius, GSM, EMR',1
     79x,'44 Y Sun Position, ECI, km',/,' 22 Latitude, GSM, Deg',17x,'45 
     8 Z Sun Position, ECI, km',/,' 23 Local Time, GSM, hr',16x,'46 X Mo
     9on Position, ECI, km',/,' 24 B, nT',30x,'47 Y Moon Position, ECI, 
     1Km')
      PRINT*,'                         PRESS ANY KEY TO CONTINUE'
      READ(*,7)ANS
      WRITE(*,566)
566   FORMAT(1X,'48 Z Moon Position, ECI, km',11x,'53 My dipole moment, 
     1ECI, nT',/,' 49 Right Ascension Greenwich',10x,'54 Mz dipole momen
     2t, ECI, nT',/,' 50 B100N, nT',26x,'55 Dx dipole offset, ECI, nT',/
     3,' 51 B100S, nT',26x,'56 Dy dipole offset, ECI, nT',/,' 52 Mx dipo
     4le moment, ECI, nT',10x,'57 Dz dipole offset, ECI, nT',/,' 58-60 v
     5acant',//)
569   NSEPH=1
      PRINT*,'Number of non-standard ephemeris parameters?   '
      READ(*,9)NEPHZ
      DO 97 I=1,NEPHZ
      WRITE(*,570)I
570   FORMAT(' PARAMETER ',I2,' ---  ')
      READ(*,9)NEAD(I)
97    WRITE(*,571)I,NEAD(I),PAR(NEAD(I))
571   FORMAT('+PARAMETER ',I2,' ---  ',I2,'  ',A10)
98    MSAMPL=NSMPL/2
      TDELT=FLOAT(NSMPL)*0.512
      READ(UNIT=1,END=120)UT,AMEAS,PA,AEPH
      WRITE(*,2)UT
2     FORMAT(' FIRST TIME IS: UT= ',F10.0)
24    PRINT*,' START AND STOP TIMES? (2F7.0)   '
      READ(*,10)TSTRT,TSTP
10    FORMAT(2F7.0)
12    TSTRT=TSTRT-.255
      TSTP=TSTP+.255
      WRITE(*,13)TSTRT,TSTP
      IF(NSEPH.EQ.1.AND.NSMPL.EQ.1)WRITE(7,1557)ENGY,(PAR(NEAD(KJ)),
     1 KJ=1,NEPHZ)
1557  FORMAT('UT,',16(F5.0,','),'PROTONS,',F5.0,',PA,L,B,B0,ELONG,LAT,AL
     1T',60(',',A10))
      IF(NSEPH.EQ.1.AND.NSMPL.GT.1)WRITE(7,1558)ENGY,(PAR(NEAD(KJ)),
     2KJ=1,NEPHZ)
1558  FORMAT('UT,',16(F5.0,','),'PROTONS,',F5.0,',L,B,B0,ELONG,LAT,ALT',
     160(',',A10))
      IF(NSEPH.EQ.0.AND.NSMPL.EQ.1)WRITE(7,1559)ENGY
1559  FORMAT('UT,',16(F5.0,','),'PROTONS,',F5.0,',PA,L,B,B0,ELONG,LAT,AL
     1T')
      IF(NSEPH.EQ.0.AND.NSMPL.GT.1)WRITE(7,1560)ENGY
1560  FORMAT('UT,',16(F5.0,','),'PROTONS,',F5.0,',L,B,B0,ELONG,LAT,ALT')
      GO TO 501
13    FORMAT(' DATA FROM UT=',F7.0,' TO ',F7.0,' WILL BE PLOTTED')
50    READ(UNIT=1,END=120)UT,AMEAS,PA,AEPH
501   IF(UT.LT.TSTRT)GO TO 50
      IF(UT.GT.127000.)GO TO 50
      IF(NROR.EQ.0)GO TO 383
      IF(AMEAS(17).GT.20000.)GO TO 50
      IF(AMEAS(9).GT.20000..AND.AMEAS(12).LT.1000.)GO TO 50
      IF(AMEAS(17).LT.0.)GO TO 50
383   IF(NANGL.EQ.0)GO TO 384
      IF(PA.LT.THETMIN)GO TO 50
      IF(PA.GT.THETMAX)GO TO 50
384   IF(IBKGD.EQ.0)GO TO 662
        IF(AEPH(1).LT.2.5)CALL BKCOR(AMEAS,PINNER)
        IF(AEPH(1).GE.2.5)CALL BKCOR(AMEAS,POUTER)
662   IF(IGEF.EQ.0)GO TO 664
        DO 663 IH=1,18
663     AMEAS(IH)=AMEAS(IH)*COEF(IH)
664   IF(NSMPL.GT.1)GO TO 51
      IF(NSEPH.EQ.1)CALL GETEPH(UT,EFEM,AEFF,NEPHZ,NEAD)
      IF(NSEPH.EQ.1)WRITE(7,557)UT,AMEAS,PA,AEPH,(AEFF(KJ),KJ=1,NEPHZ)
      IF(NSEPH.EQ.0)WRITE(7,557)UT,AMEAS,PA,AEPH
557   FORMAT(F9.2,18(',',F10.2),',',F6.2,',',F7.4,2(',',F8.2),
     12(',',F7.2),',',F8.2,60(',',1PE11.3))
      PRINT*,' UT=',UT
      IF(UT.GT.TSTP)GO TO 100
      GO TO 50
51    IF(NSAMP.GT.0)GO TO 60
      UTFIRST=UT
      NSAMP=1
      DO 52 I=1,18
52    AMEAVE(I)=AMEAS(I)
      TSTOP=UT+TDELT-.256
      GO TO 50
60    DO 54 I=1,18
54    AMEAVE(I)=AMEAVE(I)+AMEAS(I)
      NSAMP=NSAMP+1
      IF(UT.GT.TSTOP)GO TO 55
      IF(NSAMP.GE.NSMPL)GO TO 55
      IF(NSAMP.NE.MSAMPL)GO TO 50
      IF(NSEPH.EQ.1)CALL GETEPH(UT,EFEM,AEFF,NEPHZ,NEAD)
      DO 5684 I=1,6
5684  EPH(I)=AEPH(I)
      GO TO 50
55    IF(NSAMP.LT.1)GO TO 50
      DIV=FLOAT(NSAMP)
64    DO 56 I=1,18
56    AMEAVE(I)=AMEAVE(I)/DIV
65    UT1=0.5*(UT+UTFIRST)
      IF(MSAMPL.GT.1)GO TO 85
      IF(NSEPH.EQ.1)WRITE(7,57)UT1,AMEAVE,AEPH,(AEFF(KJ),KJ=1,NEPHZ)
      IF(NSEPH.EQ.0)WRITE(7,57)UT1,AMEAVE,AEPH
      GO TO 86
85    IF(NSEPH.EQ.1)WRITE(7,57)UT1,AMEAVE,EPH,(AEFF(KJ),KJ=1,NEPHZ)
      IF(NSEPH.EQ.0)WRITE(7,57)UT1,AMEAVE,EPH
57    FORMAT(F7.0,18(',',F10.2),',',F7.4,2(',',F8.2),2(',',F7.2),',',
     1 F8.2,60(',',1PE11.3))
86    PRINT*,'UT= ',UT1
      MOUTS=MOUTS+1
      NOUTS=NOUTS+1
      IF(UT.GT.TSTP)GO TO 100
      TSTRT=UT-.25
      NSAMP=0
      DO 494 I=1,18
494   AMEAVE(I)=0.
      GO TO 51
100   WRITE(*,110)UT
110   FORMAT(' LAST TIME PROCESSED WAS UT=',F10.2,/,
     1' DO YOU WANT TO CONTINUE? (Y,N)   ')
      READ(*,7)ANS
      IF(ANS.EQ.'N'.OR.ANS.EQ.'n')GO TO 140
      PRINT*,' DO YOU WANT TO USE THE SAME OUTPUT FILE? (Y,N)   '
      READ(*,7)ANS
      IF(ANS.EQ.'Y'.OR.ANS.EQ.'y')GO TO 8
      CLOSE(OUTUNIT)
      IOPEN7=0
      GO TO 5
120   PRINT*,' END-OF-FILE ON DATA, PROCESSING COMPLETED'
      IF(NSAMP.EQ.0)GO TO 100
      DIV=FLOAT(NSAMP)
74    DO 75 I=1,18
75    AMEAVE(I)=AMEAVE(I)/DIV
      UT1=0.5*(UT+UTFIRST)
      WRITE(7,57)UT1,AMEAVE,EPH
      GO TO 100
140   IF(IOPEN1.EQ.1)CLOSE(INUNIT)
      IOPEN1=0
      IF(IOPEN7.EQ.1)CLOSE(OUTUNIT)
      IOPEN7=0
141   STOP
      END


      SUBROUTINE BKCOR(A,B)
      DIMENSION A(18),B(17)
      BK=A(17)
      DO 1 IH=1,16
1     A(IH)=A(IH)-BK*B(IH)
      A(18)=A(18)-BK*B(17)
      RETURN
      END



      SUBROUTINE SUFIX(NAME,SUF)
      CHARACTER*1 NAME(51),SUF(3),SUF1
      DATA SUF1/'.'/
      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)=SUF1
4     NAME(I+1)=SUF(1)
      NAME(I+2)=SUF(2)
      NAME(I+3)=SUF(3)
      RETURN
      END


      SUBROUTINE GETEPH(UT,ARRAY,APA,N,NADD)
      DIMENSION ARRAY(60,250),APA(60)
C     NADD ARE THE N EPHEMERIS PARAMETER ADDRESS (1 TO 60)
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
      INTEGER*2 INDX,NDX,N,IFLAG,NADD(60)
      DATA INDX,IFLAG/2,0/
      IF(IFLAG.EQ.1)RETURN
1     NDX=INDX
      IF(ARRAY(1,NDX).EQ.-99999.)GO TO 120
5     DO 100 J=NDX,250
      IF(ARRAY(1,J).EQ.-99999.)GO TO 120
      IF(UT.GT.ARRAY(2,J))GO TO 95
      TDEL=ARRAY(2,J)-ARRAY(2,J-1)
      TPART1=(UT-ARRAY(2,J-1))/TDEL
      DO 90 I=1,N
      II=NADD(I)
90    APA(I)=ARRAY(II,J-1)+TPART1*(ARRAY(II,J)-ARRAY(II,J-1))
      RETURN
95    INDX=INDX+1
100   CONTINUE
120   WRITE(*,121)
121   FORMAT(' EPHEMERIS FILE EXHAUSTED')
      DO 200 I=1,N
200   APA(I)=0.
      IFLAG=1
      INDX=250
      RETURN
      END

      SUBROUTINE MEAGEFS(E,G,N)
C     THIS PROGRAM READS IN THE ENERGY AND GEFS FOR THE CRRES MEA
C     USING THE MEAGEFS FILE
      DIMENSION ENGY(17,9),GEFS(17,9),E(17),G(17)
      INTEGER*2 INUNIT,NCH,N,IENTER
      LOGICAL*1 EXST
      CHARACTER*18 TITLE
      CHARACTER*19 GEFILE
      DATA GEFILE/'GEFDATA'/
      DATA IENTER/0/
      IF(IENTER.NE.0)GO TO 2000
      IENTER=1
998   INQUIRE(FILE=GEFILE,EXIST=EXST)
      IF(EXST)GO TO 1000
      PRINT*,'ENTER THE PATH AND NAME OF THE MEA GEF-ENERGY FILE'
      READ(*,999)GEFILE
      GO TO 998
999   FORMAT(A)
1000   INUNIT=11
      OPEN(UNIT=INUNIT,FILE=GEFILE,FORM='FORMATTED',STATUS='OLD')
      READ(11,1)TITLE
1     FORMAT(A18)
      PRINT*,'READING ',TITLE
      DO 10 I=1,17
      READ(11,2)NCH
2     FORMAT(2X,I2)
      PRINT*,'CHANNEL ',NCH
      DO 10 J=1,9
      READ(11,3)ENGY(I,J),GEFS(I,J)
3     FORMAT(F7.2,2X,E8.3)
10    CONTINUE
      CLOSE(UNIT=11)
2000  IF(N.LT.0)N=-N
      IF(N.GT.8)N=8
      K=9-N
      DO 2100 J=1,13
      E(J)=ENGY(J,K)
2100  G(J)=1./(.512*GEFS(J,K))
      RETURN
      END


