*     ------------
*     PROGRAM VIEW
*     ------------
*
*     BDL-GF9612
*
*     This program allows to display the Chebychev Ephemerides SLP96
*     read in a direct access binary file SLP96.
*
*     Uses the subroutines JDDATE and DATEJD.
*
* --- Declarations -----------------------------------------------------
*
      implicit double precision (a-h,o-z)
      logical fexist
      integer dat1,dat2
      character rep
      character*40 fn
      character*8 body(11)
*
      parameter (lmin=232)
*
      dimension loc(11,3),coef(696)
*
      data body/
     .'MERCURY','VENUS','E-M BAR.','MARS','JUPITER','SATURN',
     .'URANUS','NEPTUNE','*','MOON','SUN'/
*
* --- Open the binary file SLP96 ---------------------------------------
*
100   continue
*
      write (*,1000)
      write (*,1001)
      read (*,'(a)') fn
      inquire (file=fn,exist=fexist)
      if (.not.fexist) goto 100
*
      lrec=lmin
      open (10,file=fn,access='direct',recl=lrec,status='old')
      read (10,rec=1) idf,tla,tlb,delta,ncoef,nblock,nbytes,loc
      if (idf.ne.96) goto 500
*
      close (10)
      call JDDATE (tla,dat1,ih)
      call JDDATE (tlb,dat2,ih)
*
      write (*,1000)
      write (*,1002) fn,idf,tla,dat1,tlb,dat2,delta,ncoef,nblock,nbytes
      read (*,*)
*
      open (10,file=fn,access='direct',recl=nbytes,status='old',
     .      iostat=nerr)
      if (nerr.ne.0) goto 500
*
* --- Type of display --------------------------------------------------
*
200   continue
*
      write (*,1000)
      write (*,1003)
      read (*,'(i2)',iostat=nerr) ichoice
      if (nerr.ne.0) goto 200
      if (ichoice.lt.0.or.ichoice.gt.2) goto 200
*
      if (ichoice.eq.0) then
         close (10)
         write (*,1004)
         read (*,*)
         stop
      endif
*
      if (ichoice.eq.1) then
         write (*,1005) nblock
         read (*,'(i6)',iostat=nerr) nrec
         if (nerr.ne.0) goto 200
         if (nrec.lt.2.or.nrec.gt.nblock) goto 200
      else
         write (*,1006) dat1,dat2
         read (*,'(i10)',iostat=nerr) idat
         if (nerr.ne.0) goto 200
         call DATEJD (idat,0,t)
         if (t.lt.tla.or.t.gt.tlb) goto 200
         nrec=(t-tla)/delta+2
         if (t.eq.tlb) nrec=nrec-1
      endif
*
* --- Display the Chebychev coefficients tables ------------------------
*
300   continue
*
      read (10,rec=nrec) dj0,(coef(i),i=1,ncoef)
*
      do j=1,11
*
         if (loc(j,3).ne.0) then
*
            dlt=loc(j,2)
            ncf=loc(j,3)
            ni=delta/dlt
*
            do n=1,ni
*
               iad=loc(j,1)+3*(n-1)*ncf-1
               tj1=dj0+(n-1)*dlt
               tj2=tj1+dlt
               call JDDATE (tj1,idat1,ih)
               call JDDATE (tj2,idat2,ih)
               write (*,1007) fn,body(j),tj1,tj2,idat1,idat2,nrec,n
*
               do i=1,ncf
                  i0=i-1
                  i1=iad+i
                  i2=i1+ncf
                  i3=i2+ncf
                  write (*,1008) i0,coef(i1),coef(i2),coef(i3)
               enddo
*
               write (*,1009)
               read (*,*)
*
            enddo
*
         endif
*
      enddo
*
* --- Exit -------------------------------------------------------------
*
400   continue
*
      write (*,1000)
      rep='$'
      write (*,1010)
      read (*,'(a)') rep
*
      if (rep.eq.'0') then
         close (10)
         write (*,1004)
         read (*,*)
         stop
      endif
*
      if (rep.eq.'=') goto 300
*
      if (rep.eq.'+') then
         nrec=min0(nblock,nrec+1)
         goto 300
      endif
*
      if (rep.eq.'-') then
         nrec=max0(2,nrec-1)
         goto 300
      endif
*
      if (rep.eq.'D'.or.rep.eq.'d') goto 200
*
      if (rep.eq.'F'.or.rep.eq.'f') then
         close (10)
         goto 100
      endif
*
      goto 400
*
* --- Error ------------------------------------------------------------
*
500   continue
      write (*,1011)
      read (*,*)
      close (10)
      goto 100
*
* --- Formats ----------------------------------------------------------
*
1000  format (///2x,'SLP96 : DISPLAY (BDL-GF9612)'/)
1001  format (/2x,'Name of SLP96 binary file : ',$)
1002  format (/2x,'CHEBYCHEV EPHEMERIDES SLP96'/
     .        /2x,'file   : ',a40
     .        /2x,'idf    : ',i2
     .        /2x,'tla    : JD ',f9.1,2x,'Date ',i8,
     .        /2x,'tlb    : JD ',f9.1,2x,'Date ',i8,
     .        /2x,'delta  : ',f4.1,' days'
     .        /2x,'ncoef  : ',i5.5
     .        /2x,'nblock : ',i5.5
     .        /2x,'nbytes : ',i5.5/
     .        /2x,'Press Enter')
1003  format (/2x,'Type of display :'/
     .        /2x,'1 : with block number'
     .        /2x,'2 : with calendar date'/
     .        /2x,'Enter your choice (0 : Stop)  ? ',$)
1004  format (/2x,'Program ended : Press Enter'/)
1005  format (//2x,'Enter a block number between 00002 and ',i5.5,
     .        2x,'? ',$)
1006  format (//2x,'Enter a date (yyyymmdd) between ',i8,' and ',i8,
     .        2x,'? ',$)
1007  format (///2x,'SLP96 CHEBYCHEV EPHEMERIDES SLP96',3x,a//
     .        2x,a8,2(2x,'JD',f9.1),2x,2i9,
     .        2x,'Block ',i5.5,2x,'Sub',i2/)
1008  format (2x,i2,3(d24.16))
1009  format (/2x,'Press Enter')
1010  format (/2x,'Options :'/
     .        /2x,'0 : Stop'/
     .        /2x,'= : Current block'
     .        /2x,'+ : Next block'
     .        /2x,'- : Previous block'
     .        /2x,'d : New type of display'
     .        /2x,'f : Another SLP96 file'/
     .        /2x,'Enter your choice ? : ',$)
1011  format (/2x,'File error : Press Enter'/)
*
      end
*
*
*
      subroutine JDDATE (tjd,idate,ihour)
*-----------------------------------------------------------------------
*
*     Ref : BDL/GF   J. Meeus Algorithm.
*
*     Object :
*     Convert julian date to calendar date.
*
*     Input :
*     tjd         julian date (real dp).
*
*     Output :
*     idate       calendar date - gregorian/julian (integer).
*                 code *yyyymmdd (* sign).
*     ihour       hour (integer).
*                 code hhmmss.
*
*-----------------------------------------------------------------------
*
      implicit double precision (a-h,o-z)
*
      idate=0
      ihour=0
*
      if (tjd.lt.0.d0) return
*
      t=tjd+0.5d0/86400.d0+0.5d0
      z=dint(t)
      f=t-z
*
      if (z.lt.2299161.d0) then
         a=z
      else
         x=dint((z-1867216.25d0)/36524.25d0)
         a=z+1.d0+x-dint(x/4.d0)
      endif
*
      b=a+1524.d0
      c=dint((b-122.1d0)/365.25d0)
      d=dint(365.25d0*c)
      e=dint((b-d)/30.6001d0)
      iday=b-d-dint(30.6001d0*e)
      month=e-1.d0
*
      if (e.lt.13.5d0) then
         month=e-1.d0
      else
         month=e-13.d0
      endif
*
      if (month.lt.3) then
         ky=c-4715.d0
      else
         ky=c-4716.d0
      endif
*
      is=+1
      if (ky.lt.0) is=-1
      idate=((abs(ky)*100+month)*100+iday)*is
      f=f*24.d0
      ih=f
      f=(f-ih)*60.d0
      im=f
      f=(f-im)*60.d0
      is=f
      ihour=(ih*100+im)*100+is
*
      return
      end
*
*
*
      subroutine DATEJD (idate,ihour,tjd)
*-----------------------------------------------------------------------
*
*     Ref : BDL/GF   J. Meeus Algorithm.
*
*     Object :
*     Convert a calendar date to julian date.
*
*     Input :
*     idate       calendar date - gregorian/julian (integer).
*                 code *yyyymmdd (* sign).
*     ihour       hour (integer).
*                 code hhmmss.
*
*     Output :
*     tjd         julian date (real dp).
*
*-----------------------------------------------------------------------
*
      implicit double precision (a-h,o-z)
*
      tjd=0.d0
*
      iday=idate
      ky=iday/10000
      if (ky.lt.-4713) return
      iday=abs(iday-ky*10000)
      month=iday/100
      if (month.lt.1.or.month.gt.12) return
      iday=iday-month*100
      if (iday.lt.0.or.iday.gt.31) return
*
      is=ihour
      ih=ihour/10000
      if (ih.lt.0.or.ih.gt.24) return
      is=is-ih*10000
      im=is/100
      if (im.lt.0.or.im.gt.60) return
      is=is-im*100
      if (is.lt.0.or.is.gt.60) return
*
      a=0.d0
      b=0.d0
      c=0.d0
*
      if (month.gt.2) then
         y=ky
         m=month
      else
         y=ky-1
         m=month+12
      endif
*
      if (y.lt.0.d0) then
         c=-0.75d0
      else
         if (idate.ge.15821015) then
            a=dint(y/100.d0)
            b=2.d0-a+dint(a/4.d0)
         endif
      endif
*
      tjd=dint(365.25d0*y+c)+dint(30.6001d0*(m+1))+iday+
     .    dfloat(ih)/24.d0+dfloat(im)/1440.d0+dfloat(is)/86400.d0+
     .    1720994.5d0+b
*
      return
      end
