      SUBROUTINE SDREAD(JREC,NBF,NECN,NBYT,*,*)                         00001000
C**** THIS SUBROUTINE SUBSTITUTES FOR:                                  00002000
C****     CALL FREAD(JREC(1,NBF),DDNM,NBYT,LCIO,&91,&92)                00003000
C**** IF JUPITER NAVIGATION RECORDS ARE ENCOUNTERED THEY ARE            00004000
C**** SPLIT IN HALF AND THE SECOND HALF OF EACH IS STORED:              00005000
C****   NBF   STORED IN                                                 00006000
C****    1    JREC(1-126,5)                                             00007000
C****    3    JREC(1-126,6)                                             00008000
C**** A FLAG IS SET IN NECN TO INDICATE THE TYPE OF RECORD:             00009000
C****       -2    BAD RECORD                                            00010000
C****       -1    UNDEFINED AREA                                        00011000
C****        0    HEADER RECORD                                         00012000
C****       +1    CRUISE NAVIGATION OR PV RECORD                        00013000
C****       +2    JUPITER NAVIGATION RECORD                             00014000
      INTEGER*4 KREC(126,3),JREC(126,6),LCIO/0/                         00015000
      REAL*8 DDNM/'SEDRLIST'/                                           00016000
      LOGICAL*1 NOREAD/.FALSE./,AGAIN/.FALSE./                          00017000
      INTEGER*4 ZERO(126)/126*0/                                        00018000
      IF (NOREAD) GO TO 51                                              00019000
      CALL FREAD(KREC(1,1),DDNM,NBYT,LCIO,&91,&92)                      00020000
      IF (NBYT.EQ.180)  GO TO 11                                        00021000
      IF (NBYT.EQ.1008)  GO TO 21                                       00022000
      IF (NBYT.EQ.1512)  GO TO 31                                       00023000
      NECN = -2                                                         00024000
      RETURN                                                            00025000
   11 CALL FMOVE(JREC(1,NBF),180,KREC(1,1))                             00026000
      NECN = 0                                                          00027000
      RETURN                                                            00028000
   21 CALL FMOVE(JREC(1,NBF),1008,KREC(1,1))                            00029000
      NECN = +1                                                         00030000
      RETURN                                                            00031000
   31 CONTINUE                                                          00032000
      IF (KREC(101,1) .EQ. 0) GO TO 21                                  00033000
      IF (KREC(101,1) .EQ. 1) GO TO 41                                  00034000
      CALL FMOVE(JREC(1,NBF),504,KREC(1,1))                             00035000
      CALL FMOVE(JREC(1,NBF+1),504,KREC(1,3))                           00036000
      CALL FMOVE(JREC(1,(NBF+9)/2),504,KREC(1,2))                       00037000
      NECN = +2                                                         00038000
      RETURN                                                            00039000
   41 CONTINUE                                                          00040000
      IF (KREC(101,2) .EQ. 0) GO TO 21                                  00041000
      NOREAD = .TRUE.                                                   00042000
      GO TO 21                                                          00043000
   51 CONTINUE                                                          00044000
      IF (.NOT. AGAIN) GO TO 52                                         00045000
      CALL FMOVE (JREC(1,NBF),1008,KREC(1,2))                           00046000
      AGAIN = .FALSE.                                                   00047000
      NOREAD = .FALSE.                                                  00048000
      NECN = +1                                                         00049000
      RETURN                                                            00050000
   52 IF (KREC(101,3) .EQ. 0) GO TO 55                                  00051000
      CALL FMOVE (JREC(1,NBF),504,KREC(1,3))                            00052000
      CALL FREAD (KREC(1,1),DDNM,NBYT,LCIO,&91,&92)                     00053000
      CALL FMOVE(JREC(127,NBF),504,KREC(1,1))                           00054000
      NECN = +1                                                         00055000
      IF (KREC(101,1) .EQ. 0) GO TO 53                                  00056000
      AGAIN = .TRUE.                                                    00057000
      RETURN                                                            00058000
   53 CONTINUE                                                          00059000
      NOREAD = .FALSE.                                                  00060000
      RETURN                                                            00061000
   55 CONTINUE                                                          00062000
      CALL FMOVE (JREC(1,NBF),504,KREC(1,3))                            00063000
      CALL FMOVE (JREC(127,NBF),504,ZERO)                               00064000
      NECN = +1                                                         00065000
      NOREAD = .FALSE.                                                  00066000
      RETURN                                                            00067000
   91 RETURN 1                                                          00068000
   92 RETURN 2                                                          00069000
      END                                                               00070000
      SUBROUTINE SEDR                                                   00010000
     .   (GMT,TIME,DUR,AUXM,BUXM,EANG,ERANGE,ESPV,ROT,TP,TN)            00010000
C-----------------------------------------------------------------------00020001
C U2ADS.SEDR       19-SEP-80  ALLAN SILVER                              00030001
C 85SEP16 JAJONES  SAR   UPDATED FOR URANUS U1 COORDINATES.             00040002
C 86APR19 JAJONES  SAR   INTERPOLAT S/C POSITION.                       00040002
C 89AUG07 JAJONES  STX   UPDATED FOR NEPTUNE N1 COORDINATES.            00040002
C INPUT: TIME=EPIC DAY, DUR=DURATION IN SECONDS                         00050001
C-----------------------------------------------------------------------00060001
C  AUXM=   M           :FOR HG COORDS:                                  00070001
C          THETA,BETA                                                   00080001
C  AUXM=  S            :FOR S3, L1, U1, OR N1 COORDS:                   00090002
C           2                                                           00100001
C  AUXM=   0           :FOR PL COORDS:                                  00110001
C-----------------------------------------------------------------------00120000
C  BUXM= M             :FOR HG COORDS:                                  00130001
C         THETA,BETA,5                                                  00140001
C         T    T                                                        00150001
C  BUXM= S S PA        :FOR S3, L1, U1, OR N1 COORDS:                   00160002
C         2 1                                                           00170001
C  BUXM= O             :FOR PL COORDS:                                  00180001
C-----------------------------------------------------------------------00190001
C  ANG= LONGITUDE(BETA) & LATITUDE(THT) :FOR HG COORDS:                 00200001
C  ANG= WORDS(76,77)                    :FOR L1 COORDS:                 00210001
C  ANG= WORDS(157,159)                  :FOR S3 COORDS:                 00220000
C  ANG= WORDS(139,140)                  :FOR U1 COORDS:                 00230002
C  ANG= WORDS(139,140)                  :FOR N1 COORDS:                 00230002
C  ANG= 0                               :FOR PL COORDS:                 00240001
C-----------------------------------------------------------------------00250001
C  RANGE= SUN TO S/C IN SOLAR RADII       :FOR HG COORDS:               00260001
C  RANGE= SATURN  TO S/C IN SATURN  RADII :FOR L1 COORDS:               00270001
C  RANGE= JUPITER TO S/C IN JUPITER RADII :FOR S3 COORDS:               00280001
C  RANGE= URANUS  TO S/C IN URANUS  RADII :FOR U1 COORDS:               00290002
C  RANGE= NEPTUNE TO S/C IN NEPTUNE RADII :FOR N1 COORDS:               00290002
C  RANGE= 0                               :FOR PL COORDS:               00300001
C-----------------------------------------------------------------------00310001
C  SPV= S/C POSITION(1-3) & VELOCITY(4-6)                               00320001
C            SUN CENTERED                      :FOR HG COORDS:          00330001
C            SATURN  CENTERED                  :FOR L1 COORDS:          00340000
C            JUPITER CENTERED                  :FOR S3 COORDS:          00350001
C            URANUS  CENTERED                  :FOR U1 COORDS:          00360002
C            NEPTUNE CENTERED                  :FOR N1 COORDS:          00360002
C  SPV= 0                                      :FOR PL COORDS:          00370001
C-----------------------------------------------------------------------00380001
C  ROT= HG ROTATION MATRIX :FOR HG COORDS: (LINEAR INTERP IN PV)        00390001
C  ROT= L1 ROTATION MATRIX :FOR L1 COORDS: (LINEAR INTERP IN NAV)       00400001
C  ROT= S3 ROTATION MATRIX :FOR S3 COORDS: (LINEAR INTERP IN NAV)       00410001
C  ROT= U1 ROTATION MATRIX :FOR U1 COORDS: (LINEAR INTERP IN NAV)       00420002
C  ROT= N1 ROTATION MATRIX :FOR N1 COORDS: (LINEAR INTERP IN NAV)       00420002
C           T                                                           00430001
C     = S PA            (L1, S3, U1, AND N1)                            00440002
C        1                                                              00450001
C  ROT= IDENTITY MATRIX    :FOR PL COORDS:                              00460000
C-----------------------------------------------------------------------00470001
C  TP= EPIC DAY OF POINTING BLOCK                                       00480001
C  TN= EPIC DAY OF NAVIGATION BLOCK                                     00490001
C-----------------------------------------------------------------------00500001
C  ICOORD= 1   PL COORDS               ICOORD= 2   HG COORDS            00510001
C  ICOORD= 3   L1 COORDS               ICOORD= 4   S3 COORDS            00520001
C  ICOORD= 5   U1 COORDS               ICOORD= 6   N1 COORDS            00530002
C-----------------------------------------------------------------------00540001
      LOGICAL*1 MAGIC(32)                                               00550001
      INTEGER*2 GMT(6),IDTAP(568)                                       00560001
      INTEGER*4 JREC(126,6),PMAT1(9),PMAT2(9)                           00570001
      REAL*4 WORK(500),SPV(6),ROT(3,3),DUR,AUXM(3,3),BUXM(3,3),TPEZ(3,3)00580001
      REAL*4 ANG(2),QAUXM(3,3),QBUXM(3,3),QANG(2),QSPV(6),BUXM2(3,3)    00590001
C----- 86-APR-19 (JAJ) -------------------------------------------------        
      REAL*4 EANG(2),SANG(2), ERANGE,SRANGE, ESPV(6),SSPV(6)            00590001
C-----------------------------------------------------------------------        
      REAL*4 QROT1(3,3),QROT2(3,3),BUXM1(3,3)                           00600000
      REAL*4 TZER(9)/9*0.E0/,TIDEN(9)/1.E0,3*0.E0,1.E0,3*0.E0,1.E0/     00610001
      REAL*8 TP1,TP2,SNT,T1,T2,TIME,T,TP,TN,T1S/-1.D0/,TNS/-1.D0/       00620001
      LOGICAL*4 NFST/.FALSE./                                           00630001
      EQUIVALENCE (WORK(9),MAGIC(1)),(WORK(61),ICOORD)                  00640001
      COMMON /CCA/ WORK                                                 00650001
C-----------------------------------------------------------------------00660001
C-----------------------------------------------------------------------00670001
      IF (NFST)  GO TO 10                                               00680001
C**** INITIALIZE SEDR BLOCKS.                                           00690001
      NFST = .TRUE.                                                     00700001
      CALL SEDRIN (JREC)                                                00710001
C**** COMPUTE TIME AND GET CORRESPONDING SEDR BLOCKS.                   00720000
   10 T = TIME + .5D0*DUR/86400.D0                                      00730001
      GO TO (59,52,54,54,54,54,99),ICOORD                               00740002
   99 WRITE (6,2002) ICOORD                                             00750001
 2002 FORMAT (' SEDR ERROR: REQUEST FOR COORDINATE SYSTEM #',I5)        00760001
      STOP                                                              00770001
C-----------------------------------------------------------------------00780001
C                   PL COORDINATES                                      00790001
C-----------------------------------------------------------------------00800001
   59 RANGE = 0.E0                                                      00810001
      ANG(1) = 0.E0                                                     00820000
      ANG(2) = 0.E0                                                     00830001
      CALL FMOVE (SPV,24,TZER)                                          00840001
      CALL FMOVE (AUXM,36,TZER)                                         00850001
      CALL FMOVE (BUXM,36,TZER)                                         00860001
      CALL FMOVE (ROT,36,TIDEN)                                         00870001
      CALL FMOVE (WORK(66),36,ROT)                                      00880001
      IF (MAGIC(5).AND.TN.NE.TNS) CALL SEDRDT (JREC,MN,0,11,TN,IDTAP)   00890001
      IF (MAGIC(5).AND.T1.NE.T1S) CALL SEDRDT (JREC,4,0,12,T1,IDTAP)    00900001
      TNS = TN                                                          00910001
      T1S = T1                                                          00920000
      ERANGE = RANGE                                                            
      EANG(1) = ANG(1)                                                          
      EANG(2) = ANG(2)                                                          
      CALL FMOVE (ESPV, 24, SPV)                                                
      RETURN                                                            00930001
C-----------------------------------------------------------------------00940001
C                   HG COORDINATES                                      00950001
C-----------------------------------------------------------------------00960001
   52 CALL SEDRTM (GMT,T,JREC,MP,MN,TP,TN,T1,T2,NS,NECN)                00970001
      CALL SEDRSV (T1,JREC(12,4))                                       00980001
      CALL SEDRSV (T2,JREC(12,NS))                                      00990001
      IF (TN.EQ.TNS)  GO TO 21                                          01000001
C**** COMPUTE NEW NAVIGATION MATRICES.                                  01010001
      TNS = TN                                                          01020000
      IF (MAGIC(5)) CALL SEDRDT (JREC,MN,0,11,TN,IDTAP)                 01030001
      CALL SEDRCN (JREC(1,MN),AUXM,BUXM,ANG,RANGE,SPV)                  01040001
      CALL FMOVE (QAUXM,36,AUXM)                                        01050001
      CALL FMOVE (QBUXM,36,BUXM)                                        01060001
      CALL FMOVE (QANG,8,ANG)                                           01070001
      QRANGE = RANGE                                                    01080001
      CALL FMOVE (QSPV,24,SPV)                                          01090001
      GO TO 34                                                          01100001
C**** USE OLD NAVIGATION MATRICES.                                      01110001
   21 CALL FMOVE (AUXM,36,QAUXM)                                        01120000
      CALL FMOVE (BUXM,36,QBUXM)                                        01130001
      CALL FMOVE (ANG,8,QANG)                                           01140001
      RANGE = QRANGE                                                    01150001
      CALL FMOVE (SPV,24,QSPV)                                          01160001
C**** COMPUTE NEW POINTING VECTOR MATRIX.                               01170001
   34 IF (MAGIC(5).AND.T1.NE.T1S) CALL SEDRDT (JREC,4,0,12,T1,IDTAP)    01180001
      T1S = T1                                                          01190001
      CALL SEDRRT (T,TP1,TP2,PMAT1,PMAT2)                               01200001
      CALL SEDRPV (PMAT1,AUXM,BUXM,QROT1)                               01210001
      CALL SEDRPV (PMAT2,AUXM,BUXM,QROT2)                               01220000
C**** INTERPOLATION AND NORMALIZATION.                                  01230001
      CALL SEDRIP (TP1,QROT1,TP2,QROT2,T,ROT,9,0)                       01240001
      CALL FMOVE (WORK(66),36,ROT)                                      01250001
      ERANGE = RANGE                                                            
      EANG(1) = ANG(1)                                                          
      EANG(2) = ANG(2)                                                          
      CALL FMOVE (ESPV, 24, SPV)                                                
      RETURN                                                            01260001
C-----------------------------------------------------------------------01270001
C                     S3 OR L1 COORDINATES                              01280001
C-----------------------------------------------------------------------01290001
   54 CALL SEDRTM (GMT,T,JREC,MP,MN,TP,TN,T1,T2,NS,NECN)                01300001
      CALL SEDRSV (T1,JREC(12,4))                                       01310001
      CALL SEDRSV (T2,JREC(12,NS))                                      01320000
      IF (    (NECN.EQ.2.AND.ICOORD.EQ.4)                               01330003
     X   .OR. (NECN.EQ.2.AND.ICOORD.EQ.5)                               01340004
     X   .OR. (NECN.EQ.2.AND.ICOORD.EQ.6)                               01340004
     X   .OR. (NECN.EQ.1.AND.ICOORD.EQ.3))                              01350004
     X      GO TO 53                                                    01360001
C     (* URANUS (ICOORD = 5) ADDED TO TEST ON 85DEC20, JAJ *)           01370003
C     (* NEPTUNE (ICOORD = 6) ADDED TO IF STATEMENT, 89AUG07, JAJ *)    01370003
      WRITE (6,2001) TN                                                 01380001
 2001 FORMAT (' UNABLE TO PROCESS COORDINATES: NAVIGATION RECORD',      01390001
     X  ' IS NOT CORRECT TYPE'/' TIME = ',1PD23.15)                     01400001
      STOP                                                              01410001
   53 IF (TN.EQ.TNS)  GO TO 44                                          01420001
C**** COMPUTE NEW NAVIGATION VALUES.                                    01430001
C     MMN = (ICOORD-3)*((MN+9)/2) <== (* REPLACED 86JAN02, JAJ *)       01440005
C     (* MN = 1 OR 3;                                                   01441005
C        FOR LONG (JUPITER TYPE) NAV BLOCKS, MMN = 5 OR 6 *)            01442005
      IF (ICOORD .EQ. 3) MMN = 0                                        01443005
      IF (ICOORD .EQ. 4) MMN = (MN + 9)/2                               01444005
      IF (ICOORD .EQ. 5) MMN = (MN + 9)/2                               01445005
      IF (MAGIC(5)) CALL SEDRDT (JREC,MN,MMN,11,TN,IDTAP)               01450000
      SPSI = PSI                                                        01460001
      SOMG = OMG                                                        01470001
C----- 86-APR-19 (JAJ) -------------------------------------------------        
      CALL FMOVE (SANG, 8, QANG)                                        01480001
      SRANGE = QRANGE                                                           
      CALL FMOVE (SSPV, 24, QSPV)                                               
C-----------------------------------------------------------------------        
      SNT = TNS                                                         01490001
      TNS = TN                                                          01500001
      CALL SEDRCJ (JREC(1,MN),JREC(1,(MN+9)/2),PSI,OMG,ANG,RANGE,SPV)   01510001
      CALL FMOVE (QANG,8,ANG)                                           01520001
      CALL FMOVE (QSPV,24,SPV)                                          01530001
      QRANGE = RANGE                                                    01540001
      GO TO 46                                                          01550000
C**** USE OLD NAVIGATION VALUES.                                        01560001
   44 CALL FMOVE (ANG,8,QANG)                                           01570001
      CALL FMOVE (SPV,24,QSPV)                                          01580001
      RANGE = QRANGE                                                    01590001
C**** INTERPOLATION.                                                    01600001
   46 CALL SEDRIP (SNT,SPSI,TN,PSI,T,EPSI,1,1)                          01610001
      CALL SEDRIP (SNT,SOMG,TN,OMG,T,EOMG,1,2)                          01620001
      CALL SEDRIP (SNT,SANG(2),TN,ANG(2),T,EANG2,1,3)                   01630001
      CALL SEDRRT (T,TP1,TP2,PMAT1,PMAT2)                               01640001
      CALL SEDRPJ (PMAT1,EPSI,EOMG,EANG2,AUXM,BUXM1,QROT1)              01650000
      CALL SEDRPJ (PMAT2,EPSI,EOMG,EANG2,AUXM,BUXM2,QROT2)              01660001
      CALL SEDRIP (TP1,BUXM1,TP2,BUXM2,T,BUXM,9,0)                      01670001
      CALL SEDRIP (TP1,QROT1,TP2,QROT2,T,ROT,9,0)                       01680001
      CALL FMOVE (WORK(66),36,ROT)                                      01690001
      IF (T1.NE.T1S.AND.MAGIC(5)) CALL SEDRDT (JREC,4,0,12,T1,IDTAP)    01700001
C                                                                               
C----- THE FOLLOWING WAS ADDED 86-APR-19 (JAJ) -------------------------        
C----- TO INTERPOLATE S/C POSITION -------------------------------------        
      CALL SEDRIP (SNT,SRANGE, TN,RANGE, T,ERANGE, 1,0)                         
      CALL SEDRIP (SNT,SANG(1), TN,ANG(1), T,EANG(1), 1,4)                      
      CALL SEDRIP (SNT,SANG(2), TN,ANG(2), T,EANG(2), 1,3)                      
      CALL SEDRIP (SNT,SSPV, TN,SPV, T,ESPV, 6,0)                               
C-----------------------------------------------------------------------        
C                                                                               
      T1S = T1                                                          01710001
      RETURN                                                            01720001
      END                                                               01730001
      SUBROUTINE SEDRCJ (JN,JNN,PSI,OMG,ANG,RANGE,RJVE)                 00010000
C-----------------------------------------------------------------------00020000
C  JUPITER SYSTEM III(S3) OR SATURN LATITUDE(L1) COORDINATES.           00030000
C  U2ADS.SEDRCALJ  22JUN81  ALLAN SILVER                                00040000
C  INPUT: JN POINTS TO WORD 1 OF JUPITER OR SATURN NAVIGATION DATA.     00050000
C         JNN POINTS TO WORD 127 OF JUPITER NAVIGATION DATA.            00060000
C  L1 COORDINATE SYSTEM GOOD ONLY FOR 1980 AND 1981                     00070000
C  85JUN25 J.A.JONES SAR  URANUS COORDINATE SYSTEM ADDED.               00080002
C  89AUG07 J.A.JONES STX  NEPTUNE COORDINATE SYSTEM ADDED.              00080002
C  89SEP05 J.A.JONES STX  NEPTUNE COORDINATE SYSTEM REVISED.            00080002
C                                                                       00090002
C     ICOORD = 1  PL (PAYLOAD) (THIS ROUTINE SHOULD NOT BE CALLED)      00100002
C     ICOORD = 2  HG (HELIOGRAPHIC) (THIS ROUTINE SHOULD NOT BE CALLED) 00110002
C     ICOORD = 3  L1 (SATURN)                                           00120002
C     ICOORD = 4  S3 (JUPITER)                                          00130002
C     ICOORD = 5  U1 (URANUS)                                           00140002
C     ICOORD = 6  N1 (NEPTUNE)                                          00150002
C-----------------------------------------------------------------------00160000
      COMMON /CCA/ WORK(500)                                            00170000
      EQUIVALENCE (WORK(61),ICOORD)                                     00180000
      INTEGER*4 ITM(6)                                                  00190000
      REAL*4 JN(1),JNN(1),S(3,3),Q(3,3),ANG(2),DTR/.017453293E0/        00200000
      REAL*4 RTD/57.295780E0/,TPEZ(3,3),ROT(3,3),RJVE(3)                00210000
      REAL*8 TIMEL, LONG, DRANGE, RA                                    00220005
C                                                                       00230000
C     PLANETARY RADII:                                                  00240000
      REAL*4 ARADJ/71372.E0/, ARADS/60330.E0/, ARADU/25600.E0/          00250006
C     (* URANUS RADIUS CORRECTED, 86JAN02 JAJ, ARADU/26200.E0/ *)       00260006
      REAL*4 ARADN/24765.E0/                                                    
C                                                                       00270000
C                                                                       00280000
C     THE P-MATRICES TRANSFORM FROM CARTESIAN COMPONENTS REFERED TO     00290000
C      THE EARTH MEAN ECLIPTIC & EQUINOX OF 1950.0 TO A PLANETOCENTRIC  00300000
C      CARTESIAN VERNAL EQUINOX SYSTEM (INERTIAL).                      00310000
C                                                                       00320000
      REAL*4 PJ(3,3)/-7.214966E-1,+6.922823E-1,+1.370326E-2,            00330000
     X               -6.922676E-1,-7.207863E-1,-3.511083E-2,            00340000
     X               -1.442949E-2,-3.481867E-2,+9.992895E-1/            00350000
C                                                                       00360000
      REAL*4 PS(3,3)/+9.91514E-1, -1.24478E-1, -3.7492 E-2,             00370000
     X               +9.2529 E-2, +8.78309E-1, -4.69054E-1,             00380000
     X               +9.1316 E-2, +4.61604E-1, +8.82373E-1/             00390000
C                                                                       00400000
      REAL*4 PU(3,3)/+9.737952E-1,-2.270260E-1,-1.349334E-2,            00410000
     X               -4.308389E-2,-1.258954E-1,-9.911075E-1,            00420000
     X               +2.233085E-1,+9.657171E-1,-1.323775E-1/            00430000
C                                                                       00440001
CC    REAL*4 PN(3,3)/-7.42052E-1, -6.69626E-1, +3.09714E-2,             00450001
CC   X               +5.67694E-1, -6.52322E-1, -5.02196E-1,             00380000
CC   X               +3.56487E-1, -3.55073E-1, +8.64199E-1/             00390000
C                                                                       00440001
C     (* POST-ENCOUNTER REVISION OF NEPTUNE ROTATION AXIS, 89SEP05 *)           
C     REAL*4 PN(3,3)/-7.139430E-1,  -6.995204E-1,   3.092683E-2,        00450001
C    X                6.028297E-1,  -6.365276E-1,  -4.810707E-1,        00380000
C    X                3.562046E-1,  -3.248134E-1,   8.761361E-1 /       00390000
C     (* POST-ENCOUNTER REVISION OF NEPTUNE ROTATION AXIS, 90JUL16 *)           
      REAL*4 PN(3,3)/-7.093737E-1,  -7.041542E-1,   3.091500E-2,        00450001
     X                6.092710E-1,  -6.346587E-1,  -4.753915E-1,        00380000
     X                3.543694E-1,  -3.183947E-1,   8.792310E-1 /       00390000
C                                                                       00460000
C                                                                       00470000
C                                                                       00480000
C                                                                       00490000
C     (* CONVERT S/C STATE (POSITION & VELOCITY) FROM ECL50             00500000
C        TO PLANET'S VERNAL EQUINOX SYSTEM (RJVE);                      00510000
C        FIND S/C LATITUDE, LONGITUDE, AND RANGE IN PLANET-FIXED        00520000
C        SYSTEM (ANG & RANGE). *)                                       00530000
      GO TO (80,80,200,100,300,400), ICOORD                             00540000
   80 CONTINUE                                                          00550000
C       --ERROR--   NON-ENCOUNTER COORDINATES.                          00560000
        WRITE (6, 2002) ICOORD                                          00570000
        GO TO 500                                                       00580000
  100 CONTINUE                                                          00590000
C       --JUPITER--   (S3 COORDINATES, ICOORD = 4)                      00600000
        DO 110 I = 1, 3                                                 00610000
          RJVE(I)                                                       00620000
     .      = (PJ(1,I)*JN(19) + PJ(2,I)*JN(20) + PJ(3,I)*JN(21))/ARADJ  00630000
          RJVE(I+3) = PJ(1,I)*JN(22) + PJ(2,I)*JN(23) + PJ(3,I)*JN(24)  00640000
  110   CONTINUE                                                        00650000
        ANG(1) = JNN(31)                                                00660000
        ANG(2) = JNN(33)                                                00670000
        RANGE = JNN(50)/ARADJ                                           00680000
C       (* ANG = JOVIAN LATITUDE, LONGITUDE (S III) OF S/C (DEGREES) *) 00690000
C       (* RANGE = S/C RANGE FROM JUPITER (JOVIAN RADII) *)             00700000
        GO TO 500                                                       00710000
  200 CONTINUE                                                          00720000
C       --SATURN--   (L1 COORDINATES, ICOORD = 3)                       00730000
        DO 210 I = 1, 3                                                 00740000
          RJVE(I)                                                       00750000
     .      = (PS(1,I)*JN(19) + PS(2,I)*JN(20) + PS(3,I)*JN(21))/ARADS  00760000
          RJVE(I+3) = PS(1,I)*JN(22) + PS(2,I)*JN(23) + PS(3,I)*JN(24)  00770000
  210   CONTINUE                                                        00780000
        ANG(1) = JN(76)                                                 00790000
C       (* ANG(1) = SATURN LATITUDE OF S/C (DEGREES) *)                 00800000
        CALL FMOVE (ITM,24,JN)                                          00810000
C       (* ITM = SCE GMT(Y,D,H,M,S,MS) OF NAVIGATION BLOCK *)           00820000
        TIMEL = ITM(2) - 1.0D0                                          00830004
     .    + (ITM(3) + (ITM(4) + (ITM(5) + ITM(6)*1D-3)/60D0)/60D0)/24D0 00840004
        IF (ITM(1).EQ.1981) TIMEL = TIMEL + 366.D0                      00850004
        DRANGE = JN(83)                                                 00860005
        RA = JN(103)                                                    00870005
        LONG = 810.76D0*(TIMEL - 3.860695545D-11*DRANGE) - RA           00880005
        ANG(2) = DMOD(LONG,360.D0)                                      00890005
C       (* ANG(2) = SATURN LONGITUDE OF S/C (DEGREES) *)                00900004
        RANGE = JN(83)/ARADS                                            00910000
        GO TO 500                                                       00920000
  300 CONTINUE                                                          00930000
C       --URANUS--                                                      00940000
        DO 310 I = 1, 3                                                 00950000
          RJVE(I)                                                       00960000
     .      = (PU(1,I)*JN(19) + PU(2,I)*JN(20) + PU(3,I)*JN(21))/ARADU  00970000
          RJVE(I+3) = PU(1,I)*JN(22) + PU(2,I)*JN(23) + PU(3,I)*JN(24)  00980000
  310   CONTINUE                                                        00990000
        ANG(1) = JNN(13)                                                01000000
        ANG(2) = JNN(14)                                                01010000
        RANGE = JNN(27)/ARADU                                           01020000
C       (* ANG = URANUS LATITUDE, LONGITUDE OF S/C (DEGREES) *)         01030000
C       (* RANGE = S/C RANGE FROM URANUS (URANIAN RADII) *)             01040000
        GO TO 500                                                       01050000
  400 CONTINUE                                                          01060000
C       --NEPTUNE--                                                     01070000
        DO 410 I = 1, 3                                                 00950000
          RJVE(I)                                                       00960000
     .      = (PN(1,I)*JN(19) + PN(2,I)*JN(20) + PN(3,I)*JN(21))/ARADN  00970000
          RJVE(I+3) = PN(1,I)*JN(22) + PN(2,I)*JN(23) + PN(3,I)*JN(24)  00980000
  410   CONTINUE                                                        00990000
        ANG(1) = JNN(13)                                                01000000
        ANG(2) = JNN(14)                                                01010000
        RANGE = JNN(27)/ARADN                                           01020000
C       (* ANG = NEPTUNE LATITUDE, LONGITUDE OF S/C (DEGREES) *)        01030000
C       (* RANGE = S/C RANGE FROM NEPTUNE (NEPTUNE RADII) *)            01040000
        GO TO 500                                                       01050000
  500 CONTINUE                                                          01090000
C                                                                       01100000
C     (* COMPUTE PSI AND OMEGA. *)                                      01110000
C     (* PSI IS CO-LATITUDE OF THE S/C IN THE VERNAL EQUINOX SYSTEM;    01120000
C        OMG IS THE INERTIAL LONGITUDE.  *)                             01130000
      SQ = SQRT(RJVE(1)**2 + RJVE(2)**2 + RJVE(3)**2)                   01140000
      PSI = 0.E0                                                        01150000
      IF (SQ.NE.0.E0)  PSI = ARCOS(RJVE(3)/SQ)                          01160000
      OMG = ATAN2(RJVE(2),RJVE(1))                                      01170000
C                                                                       01180000
C     (* CHECK ANGLE PSI. *)                                            01190000
      PSID = 90.E0 - PSI*RTD                                            01200000
      IF (ABS(PSID - ANG(1)).GT..015E0)                                 01210000
     .   WRITE (6,2001) PSID,ANG(1)                                     01220000
      RETURN                                                            01230000
C                                                                       01240000
C                                                                       01250000
C                                                                       01260000
      ENTRY SEDRPJ (TPEZ,PSI,OMG,ANG2,S,Q,ROT)                          01270000
C**** INPUT: TPEZ POINTS TO WORD 12 OF POINTING VECTOR DATA.            01280000
C**** COMPUTE SINES & COSINES OF PSI & OMEGA.                           01290000
      CPSI = COS(PSI)                                                   01300000
      SPSI = SIN(PSI)                                                   01310000
      COMG = COS(OMG)                                                   01320000
      SOMG = SIN(OMG)                                                   01330000
C**** COMPUTE S  MATRIX                                                 01340000
C****          1                                                        01350000
      S(1,1) = SPSI*COMG                                                01360000
      S(1,2) = CPSI*COMG                                                01370000
      S(1,3) = - SOMG                                                   01380000
      S(2,1) = SPSI*SOMG                                                01390000
      S(2,2) = CPSI*SOMG                                                01400000
      S(2,3) = COMG                                                     01410000
      S(3,1) = CPSI                                                     01420000
      S(3,2) = - SPSI                                                   01430000
      S(3,3) = 0.E0                                                     01440000
C****                             T                                     01450000
C**** COMPUTE ROTATION MATRIX S PA .                                    01460000
C****                          1                                        01470000
      GO TO (2080,2080,2200,2100,2300,2400), ICOORD                     01480000
 2080 CONTINUE                                                          01490000
 2100 CONTINUE                                                          01500000
C       --JUPITER--                                                     01510000
        DO 2120  I = 1,3                                                01520000
        DO 2120  J = 1,3                                                01530000
           Q(J,I)                                                       01540000
     .       = PJ(1,I)*TPEZ(1,J) + PJ(2,I)*TPEZ(2,J) + PJ(3,I)*TPEZ(3,J)01550000
 2120   CONTINUE                                                        01560000
        GO TO 2500                                                      01570000
 2200 CONTINUE                                                          01580000
C       --SATURN--                                                      01590000
        DO 2220  I = 1,3                                                01600000
        DO 2220  J = 1,3                                                01610000
           Q(J,I)                                                       01620000
     .       = PS(1,I)*TPEZ(1,J) + PS(2,I)*TPEZ(2,J) + PS(3,I)*TPEZ(3,J)01630000
 2220   CONTINUE                                                        01640000
        GO TO 2500                                                      01650000
 2300 CONTINUE                                                          01660000
C       --URANUS--                                                      01670000
        DO 2320  I = 1,3                                                01680000
        DO 2320  J = 1,3                                                01690000
           Q(J,I)                                                       01700000
     .       = PU(1,I)*TPEZ(1,J) + PU(2,I)*TPEZ(2,J) + PU(3,I)*TPEZ(3,J)01710000
 2320   CONTINUE                                                        01720000
        GO TO 2500                                                      01730000
 2400 CONTINUE                                                          01740000
C       --NEPTUNE--                                                     01750000
        DO 2420  I = 1,3                                                01760000
        DO 2420  J = 1,3                                                01770000
           Q(J,I)                                                       01780000
     .       = PN(1,I)*TPEZ(1,J) + PN(2,I)*TPEZ(2,J) + PN(3,I)*TPEZ(3,J)01790000
 2420   CONTINUE                                                        01800000
        GO TO 2500                                                      01810000
 2500 CONTINUE                                                          01820000
      DO 30  I = 1,3                                                    01830000
      DO 30  J = 1,3                                                    01840000
         ROT(J,I) = S(1,I)*Q(J,1) + S(2,I)*Q(J,2) + S(3,I)*Q(J,3)       01850000
   30 CONTINUE                                                          01860000
C**** COMPUTE S  MATRIX.                                                01870000
C****          2                                                        01880000
      COMG = COS(DTR*(360.E0-ANG2))                                     01890000
      SOMG = SIN(DTR*(360.E0-ANG2))                                     01900000
      S(1,1) = SPSI*COMG                                                01910000
      S(1,2) = CPSI*COMG                                                01920000
      S(1,3) = - SOMG                                                   01930000
      S(2,1) = SPSI*SOMG                                                01940000
      S(2,2) = CPSI*SOMG                                                01950000
      S(2,3) = COMG                                                     01960000
C****          T    T                                                   01970000
C**** COMPUTE S S PA .                                                  01980000
C****          2 1                                                      01990000
      DO 40  I = 1,3                                                    02000000
      DO 40  J = 1,3                                                    02010000
   40 Q(J,I) = S(I,1)*ROT(J,1) + S(I,2)*ROT(J,2) + S(I,3)*ROT(J,3)      02020000
      RETURN                                                            02030000
 2001 FORMAT (' JUPITER OR SATURN COORDINATE SYSTEM ERROR, 90-PSI = ',  02040000
     X 1PE11.3,' SEDR WORD = ',E11.3)                                   02050000
 2002 FORMAT (' ENCOUNTER COORDINATE SYSTEM ERROR, ',                   02060000
     X        'SUBROUTINE SEDRCJ CALLED WITH ICOORD =', I5)             02070000
      END                                                               02080000
      SUBROUTINE SEDRCN(CN,TTB,TTB5,ANG,RANGE,SPV)                      00001000
C****    HG COORDINATE SYSTEM                                           00002000
C**** U2ADS.SEDRCALC  30-JAN-79   ALLAN SILVER                          00003000
C**** INPUT: CN POINTS TO WORD 1 OF CRUISE NAVIGATION DATA.             00004000
      REAL*4 CN(1),TPEZ(3,3),ANG(2),SPV(6),THG(3,3),TTB5(3,3)           00005000
      REAL*4 TTB(3,3),TPIE/6.2831853E0/,ARAD/1.495985E8/,WORK(500)      00006000
      REAL*4 T5(3,3) /+0.2576  ,+0.9662  ,+0.      ,                    00007000
     X                -0.9585  ,+0.2555  ,+0.1262  ,                    00008000
     X                +0.1219  ,-0.0325  ,+0.9920  /                    00009000
C**** COMPUTE POSITION & VELOCITY VECTORS IN INERTIAL SUN EQUATOR SYSTEM00010000
C**** COMPUTE RANGE.                                                    00011000
      DO 21  I = 1,3                                                    00012000
      SPV(I) = (T5(1,I)*CN(13) + T5(2,I)*CN(14) + T5(3,I)*CN(15))/ARAD  00013000
   21 SPV(I+3) = T5(1,I)*CN(16) + T5(2,I)*CN(17) + T5(3,I)*CN(18)       00014000
      RANGE = SQRT(SPV(1)**2 + SPV(2)**2 + SPV(3)**2)                   00015000
C**** COMPUTE PROBE LONGITUDE & LATITUDE IN INERTIAL SUN EQUATOR SYSTEM.00016000
      DEN = SQRT (SPV(2)**2 + SPV(1)**2)                                00017000
      IF (DEN.EQ.0.E0)  DEN = 1.E0                                      00018000
      SNB = SPV(2)/DEN                                                  00019000
      CSB = SPV(1)/DEN                                                  00020000
      ANG(1) = ATAN2(SPV(2),SPV(1))                                     00021000
      IF (ANG(1).LT.0.E0)  ANG(1) = ANG(1) + TPIE                       00022000
      SNT = SPV(3)/RANGE                                                00023000
      CST = SQRT(1.E0 - SNT**2)                                         00024000
      ANG(2) = ARSIN(SNT)                                               00025000
C**** COMPUTE TRANSFORMATION MATRIX M          .                        00026000
C****                                THETA,BETA                         00027000
      TTB(1,1) = CST*CSB                                                00028000
      TTB(1,2)= - SNB                                                   00029000
      TTB(1,3) = - SNT*CSB                                              00030000
      TTB(2,1) = CST*SNB                                                00031000
      TTB(2,2) = CSB                                                    00032000
      TTB(2,3) = - SNT*SNB                                              00033000
      TTB(3,1) = SNT                                                    00034000
      TTB(3,2) = 0.E0                                                   00035000
      TTB(3,3) = CST                                                    00036000
C**** COMPUTE TRANSFORMATION MATRIX M             = M           X M .   00037000
C****                                THETA,BETA,5    THETA,BETA    5    00038000
C**** STORE AS INVERSE (TRANSPOSE).                                     00039000
      DO 31  I = 1,3                                                    00040000
      DO 31  J = 1,3                                                    00041000
   31 TTB5(I,J) = TTB(1,I)*T5(J,1) + TTB(2,I)*T5(J,2) + TTB(3,I)*T5(J,3)00042000
      RETURN                                                            00043000
      ENTRY SEDRPV (TPEZ,TTB,TTB5,THG)                                  00044000
C**** INPUT: TPEZ POINTS TO WORD 12 OF POINTING VECTOR DATA.            00045000
C**** COMPUTE TRANSFORMATION MATRIX M   = M             X M    .        00046000
C****                                HG    THETA,BETA,5    P,E0         00047000
      DO 41  I = 1,3                                                    00048000
      DO 41  J = 1,3                                                    00049000
   41 THG(J,I) = TTB5(I,1)*TPEZ(1,J) + TTB5(I,2)*TPEZ(2,J) +            00050000
     X           TTB5(I,3)*TPEZ(3,J)                                    00051000
      RETURN                                                            00052000
      END                                                               00053000
      SUBROUTINE SEDRDT (JREC,IND1,IND2,NTYP,EPD,IDTAP)                 00001000
C**** WRITE AN SEDR RECORD TAPE ON DETAIL TAPE.                         00002000
      COMMON /CCA/ WORK(500)                                            00003000
      REAL*8 EPD                                                        00004000
      INTEGER*4 JREC(126,6),FLTN(3)/'FLT2','FLT1','BAD '/               00005000
      INTEGER*2 IDTAP(1),SD/'SD'/,RN/'RN'/,RP/'RP'/                     00006000
      EQUIVALENCE (ISCN,WORK(34))                                       00007000
      IDTAP(1) = SD                                                     00008000
      IDTAP(33) = NTYP                                                  00009000
      FLTT = FLTN(3)                                                    00010000
      IF (ISCN.EQ.0.OR.ISCN.EQ.1)  FLTT = FLTN (ISCN+1)                 00011000
      CALL FMOVE (IDTAP(5),4,FLTT)                                      00012000
      IDTAP(7) = MOD(JREC(1,IND1),1900)                                 00013000
      DO 40  I = 2,6                                                    00014000
   40 IDTAP(I+6) = JREC(I,IND1)                                         00015000
      CALL FMOVE (IDTAP(17),8,EPD)                                      00016000
      CALL FMOVE (IDTAP(65),504,JREC(1,IND1))                           00017000
      IF (NTYP.EQ.12) GO TO 50                                          00018000
C**** NAVIGATION RECORD NTYP=11 'SDRN' (32 WD HDR)+(126WD)+(126WD JUP)  00019000
      IDTAP(2) = RN                                                     00020000
      IF (IND2.GT.0) CALL FMOVE (IDTAP(317),504,JREC(1,IND2))           00021000
      IF (IND2.EQ.0) CALL AMBTAP (IDTAP,42)                             00022000
      IF (IND2.GT.0) CALL AMBTAP (IDTAP,84)                             00023000
      RETURN                                                            00024000
C**** POINTING VECTOR RECORD NTYP=12 'SDRP' (32 WD HDR)+(126 WD)        00025000
   50 IDTAP(2) = RP                                                     00026000
      CALL AMBTAP (IDTAP,42)                                            00027000
      RETURN                                                            00028000
      END                                                               00029000
      SUBROUTINE SEDRIN (JREC)                                          00000010
C**** INITIALIZE THE SEDR BUFFERS; READ SEDR TAPE.                      00000020
C**** U2ADS.SEDRINTM     02-JAN-79   ALLAN SILVER                       00000030
C*****************************************************                  00000040
C****    N = NAVIGATION RECORD                                          00000050
C****    P = POINTING VECTOR RECORD                                     00000060
C****    PL = POINTING VECTOR RECORD (LAST)                             00000070
C****    PN = POINTING VECTOR RECORD (NOT LAST)                         00000080
C*****************************************************                  00000090
C**** *   Q:  *   1       2       3       4       5                     00000100
C**** * R1/R2:*  N/PL    N/PN   PL/-    PN/PL   PN/PN                   00000110
C**** *   S:  *   2       2       1      1,2     1,2                    00000120
C*****************************************************                  00000130
C****    R3/R4 = N/P                                                    00000140
C****    T1 = TIME OF R4                                                00000150
C****    T2 = TIME OF RS                                                00000160
C****    W1 = TIME OF R3                                                00000170
C****    W2 = TIME OF R1 (IF Q = 1 OR 2)                                00000180
C****    MP = 1,2,3, OR 4 IS POINTER TO CURRENT P                       00000190
C****    MN = 1 OR 3 IS POINTER TO CURRENT N                            00000200
C*****************************************************                  00000210
      INTEGER*4 NECN(3)/3*-1/,LUNO/6/,JREC(126,6),NBYT,SCN              00000220
      REAL*4 WORK(500),UNIT,SENS(2)/2*'    '/                           00000230
      REAL*8 T,T1,T2,W1,W2,TP,TN,DDF,DDNM/'SEDRLIST'/,TMAX/.14D0/       00000240
      REAL*8 T1R,T2R                                                    00000250
      REAL*8 VOLSER,SENSE,OLDVOL/'        '/,VOLSDR(5)                  00000260
      INTEGER*2 IYRF,SIO(5),GMT(6),ITB(6)                               00000270
      LOGICAL*1 LYRC,LFTS/.TRUE./,LTPP,LEOF/.FALSE./,LFRD/.FALSE./      00000280
      COMMON /CCA/ WORK                                                 00000290
      EQUIVALENCE (WORK(34),SCN),(WORK(122),NSDR),(WORK(123),VOLSDR(1)),00000300
     X  (WORK(144),UNIT),(WORK(148),SIO(1)),(SENS(1),SENSE)             00000310
      DDF(INS) = JREC(2,INS)+(JREC(3,INS)+(JREC(4,INS)+(JREC(5,INS)+    00000320
     X    .001D0*JREC(6,INS))/60.D0)/60.D0)/24.D0 - 1.D0                00000330
      IYRF(INS) = MOD(JREC(1,INS),1900)                                 00000340
      LTPP(INS) = ((JREC(101,INS).EQ.0).OR.(JREC(101,INS).EQ.1))        00000350
     X      .AND.JREC(8,INS).GE.0.AND.JREC(8,INS).LE.59                 00000360
      LYRC(INS) = JREC(1,INS).GE.1977.AND.JREC(1,INS+1).GE.1977         00000370
      NREC = 0                                                          00000380
C**** READ HEADER BLOCK.                                                00000390
      NRET = 1                                                          00000400
      CALL SDREAD(JREC,1,NECN(1),NBYT,&91,&92)                          00000410
      NREC = NREC + 1                                                   00000420
      IF (NBYT.EQ.180)  GO TO 93                                        00000430
      WRITE (LUNO,2003) NBYT,NREC                                       00000440
C**** READ DATA BLOCK INTO R3/R4.                                       00000450
   32 NRET = 2                                                          00000460
      CALL SDREAD(JREC,3,NECN(3),NBYT,&91,&92)                          00000470
      NREC = NREC + 1                                                   00000480
      IF (NECN(3).GE.1.AND.LTPP(4).AND.(.NOT.LTPP(3)))  GO TO 31        00000490
      WRITE (LUNO,2004) NBYT,NREC,(JREC(IW,3),IW=1,6),                  00000500
     X    (JREC(IW,4),IW=1,6),JREC(8,3),JREC(8,4),JREC(101,3),          00000510
     X    JREC(101,4)                                                   00000520
      GO TO 32                                                          00000530
C**** READ DATA BLOCK INTO R1/R2.                                       00000540
   31 NRET = 3                                                          00000550
      CALL SDREAD(JREC,1,NECN(1),NBYT,&91,&92)                          00000560
      NREC = NREC + 1                                                   00000570
      IF (NECN(1).GE.1)  GO TO 33                                       00000580
      WRITE (LUNO,2004) NBYT,NREC,(JREC(IW,1),IW=1,6),                  00000590
     X    (JREC(IW,2),IW=1,6)                                           00000600
      GO TO 31                                                          00000610
   33 IF (JREC(101,4).EQ.0)  GO TO 12                                   00000620
      NS = 1                                                            00000630
      IF (JREC(101,1).EQ.0)  GO TO 10                                   00000640
      IF (JREC(101,2).EQ.0)  GO TO 11                                   00000650
      NQ = 5                                                            00000660
      GO TO 14                                                          00000670
   10 NQ = 3                                                            00000680
      GO TO 14                                                          00000690
   11 NQ = 4                                                            00000700
      GO TO 14                                                          00000710
   12 CALL EPIC(IYRF(1),DDF(1),W2)                                      00000720
      NS = 2                                                            00000730
      IF (JREC(101,2).EQ.0)  GO TO 13                                   00000740
      NQ = 2                                                            00000750
      GO TO 14                                                          00000760
   13 NQ = 1                                                            00000770
C**** CALCULATE TIMES.                                                  00000780
   14 CALL EPIC (IYRF(4),DDF(4),T1)                                     00000790
      CALL EPIC (IYRF(3),DDF(3),W1)                                     00000800
      CALL EPIC (IYRF(NS),DDF(NS),T2)                                   00000810
      WRITE (6,2006) (JREC(IW,4),IW=1,6),(JREC(IW,NS),IW=1,6),          00000820
     X    (JREC(IW,3),IW=1,6),(JREC(IW,1),IW=1,6)                       00000830
      RETURN                                                            00000840
      ENTRY SEDRTM (GMT,T,JREC,MP,MN,TP,TN,T1R,T2R,NSR,NECR)            00000850
      IF (LEOF)  RETURN                                                 00000860
      IF (T1-T.LE.TMAX.OR..NOT.LFTS)  GO TO 40                          00000870
      CALL SETIME (MOD(JREC(1,4)-GMT(1),1900),T1-T,ITB)                 00000880
      ITB(2) = ITB(2) - 1                                               00000890
      WRITE (LUNO,2008) ITB,GMT,(JREC(IW,4),IW=1,6)                     00000900
      LFTS = .FALSE.                                                    00000910
C**** CHOOSE CORRECT SEDR BUFFER BLOCKS ACCORDING TO INPUT TIME.        00000920
C**** IF NECESSARY, READ SEDR TAPE AND UPDATE BUFFERS.                  00000930
C****                                                                   00000940
C**** TEST TIMES & SET UP EXTERNAL POINTERS.                            00000950
      IF (T.GE.T2)  GO TO 45                                            00000960
   48 IF (DABS(T-T1).GE.DABS(T-T2))  GO TO 41                           00000970
      MP = 4                                                            00000980
      TP = T1                                                           00000990
      GO TO 42                                                          00001000
   41 MP = NS                                                           00001010
      TP = T2                                                           00001020
   42 IF (NQ.LE.2)  GO TO 43                                            00001030
      MN = 3                                                            00001040
      TN = W1                                                           00001050
      GO TO 46                                                          00001060
   43 IF (DABS(T-W1).GE.DABS(T-W2))  GO TO 44                           00001070
      MN = 3                                                            00001080
      TN = W1                                                           00001090
      GO TO 46                                                          00001100
   44 MN = 1                                                            00001110
      TN = W2                                                           00001120
   46 LFRD = .TRUE.                                                     00001130
      NSR = NS                                                          00001140
      T1R = T1                                                          00001150
      T2R = T2                                                          00001160
      NECR = NECN(MN)                                                   00001170
      RETURN                                                            00001180
C**** MOVE INTERNAL POINTERS.                                           00001190
   45 IF (T-T2.LE.TMAX.OR..NOT.LFRD)  GO TO 47                          00001200
      CALL SETIME (MOD(GMT(1)-JREC(1,NS),1900),T-T2,ITB)                00001210
      ITB(2) = ITB(2) - 1                                               00001220
      WRITE (LUNO,2008) ITB,GMT,(JREC(IW,NS),IW=1,6)                    00001230
   47 T1 = T2                                                           00001240
      CALL FMOVE (JREC(1,4),504,JREC(1,NS))                             00001250
      GO TO (51,52,61,54,55),NQ                                         00001260
   51 CALL FMOVE (JREC(1,3),504,JREC(1,1))                              00001270
      CALL FMOVE(JREC(1,6),504,JREC(1,5))                               00001280
      NECN(3) = NECN(1)                                                 00001290
      NECN(1) = -1                                                      00001300
      W1 = W2                                                           00001310
      GO TO 61                                                          00001320
   52 CALL FMOVE (JREC(1,3),504,JREC(1,1))                              00001330
      CALL FMOVE(JREC(1,6),504,JREC(1,5))                               00001340
      NECN(3) = NECN(1)                                                 00001350
      NECN(1) = -1                                                      00001360
      W1 = W2                                                           00001370
      GO TO 62                                                          00001380
   54 IF (NS.EQ.2)  GO TO 61                                            00001390
      NS = 2                                                            00001400
      CALL EPIC (IYRF(2),DDF(2),T2)                                     00001410
      GO TO 40                                                          00001420
   55 IF (NS.EQ.2)  GO TO 62                                            00001430
      NS = 2                                                            00001440
      CALL EPIC (IYRF(2),DDF(2),T2)                                     00001450
      GO TO 40                                                          00001460
C**** READ A PHYSICAL BLOCK (N/P).                                      00001470
   61 NRET = 4                                                          00001480
      CALL SDREAD(JREC,1,NECN(1),NBYT,&91,&92)                          00001490
      NREC = NREC + 1                                                   00001500
      IF (NBYT.EQ.180)  GO TO 93                                        00001510
   64 IF (NECN(1).GE.1.AND.LTPP(2).AND.(.NOT.LTPP(1)).AND.LYRC(1))      00001520
     X    GO TO 67                                                      00001530
      IF (NBYT.EQ.180) GO TO 61                                         00001540
      WRITE (LUNO,2004) NBYT,NREC,(JREC(IW,1),IW=1,6),                  00001550
     X     (JREC(IW,2),IW=1,6),JREC(8,1),JREC(8,2),JREC(101,1),         00001560
     X     JREC(101,2)                                                  00001570
      GO TO 61                                                          00001580
   67 NS = 2                                                            00001590
      CALL EPIC (IYRF(2),DDF(2),T2)                                     00001600
      IF (T2-T.LE.TMAX)  GO TO 65                                       00001610
      CALL SETIME (MOD(JREC(1,NS)-GMT(1),1900),T2-T,ITB)                00001620
      ITB(2) = ITB(2) - 1                                               00001630
      WRITE (LUNO,2008) ITB,GMT,(JREC(IW,NS),IW=1,6)                    00001640
   65 CALL EPIC (IYRF(1),DDF(1),W2)                                     00001650
      IF (JREC(101,2).EQ.0)  GO TO 66                                   00001660
      NQ = 2                                                            00001670
      GO TO 40                                                          00001680
   66 NQ = 1                                                            00001690
      GO TO 40                                                          00001700
C**** READ A PHYSICAL BLOCK (P/P) OR (P/ ).                             00001710
   62 NRET = 5                                                          00001720
      CALL SDREAD(JREC,1,NECN(1),NBYT,&91,&92)                          00001730
      NREC = NREC + 1                                                   00001740
      IF (NECN(1).GE.1.AND.LTPP(1))  GO TO 63                           00001750
      WRITE (LUNO,2005) NBYT,NREC,GMT                                   00001760
      GO TO 62                                                          00001770
   63 NS = 1                                                            00001780
      CALL EPIC (IYRF(1),DDF(1),T2)                                     00001790
      IF (T2-T.LE.TMAX)  GO TO 70                                       00001800
      CALL SETIME (MOD(JREC(1,NS)-GMT(1),1900),T2-T,ITB)                00001810
      ITB(2) = ITB(2) - 1                                               00001820
      WRITE (LUNO,2008) ITB,GMT,(JREC(IW,NS),IW=1,6)                    00001830
   70 IF (JREC(101,1).EQ.0)  GO TO 68                                   00001840
      IF (JREC(101,2).EQ.0)  GO TO 69                                   00001850
      NQ = 5                                                            00001860
      GO TO 40                                                          00001870
   68 NQ = 3                                                            00001880
      GO TO 40                                                          00001890
   69 NQ = 4                                                            00001900
C**** TEST TIME AGAIN.                                                  00001910
   40 IF (T.GE.T2)  GO TO 47                                            00001920
      GO TO 48                                                          00001930
C**** HEADER RECORD HAS BEEN READ.                                      00001940
   93 IF (JREC(3,1).EQ.SCN)  GO TO 94                                   00001950
      WRITE (LUNO,2007) JREC(3,1),SCN                                   00001960
      STOP                                                              00001970
   94 CALL WATSUP(DDNM,VOLSER,UNIT)                                     00001980
      WRITE (LUNO,2009) VOLSER,UNIT                                     00001990
      IF (OLDVOL.EQ.VOLSER)  GO TO 95                                   00002000
      OLDVOL = VOLSER                                                   00002010
      NSDR = NSDR + 1                                                   00002020
      VOLSDR(NSDR) = VOLSER                                             00002030
   95 IF (NRET.EQ.1)  GO TO 32                                          00002040
      GO TO 64                                                          00002050
C**** EOF ON SEDR TAPE.                                                 00002060
   91 CALL WATSUP (DDNM,VOLSER)                                         00002070
      WRITE (LUNO,2001) VOLSER,(JREC(IW,3),IW=1,6)                      00002080
      WRITE (4,2001) VOLSER,(JREC(IW,3),IW=1,6)                         00002090
      LEOF = .TRUE.                                                     00002100
      MP = 4                                                            00002110
      MN = 3                                                            00002120
      TP = T1                                                           00002130
      TN = W1                                                           00002140
      NSR = NS                                                          00002150
      T1R = T1                                                          00002160
      T2R = T2                                                          00002170
      NECR = NECN(3)                                                    00002180
      RETURN                                                            00002190
C**** I/O ERROR ON SEDR TAPE.                                           00002200
   92 CALL WATSUP (DDNM,VOLSER,UNIT,SENSE)                              00002210
      WRITE (LUNO,2002) VOLSER,UNIT,SENS,(JREC(IW,3),IW=1,6)            00002220
      SIO(NSDR) = SIO(NSDR) + 1                                         00002230
      GO TO (32,32,31,61,62),NRET                                       00002240
      RETURN                                                            00002250
 2001 FORMAT (////'0',56('$'),'  WARNING !!  ',56('$')/' ',126('$')/    00002260
     X        '0$$$$$ END FILE ON SEDR TAPE ',A6,' AFTER TIME ',        00002270
     X    2I4,3(':',I2),'.',I3,' $$$$$'/'0',126('$')/////)              00002280
 2002 FORMAT (' I/O ERROR ON SEDR TAPE ',A6,'(',A3,') SENSE BYTES=',    00002290
     X  2Z8,' AFTER TIME ',2I4,3(':',I2),'.',I3,' PROCESSING CONTINUES')00002300
 2003 FORMAT ('0HEADER RECORD EXPECTED ON SEDR TAPE',2I10)              00002310
 2004 FORMAT ('0N/P DATA RECORD EXPECTED ON SEDR TAPE',2I7,1X,2I4,      00002320
     X   3(':',I2),'.',I3,1X,2I4,3(':',I2),'.',I3,5X,4I3)               00002330
 2005 FORMAT ('0P/P DATA RECORD EXPECTED ON SEDR TAPE',2I10,1X,2I4,     00002340
     X   3(':',I2),'.',I3)                                              00002350
 2006 FORMAT (' INITIAL SEDR TIMES: ',2I4,3(':',I2),'.',I3,5X,2I4,      00002360
     X 3(':',I2),'.',I3,5X,2I4,3(':',I2),'.',I3,5X,2I4,3(':',I2),'.',I3)00002370
 2007 FORMAT ('0$$$$$ FLIGHT NUMBERS DISAGREE:   SEDR= ',I4,' EDR= ',I4 00002380
     X   ,' $$$$$'/'0')                                                 00002390
 2008 FORMAT (////'0',56('$'),'  WARNING !!  ',56('$')/' ',126('$')/    00002400
     X        '0$$$$$ EDR & SEDR TIMES DIFFER BY ',2I4,3(':',I2),'.',I3,00002410
     X '  EDR TIME= ',2I4,3(':',I2),'.',I3,' SEDR TIME= ',2I4,          00002420
     X 3(':',I2),'.',I3,' $$$$$'/'0',126('$')/////)                     00002430
 2009 FORMAT (T100,' MJS SEDR VOL=SER=',A6,' UNIT=',A3)                 00002440
      END                                                               00002450
      SUBROUTINE SEDRIP (T1,B1,T2,B2,T,B,N,MD)                          00001000
C****  =U2ADS.SEDRIP       05-OCT-79     ALLAN SILVER                   00002000
      REAL*8 T1,T2,T                                                    00003000
      REAL*4 B1(1),B2(1),B(1)                                           00004000
C --> REAL*4 RL(3)/0.,-3.1415927E0,0./       <-- REPLACED 86-APR-19,    00005000
C --> REAL*4 RU(3)/+3.1415927E0,+3.1415927E0,+360./    JAJONES, SAR     00006000
      REAL*4 RL(4)/0.,-3.1415927E0,0.,-90./                             00005000
      REAL*4 RU(4)/+3.1415927E0,+3.1415927E0,+360.,+90./                00006000
C***********************************************************************00007000
C******** LINEAR INTERPOLATION WITHIN LIMITS & NORMALIZATION ***********00008000
C***********************************************************************00009000
C****  INDEPENDENT VARIABLE     FUNCTION VALUE(S)                      *00010000
C****    T1 (INPUT)              B1(1...N) (INPUT)                     *00011000
C****    T2 (INPUT)              B2(1...N) (INPUT)                     *00012000
C****     T (INPUT)               B(1...N) (OUTPUT; LINEAR INTERP.)    *00013000
C***********************************************************************00014000
C****         MD         LIMITS OF FUNCTION                            *00015000
C****          0          UNLIMITED                                    *00016000
C****          1          0 TO PI                                      *00017000
C****          2          - PI TO + PI                                 *00018000
C****          3          0 TO 360                                     *00019000
C****          4          - 90 TO + 90  ( <-- ADDED BY JAJ 86-APR19 )  *00019000
C***********************************************************************00020000
C****  T1<0  ---> DO NOT USE B1  ****  T2<0  ---> DO NOT USE B2        *00021000
C****                    T1=T2  ---> USE B1 ONLY                       *00022000
C***********************************************************************00023000
C**** FOR N=9 & MD=0, TREAT B AS A 3X3 MATRIX & NORMALIZE BY ROWS      *00024000
C***********************************************************************00025000
      IF (MD.EQ.0)  GO TO 10                                            00026000
C**** COMPUTE RANGE AND HALF RANGE                                      00027000
      RG = RU(MD) - RL(MD)                                              00028000
      RGH = .5E0*RG                                                     00029000
C**** COMPUTE LINEAR INTERPOLATION COEFFICIENTS                         00030000
   10 IF (T1.GE.0.D0) GO TO 20                                          00031000
      IF (T2.LT.0.D0)  GO TO 99                                         00032000
      ALF = 0.E0                                                        00033000
      BET = 1.E0                                                        00034000
      GO TO 40                                                          00035000
   20 IF (T2.GE.0.D0.AND.T1.NE.T2)  GO TO 30                            00036000
      ALF = 1.E0                                                        00037000
      BET = 0.E0                                                        00038000
      GO TO 40                                                          00039000
   30 ALF = (T2 - T)/(T2 - T1)                                          00040000
      BET = (T - T1)/(T2 - T1)                                          00041000
C**** DO THE INTERPOLATION                                              00042000
   40 DO 50  I = 1,N                                                    00043000
      B(I) = ALF*B1(I) + BET*B2(I)                                      00044000
      IF (MD.EQ.0)  GO TO 50                                            00045000
C**** PUT B1 AND B2 WITHIN HALF-RANGE OF EACH OTHER                     00046000
      K = INT((B2(I) - B1(I))/RGH)                                      00047000
      B(I) = B(I) + RGH*ALF*(K + MOD(K,2))                              00048000
C**** PUT B WITHIN LIMITS                                               00049000
      B(I) = B(I) - RG*INT((B(I) - RL(MD))/RG)                          00050000
      IF (B(I).LT.RL(MD)) B(I) = B(I) + RG                              00051000
   50 CONTINUE                                                          00052000
      IF (N.NE.9.OR.MD.NE.0) RETURN                                     00053000
C**** NORMALIZE THE MATRIX                                              00054000
      DO 60  J = 1,7,3                                                  00055000
      FCT = SQRT(B(J)**2 + B(J+1)**2 + B(J+2)**2)                       00056000
      IF (FCT.EQ.0.E0)  GO TO 60                                        00057000
      B(J) = B(J)/FCT                                                   00058000
      B(J+1) = B(J+1)/FCT                                               00059000
      B(J+2) = B(J+2)/FCT                                               00060000
   60 CONTINUE                                                          00061000
      RETURN                                                            00062000
C**** ERROR                                                             00063000
   99 WRITE (6,2001) T1,T2                                              00064000
 2001 FORMAT (' SEDRIP ERROR: ',1P2D15.7)                               00065000
      RETURN                                                            00066000
      END                                                               00067000
      SUBROUTINE SEDRSV(T,PMAT)                                         00000100
C**** THIS ENTRY SAVES THE POSITION MATRIX PMAT OF THE MOST             00000200
C**** RECENT POINTING VECTOR. T IS THE TIME OF THIS VECTOR.             00000300
      REAL*8 DBLMAX/7.D75/,T,T1,T2,TS(6)/6*-1.D0/,DEL1,DEL2,DEL         00000400
      INTEGER*4 PMAT(9),PMAT1(9),PMAT2(9),KBUF(9,6),NMAX/6/             00000500
      INTEGER*4 IP/0/                                                   00000600
C**** IF A BUFFER WITH THE INPUT TIME ALREADY EXISTS, DO NOT            00000700
C**** SAVE PMAT.                                                        00000800
      DO 10  I = 1,NMAX                                                 00000900
      IF (T.EQ.TS(I)) RETURN                                            00001000
   10 CONTINUE                                                          00001100
C**** UPDATE THE BUFFER POINTER.                                        00001200
      IP = IP + 1                                                       00001300
      IF (IP.GT.NMAX)  IP = 1                                           00001400
C**** REPLACE THE CHOSEN BUFFER.                                        00001500
      TS(IP) = T                                                        00001600
      CALL FMOVE(KBUF(1,IP),36,PMAT)                                    00001700
      RETURN                                                            00001800
      ENTRY SEDRRT(T,T1,T2,PMAT1,PMAT2)                                 00001900
C**** THIS ENTRY RETURNS THE TWO POSITION MATRICES (FROM                00002000
C**** POINTING VECTORS) WITH TIMES T1 & T2 CLOSEST TO                   00002100
C**** INPUT TIME T.                                                     00002200
C****                                                                   00002300
C**** FIND THE TWO CLOSEST TIMES.                                       00002400
      IP1 = 1                                                           00002500
      IP2 = 2                                                           00002600
      DEL1 = DBLMAX                                                     00002700
      DEL2 = DBLMAX                                                     00002800
      DO 20 I = 1,NMAX                                                  00002900
      IF (TS(I).EQ.-1.D0)  GO TO 20                                     00003000
      DEL = DABS(T - TS(I))                                             00003100
      IF (DEL.GE.DEL2) GO TO 20                                         00003200
      IF (DEL.GE.DEL1) GO TO 30                                         00003300
      DEL2 = DEL1                                                       00003400
      DEL1 = DEL                                                        00003500
      IP2 = IP1                                                         00003600
      IP1 = I                                                           00003700
      GO TO 20                                                          00003800
   30 DEL2 = DEL                                                        00003900
      IP2 = I                                                           00004000
   20 CONTINUE                                                          00004100
C**** RETURN T1,T2,PMAT1,PMAT2                                          00004200
      T1 = TS(IP1)                                                      00004300
      T2 = TS(IP2)                                                      00004400
      CALL FMOVE (PMAT1,36,KBUF(1,IP1))                                 00004500
      CALL FMOVE (PMAT2,36,KBUF(1,IP2))                                 00004600
      RETURN                                                            00004700
      END                                                               00004800
