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