C $Id: ic_fetch_slp_coef.f,v 1.2 1998/07/24 21:54:28 asc Exp $
CCCC
C
C  IC_FETCH_SLP_COEF - return a group of coefficients from the SLP file
C 
C  PURPOSE:  Calculate the record-pair needed from the SLP file for a given
C            time and return the coefficients on that record-pair
C
C  UNIT TYPE:  SUBROUTINE
C
C  INVOCATION METHOD:  CALL FETCH_SLP_COEF (TIME,
C					    REQTIM,
C					    LUSLP,
C					    IERR)
C
C  ARGUMENT LIST:
C
C  NAME	                  TYPE   USE  DESCRIPTION
C  ----                   ----   ---  -----------
C  TIME                   R*8    I    TIME OF CALCULATION. FORMAT IS 
C                                      JULIAN DATE, CORRECTED TO A.1 TIME
C  REQTIM                 R*8    O    TIME VARIABLE TO BE USED FOR THE
C                                      EVALUATION OF THE CHEBYSHEV 
C                                      POLYNOMIAL
C  LUSLP                  I*4    I    FORTRAN LOGICAL UNIT NUMBER OF THE
C                                      SLP FILE
C  IERR                   I*4    O    OUTPUT ERROR FLAG
C
C  FILE/RECORD REFERENCES:
C
C  NAME 	  USE	    DESCRIPTION
C  ----	    	  ---       -----------
C  SLP FILE	  I	    SOLAR/LUNAR/PLANETARY EPHEMERIS (SLP) FILE
C
C  EXTERNAL VARIABLES:
C
C  SOURCE	NAME	       USE	DESCRIPTION
C  ------       ----           ---      -----------
C  ORLSPR       TSEC			Time of day in seconds
C		PPOLY1(3,20)		Position poly. coeff. for fast non-central body
C		VPOLY1(3,13)		Velocity poly. coeff. for fast body
C		PPOLY2(3,13,7)		
C		APOLY(3,3,10)		Not Used, Poly Coeffs. for A matrix
C		CPOLY(3,3,10)		Polynomial coefficients for the C matrix	
C		PDELH(10)		Coef. for nutation of Greenwich Hour Angle
C		IDAY			Day # within SLP of current record pair
C		IDAY1			1st day of the SLP file
C		IYEAR			1st year of the SLP file
C		ISPAN			Span of the SLP file in days
C		NBEPM(9)		Body index #s of all bodies listed in SLP file
C		NDEGRE(4)		degree of polynomial expansion for 
C					each quantity given in the SLP file
C		NCFDAY		
C		ISLP50			coordinate system of SLP file
C		NBSLP			# of bodies in SLP file (usually 9)
C		IHEADR		       Indicates if the SLP header has been read
C
C  EXTERNAL REFERENCES:
C	READ - FORTRAN READ
C
C  ABNORMAL TERMINATION CONDITIONS, ERROR MESSAGES:
C    If there is an error reading from the SLP file IERR is returned as follows:
C	IERR = error number  
C       IERR = 2    time out of range error
C
C  ASSUMPTIONS, CONSTRAINTS, RESTRICTIONS:
C
C  1.	Assumes that the SLP file has already been opened.
C
C  DEVELOPMENT HISTORY
C
C  AUTHOR	CHANGE ID	RELEASE	  DATE	    DESCRIPTION OF CHANGE
C  ------	---------	-------   ----	    ---------------------
C  C. RAYMOND (CSC)                       07/25/91  CODED USING IDEAS 
C                                                    HEAVILY BORROWED FROM
C                                                    EPHGEN PROGRAM.
C  J. LUBELCZYK (NASA)			  09/04/91  Corrected to meet
C						    SSDM standards
C  J. Lubelczyk				  09/12/91  Added error handling
C  J. LUBELCZYK ICCR #83, CCR #'S 130, 137 11/91    B3 update
C  B. SAMUELSON SPOF PORT       NONE      04/11/94  Change: required to port
C     (CSC)     (see notes)                          icss routines to SPOF
C  J. RIZZELLO  ICCR1847          R5.0    10/12/94  Added check for date
C                                                   outside range of SLP file
C  B. Samuelson UNIX PORT                 10/18/96  Updating unix versions 
C                                                   of icss routines that 
C                                                   have changed (see note 4)
C  
C
C  NOTES:  
C  1)  The COMMON block /ORSLPR/ is introduced only as a means for holding
C      the large amount of data that each pair of SLP file records contains
C      for a 10-day span of time.
C  2)  The changes recorded under ID SPOF-PORT are required to make the
C      ICSS coordinate conversion routines, originally developed under
C      VAX-VMS 5.4 run on the UNIX-based workstations of the SPOF.  (Sun
C      SPARCstations and DEC DECstations).  The changes are as follows:
C         a.  Delete references to ICSS_INC 
C         b.  Define Message texts or files to correspond to the messages
C             ICSS_SUCCESSFUL, etc. which are embedded in the error handling.
C         c.  Remove references to the NAG routines F01CRF and F01CKF (matrix
C             transposition and matrix multiplication routines).
C  3)  In addition, to successfully run the software packages, copies of the
C      Solar/Lunar/Planetary (SLP) file and timing coefficients file (TCC)
C      must be ported onto the SPOF.
C  4)  Removed vax specific error message number replaced with a 2.  The
C      error is a time out of range error
C  
CCCC
C
C  PDL:
C
C  IF HEADER FLAG WAS NOT SET THEN
C     READ HEADER 
C     IF ERROR READING THE HEADER THEN
C        SET IERR TO INDICATE ERROR READING FROM SLP FILE
C	 ABORT TO 999
C     ENDIF
C 
C     SET HEADER FLAG
C  ENDIF
C
C  CALCULATE offset from beginning of SLP file using TIME and 
C                                            header variables
C
C  CONVERT time offset to record-pair number
C
C  READ record-pair
C  IF ERROR READING THE RECORD PAIR THEN
C     SET IERR TO INDICATE ERROR READING FROM SLP FILE
C     ABORT TO 999
C  ENDIF
C
C  CALCULATE REQTIM
C
C999 CONTINUE
C  RETURN
C
CCCC
	SUBROUTINE IC_FETCH_SLP_COEF (TIME,REQTIM,LUSLP,IERR)
C
	IMPLICIT    none
C
C*  Calling parameters
C
	real*8	    TIME    !Time of calculation, Julian date, corrected to A1
	real*8	    REQTIM  !Used for the evaluation of the Chebyshev polynomial
	integer*4   LUSLP   !Logical unit number of the SLP file
	integer*4   IERR    !Output error flag
C
C*  Other Variables
C
	real*8	    DXJUL	!Julian ephemeris date at beginning of year
	integer*4   I, j, k		!Loop variable
	integer*4   NYEAR	!Used to calculate REQTIME
	real*8	    XJUL	!Used to calculate REQTIME
	real*8	    SET		!Used to calculate REQTIME
	real*8	    REQDAY	!Used to calculate REQTIME
	integer*4   IREQ	!Used to calculate REQTIME
	integer*4   IREQ1	!Used to calculate REQTIME
	integer*4   IREC        !Used to compute which
	integer*4   IREC1       !  record pair to get from
	integer*4   IREC2       !  the SLP file
	integer*4   STATUS	!temp status variable
C
	include 'orslpr.cmn'
C
C
C              STATEMENT FUNCTION DEFINITION FOR DXJUL -- JULIAN EPHEMERIS
C         DATE AT BEGINNING OF YEAR.
C
	DXJUL(I) = (-32075+1461*(I+4800-13/12)/4
     1              +367*(-1+13/12*12)/12
     2              -3*((I+4900-13/12)/100)/4)-0.5d0
C
C
C*  Start Executable Statements
C                                                                       
      IERR = 0
      IF (IHEADR .EQ. 0) THEN
	 READ (LUSLP,REC=1, IOSTAT=status) IDAY1,IYEAR,ISPAN,
     *      NBEPM,NDEGRE,NCFDAY,ISLP50,NBSLP

	 IF (STATUS .NE. 0) THEN
	    IERR = 1 
	    GOTO 999
         ENDIF
         IDAY=0
         IHEADR = 1
      ENDIF
C                                                                       
C  CALCULATE WHICH DATA RECORD TO BE READ                               
C
      NYEAR = IYEAR
      xjul = dXjul(NYEAR) + 1.0D0
      set = xjul + dfloat(iday1) - 1.0d0	
      REQDAY=TIME-set
      IREQ = REQDAY
      IREQ1 = IREQ + IDAY1 - 1                                          
      IF   (IREQ1 .GE. (IDAY -1)                                        
     *      .AND. IREQ1 .LT. (IDAY + NCFDAY - 1)                             
     *      .AND. IDAY .NE. 0)                                                
     *  GO TO 800                                                       
C      print *, 'fetch_slp: got here'
      IREC = IREQ / NCFDAY + 1                                         
      IREC1 = IREC * 2                                                  
      IREC2 = IREC1 + 1
      IF(IREC1 .LE. 1 .OR. IREC2 .GT. ((ISPAN * 2) + 1)) THEN
         IERR = 2
         GOTO 999
      ENDIF
C      print *, 'irec12: ', IREC1, IREC2
      READ (LUSLP,REC=IREC1,IOSTAT=STATUS)TSEC,PPOLY1,VPOLY1,
     *                                      APOLY,CPOLY,IDAY

C      print *, 'iday:', IDAY
      IF (STATUS .NE. 0) THEN
	 IERR = 1 
	 GOTO 999
      ENDIF
      READ (LUSLP,REC=IREC2,IOSTAT=STATUS)PPOLY2,PDELH                        

      IF (STATUS .NE. 0) THEN
	 IERR = 1 
	 GOTO 999
      ENDIF
  800 REQTIM=REQDAY-TSEC/86400.D0+DFLOAT(IDAY1)-1.0D0
  999 RETURN                                                            
      END                                                               
