c----------------------------------------------------------------------
c     2body:  Integrates restricted gravitational 2-body problem.
c----------------------------------------------------------------------
      program        twobody

      implicit       none

      character*2    itoc
      character*64   catsqz
      integer        iargc,         indlnb,         vsxynt
      integer        vsrc

      integer         stderr,      stdin,     stdout
      parameter     ( stderr = 0,  stdin = 5, stdout = 6 )

      real*8          s2r8
      real*8          r8arg
      integer         s2i4
      integer         i4arg
      character*128   sarg

      real*8          r8_never
      parameter     ( r8_never = -1.0d-60 )

      integer         i4_never 
      parameter     ( i4_never = -2 000 000 000 )

      integer        neq
      parameter    ( neq = 4 )

      integer        maxout
      parameter    ( maxout = 10 000 )

      real*8         y0(neq)
      real*8         vtout(maxout), vyout(maxout,neq),
     &               work(maxout)
      integer        ntout,         itout

      integer        ieq

      logical        ltrace
      parameter    ( ltrace = .true. )

      integer        maxdump
      parameter    ( maxdump = 50 )

      logical        vstrace
      parameter    ( vstrace = .true. )

      logical        lsodatrace
      parameter    ( lsodatrace = .false. )

      logical        ivs_ok

c----------------------------------------------------------------------
c     LSODA Variables.
c----------------------------------------------------------------------
      external       fcn,        jac

      real*8         y(neq)
      real*8         tbgn,       tend
      integer        itol
      real*8         rtol,       atol
      integer        itask,      istate,     iopt
      integer        lrw

      parameter    ( lrw = 22 + neq * 16 )
      real*8         rwork(lrw)

      integer        liw
      parameter    ( liw = 20 + neq )
      integer        iwork(liw)
      integer        jt

      real*8         tol
      real*8         default_tol
      parameter    ( default_tol = 1.0d-6 )

c----------------------------------------------------------------------
c     Common communication with routine 'fcn' in 'fcn.f' ...
c----------------------------------------------------------------------

      include       'fcn.inc'

c----------------------------------------------------------------------
c     Initialize parameters defined  in common block ...
c----------------------------------------------------------------------
      G = 1.0d0
      M = 1.0d0

c----------------------------------------------------------------------
c     Parse command line arguments (initial values) ...
c----------------------------------------------------------------------
      if( iargc() .lt. neq ) then
            write(0,*) '2body: Insufficient initial values specified '
     &                 //'on command line.'
            go to 900
      end if

      ivs_ok = .true.
      do ieq = 1 , neq
         y0(ieq) = r8arg(ieq,r8_never)
         if( y0(ieq) .eq. r8_never ) then
            write(0,*) '2body: Initial value ', ieq, ' unrecognizable ',
     &                 'as a real number.'
            ivs_ok = .false.
         end if
      end do
      if( .not. ivs_ok ) go to 900
      if( ltrace ) then
         call dvdump(y0,neq,'2body: initial values',0)
      end if

      tol = r8arg(neq+1,default_tol)

c----------------------------------------------------------------------
c     Get output times from standard input ...
c----------------------------------------------------------------------
      call dvfrom('-',vtout,ntout,maxout)
      if( ntout .le. 0 ) then
         write(0,*) 
         write(0,*) '2body: No output times read from standard in'
         write(0,*) '2body: Use (e.g.) dvmesh or dvgmesh to '//
     &              'generate output times.'
         write(0,*) 
         write(0,*) '2body: Sample usages:'
         write(0,*) 
         write(0,*) '2body: dvmesh  0.0 1.0 101 | 2body ... '
         write(0,*) '2body: dvgmesh 0.0 1.0 101 10 | 2body ...'
         write(0,*) 
         stop
      end if
      if( ltrace ) then
         if( ntout .le. maxdump ) then
            call dvdump(vtout,ntout,'2body: output times',0)
         else 
            call dvdmp1(vtout,work,
     &                  int(1.0d0 * ntout / maxdump + 0.5d0),
     &                  ntout,'2body: selected output times',0)
         end if
         write(0,*)
         write(0,*) '***** INITIAL TIME: ', vtout(1)
         write(0,*)
      end if

c----------------------------------------------------------------------
c     Set LSODA parameters ...
c----------------------------------------------------------------------
      itol = 1
      rtol = tol
      atol = tol
      itask = 1 
      iopt = 0
      jt = 2

c----------------------------------------------------------------------
c     Initialize the solution ...
c-----------------------------------------------------------------------
      call dvcopy(y0,y,neq)

c----------------------------------------------------------------------
c     Do the integration ...
c----------------------------------------------------------------------
      do itout = 1 , ntout
         do ieq = 1 , neq
            vyout(itout,ieq) = y(ieq)
         end do
         if( itout .eq. ntout ) go to 500
            
         istate = 1
c----------------------------------------------------------------------
c        Need these temporaries since lsoda overwrites tend ...
c----------------------------------------------------------------------
         tbgn = vtout(itout)
         tend = vtout(itout+1)
         call lsoda(fcn,neq,y,tbgn,tend,
     &              itol,rtol,atol,itask,    
     &              istate,iopt,rwork,lrw,iwork,liw,jac,jt)
         if( lsodatrace ) then
            write(0,1000) itout, ntout, vtout(itout), vtout(itout+1)
1000        format(' 2body: Step ',i4,'  t = ',1pe10.3,' .. ',1pe10.3)
            write(0,*) 'sode: lsoda reurns ', istate
         end if

         if( istate .lt. 0 ) then
            write(0,1500) istate, itout, ntout, vtout(itout),
     &                    vtout(itout+1)
1500        format(/' 2body: Error return ',i2,
     &              ' from integrator LSODA.'/
     &              ' 2body: At output time ',i5,' of ',i5/
     &              ' 2body: Interval ',1pe11.3,' .. ',1pe11.3/)
            go to 500
         end if
      end do

500   continue
      if( vstrace ) then
         do ieq = 1 , neq
            vsrc = vsxynt(catsqz(catsqz('y(',itoc(ieq)),')'),
     &                    0.0d0,vtout,vyout(1,ieq),itout)
         end do
      end if
      write(*,*) vtout(itout), ( vyout(itout,ieq) , ieq = 1 , neq )
      stop

900   continue
         write(0,*) 'usage: 2body <iv 1> <iv 2> ... <iv neq>'
         write(0,*) '                                      '
         write(0,*) '       2body reads requested output times'
         write(0,*) '       from standard input, one number '
         write(0,*) '       per line.'
      stop
      end
