C =====================================================================
C TREECODE: Fortran77 version of hierarchical N-body code (O(N log N)).

C     This program evolves a self-gravitating N-body system, using
C     a hierarchical O(N log N) algorithm to compute gravitational
C     forces (see Barnes, J.E. & Hut, P. 1986, Nature, 324, 446).
C     The computational system of units is determined by the input
C     data, with the assumption that G = 1.  Particles are not
C     required to have identical masses.

C     This code is based on a Fortran implementation of the
C     hierarchical algorithm developed and kindly provided by
C     Lars Hernquist.  Several additional refinments by Jun Makino
C     have been incorporated as well.

C     The present version of the code includes quadrupole moments
C     when calculating the gravitational fields of cells.  It also
C     incorporates an improved opening criterion which increases
C     the accuracy of the forces in certain exceptional situations.

C					Joshua Barnes
C					April 23, 1993
C =====================================================================



C ==============================================================
C TREECD: top-level N-body evolution program.  Its tasks are to:
C  *  read input parameters and initial conditions;
C  *  perform an initial force calculation, reporting
C     system diagnostics and time required;
C  *  advance the system for NSTEPS time-steps, periodically
C     saving a snapshot of the system;
C  *  terminate the simulation and close data files.
C ==============================================================

      PROGRAM TREECD

	INCLUDE 'treedefs.f'
	INTEGER NDIAG, N

C       ---------------------
C       Initialize cpu timer.
C       ---------------------
	CALL SECOND(CPUT0)
C	----------------------------------------------------------------
C	Open data files, read input parameters and initial system state,
C       initialize system parameters, and start output.
C	----------------------------------------------------------------
        CALL INPARM
        CALL GETBDS
        CALL INITCD
        CALL BEGOUT
C       -----------------------------------------------
C	Generate tree and compute initial acceleration.
C	-----------------------------------------------
        CALL MKTREE
	CALL ACCEL
C	------------------------------------------
C	Output timing data and system diagnostics.
C	------------------------------------------
        CALL OUTTIM
        CALL OUTLOG
        CALL DIAGS
C       -----------------------------------------------
C       Set number of steps between diagnostic outputs.
C       -----------------------------------------------
	NDIAG = MAX(1, NSTEPS / 128)
C	=================================================================
C	Primary loop to advance system state for a given number of steps.
C	=================================================================
        DO 100 N = 1, NSTEPS
C	  ------------------------------------------------------
C	  Advance velocity by 1/2 step, positions by 1 timestep.
C	  ------------------------------------------------------
          CALL ADVVEL(DTIME / 2.0)
          CALL ADVPOS(DTIME)
C	  ----------------------------
C	  Create tree, compute forces.
C	  ----------------------------
          CALL MKTREE
          CALL ACCEL
C	  ----------------------------------------------------
C	  Advance velocity 1/2 step to synchronize tvel, tpos.
C	  ----------------------------------------------------
          CALL ADVVEL(DTIME / 2.0)
C	  ----------------------------------------------------
C	  At appropriate intervals, output system diagnostics.
C	  ----------------------------------------------------
          IF (MOD(N, NDIAG) .EQ. 0) THEN
            CALL OUTLOG
            CALL DIAGS
	  ENDIF
C         ----------------------------------------------
C	  At appropriate intervals, output system state.
C         ----------------------------------------------
          IF (MOD(N, NOUT) .EQ. 0)
     &      CALL PUTBDS(.FALSE.)
 100    CONTINUE
C	----------------------------------
C	Output final snapshot with masses.
C	----------------------------------
        CALL PUTBDS(.TRUE.)
C	------------------------------------------------------------------
C	Stop timing, write timing data, close files, terminate simulation.
C	------------------------------------------------------------------
        CALL OUTCPU
        CALL STPOUT
      END

C ----------------------------------------------------------
C INITCD: initialize system parameters that depend on either
C the input data or defined PARAMETERS.
C ----------------------------------------------------------

      SUBROUTINE INITCD
 
	INCLUDE 'treedefs.f'
 
C	---------------------------------------
C	Initialize position and velocity times.
C	---------------------------------------
        TPOS = TNOW
        TVEL = TNOW
C	---------------------------------
C	Initialize box coordinate system.
C	---------------------------------
	RSIZE = 4.0
      END

C ---------------------------------------------------------------
C ADVPOS: advance the positions of the bodies for a timestep DT.
C ---------------------------------------------------------------
 
      SUBROUTINE ADVPOS(DT)
      REAL*8 DT

	INCLUDE 'treedefs.f'
        INTEGER K, P

C	------------------------------------------------- 
C	Loop over all spatial coordinates for all bodies.
C	------------------------------------------------- 
        DO 20 K = 1, NDIM
          DO 10 P = 1, NBODY
            POS(P,K) = POS(P,K) + DT*VEL(P,K)
 10       CONTINUE
 20     CONTINUE
C	----------------------------------
C	Update position time, system time.
C	----------------------------------
        TPOS = TPOS+DT
        TNOW = TPOS
      END

C ----------------------------------------------------------------
C ADVVEL: advance the velocities of the bodies for a timestep dt.
C ----------------------------------------------------------------
 
      SUBROUTINE ADVVEL(DT)
      REAL*8 DT

	INCLUDE 'treedefs.f'
        INTEGER K, P

C	------------------------------------------------- 
C	Loop over all spatial coordinates for all bodies.
C	------------------------------------------------- 
        DO 20 K = 1, NDIM
          DO 10 P = 1, NBODY
            VEL(P,K) = VEL(P,K) + DT*ACC(P,K)
 10       CONTINUE
 20     CONTINUE
C	----------------------------------
C	Update velocity time, system time.
C	----------------------------------
        TVEL = TVEL+DT
        TNOW = TVEL
      END

C ----------------------------------------------------------------
C DIAGS: compute diagnostics for the system: total energy, total
C kinetic energy, total potential energy, angular momentum, center
C of mass coordinates, and center of mass velocity.
C ----------------------------------------------------------------
 
      SUBROUTINE DIAGS

	INCLUDE 'treedefs.f'
        INTEGER P, K
 
C       --------------------------------------------------------------
C       Check that tpos and tvel are synchronized to one part in 1000.
C       --------------------------------------------------------------
        IF (ABS(TPOS - TVEL) .GT. DTIME/1.0E3)
     &     CALL TERROR(' DIAGS: TIMES NOT SYNCHRONIZED')
C       ---------------------------------------------
C       Zero the accumulators for system diagnostics.
C       ---------------------------------------------
        MTOT = 0.0
        EKTOT = 0.0
        EPTOT = 0.0
        DO 10 K = 1, NDIM
          CMPOS(K) = 0.0
          CMVEL(K) = 0.0
          AMVEC(K) = 0.0
 10     CONTINUE
C       ----------------------------------------------------------
C       Loop over bodies to compute net mass and potential energy.
C       ----------------------------------------------------------
        DO 20 P = 1, NBODY
          MTOT = MTOT + MASS(P)
          EPTOT = EPTOT + 0.5 * MASS(P) * PHI(P)
 20     CONTINUE
C       -----------------------------------------------------------------
C       Compute net kinetic energy, center of mass position and velocity.
C       -----------------------------------------------------------------
        DO 30 K = 1, NDIM
          DO 40 P = 1, NBODY
            EKTOT = EKTOT + 0.5 * MASS(P) * VEL(P,K)**2
            CMPOS(K) = CMPOS(K) + MASS(P) * POS(P,K)
            CMVEL(K) = CMVEL(K) + MASS(P) * VEL(P,K)
 40       CONTINUE
          CMVEL(K) = CMVEL(K) / MTOT
          CMPOS(K) = CMPOS(K) / MTOT
 30     CONTINUE
C       ----------------------------
C       Compute total system energy.
C       ----------------------------
        ETOT = EKTOT + EPTOT
C       ---------------------------------------
C       Compute angular momentum of the system.
C       ---------------------------------------
        DO 50 P = 1, NBODY
          AMVEC(1) = AMVEC(1) + MASS(P) *
     &                 (POS(P,2)*VEL(P,3) - POS(P,3)*VEL(P,2))
          AMVEC(2) = AMVEC(2) + MASS(P) *
     &                 (POS(P,3)*VEL(P,1) - POS(P,1)*VEL(P,3))
          AMVEC(3) = AMVEC(3) + MASS(P) *
     &                 (POS(P,1)*VEL(P,2) - POS(P,2)*VEL(P,1))
 50     CONTINUE
C       ----------------------------------
C       Write diagnostics to the log file.
C       ----------------------------------
        CALL OUTDAG
      END

C -------------------------------------------------------------
C TERROR: terminate the program as the result of a fatal error,
C closing the output files and writing timing information.
C -------------------------------------------------------------

      SUBROUTINE TERROR(MSG)
      CHARACTER*(*) MSG

	INCLUDE 'treedefs.f'

C       ------------------------------------
C       Write error message to the log file.
C       ------------------------------------
        CALL OUTERR(MSG)
C       ---------------------------------------------------
C       Output timing data, close files, terminate the run.
C       ---------------------------------------------------
        CALL OUTCPU
        CALL STPOUT
	STOP
      END



C ============================================================
C TREEDEFS: include file with common definitions for TREECODE.
C ============================================================
 
C --------------------------------------------------------------
C Fundamental constants for treecode, not to be altered lightly.
C --------------------------------------------------------------
 
C NULL        value denoting pointer to nothing.
C NDIM        number of spatial dimensions.
C NSUBC       number of descendents per cell.
C NQUAD       number of independent quadrupole components.
 
        INTEGER NULL, NDIM, NSUBC, NQUAD
        PARAMETER(NULL = 0)
        PARAMETER(NDIM = 3)
        PARAMETER(NSUBC = 2**NDIM)
        PARAMETER(NQUAD = 2*NDIM - 1)
 
C -------------------------------------------------------
C Treecode control parameters, input from parameter file.
C -------------------------------------------------------
 
C HDLINE      identification string for the run.
C THETA       accuracy parameter.
C EPS         potential softening parameter.
C DTIME       N-body integration timestep.
C USQUAD      option to include quadrupole terms.
C NSTEPS      total number of timesteps in the simulation.
C NOUT        frequency of system record outputs.
 
        CHARACTER*32 HDLINE
        COMMON /TEXT/ HDLINE
 
        REAL*8 THETA, EPS, DTIME
        LOGICAL USQUAD
        INTEGER NSTEPS, NOUT
        COMMON /PARAMS/ THETA, EPS, DTIME, USQUAD, NSTEPS, NOUT
 
C ----------------------------------
C System status and diagnostic data.
C ----------------------------------
        
C TNOW        value of current system time.
C MTOT        total mass of system.
C EKTOT       total kinetic energy.
C EPTOT       total potential energy.
C ETOT        sum of KE and PE.
C CMPOS       position of center of mass.
C CMVEL       velocity of center of mass.
C AMVEC       total angular momentum vector.
C CPUMKT      cpu time used in last tree construction.
C CPUACC      cpu time used in last force calculation.
C CPUT0       baseline for computing total cpu time.
C NBTOT       total number of body-body interactions.
C NCTOT       total number of body-cell interactions.
C NTMAX       maximum number of interactions for any body.
C NTAVG       average number of interactions per body.
 
        REAL*8 TNOW, MTOT, EKTOT, EPTOT, ETOT, CMPOS(NDIM),
     &        CMVEL(NDIM), AMVEC(NDIM), CPUMKT, CPUACC
        DOUBLE PRECISION CPUT0
        INTEGER NBTOT, NCTOT, NTMAX, NTAVG
        COMMON /STATUS/ TNOW, MTOT, EKTOT, EPTOT, ETOT,
     &                  CMPOS, CMVEL, AMVEC, CPUMKT, CPUACC,
     &                  CPUT0, NBTOT, NCTOT, NTMAX, NTAVG
 
C ---------------------------
C Tree structure data arrays.
C ---------------------------
 
C Bodies and cells are used to represent the tree.  The information for a
C given node is distributed across a number of arrays.  Quantities defined
C for both bodies and cells, such as mass and position, are stored in
C arrays with indicies running from 1 to MXNODE.  Quantities defined only
C for bodies are stored in arrays with indicies running from 1 to MXBODY,
C while those defined only for cells are stored in arrays with indicies
C running from INCELL to MXNODE.  With this convention, indicies can refer
C to either bodies or cells without conflict, and the type is deduced by
C comparing the index to the index of the first cell.  During tree
C construction, descendent indicies are stored in the SUBP arrays:
C
C          +-------------------------------------------------------+
C ROOT --> | CELL: MASS, POS, RCRIT2, QUAD, SUBP:[/,o,/,/,/,/,o,/] |
C          +----------------------------------------|---------|----+
C                                                   |         |
C     +---------------------------------------------+         |
C     |                                                       |
C     |    +--------------------------------+                 |
C     +--> | BODY: MASS, POS, VEL, ACC, PHI |                 |
C          +--------------------------------+                 |
C                                                             |
C     +-------------------------------------------------------+
C     |
C     |    +-------------------------------------------------------+
C     +--> | CELL: MASS, POS, RCRIT2, QUAD, SUBP:[o,/,/,o,/,/,o,/] |
C          +--------------------------------------|-----|-----|----+
C                                                etc   etc   etc
 
C MXBODY      maximum number of bodies allowed.
C MXCELL      maximum number of cells allowed.
C INCELL      index of first cell in arrays.
C MXNODE      maximum number of nodes (bodies + cells).

C NBODY       number of bodies in the system.
C NCELL       number of cells currently in use.
C MASS        mass of each node.
C POS         position of each node.
C VEL         velocity of each body.
C ACC         acceleration of each body
C PHI         potential of each body.
C RCRIT2      critical distances**2 of each cell.
C QUAD        quad moments of each cell.
C SUBP        descendent of each cell.
C TPOS        current position time.
C TVEL        current velocity time.
C RSIZE       side-length of root cell.
C ROOT        index of cell representing root.
 
        INTEGER MXBODY, MXCELL, INCELL, MXNODE
        PARAMETER(MXBODY = 8192)
        PARAMETER(MXCELL = MXBODY)
        PARAMETER(INCELL = MXBODY + 1)
        PARAMETER(MXNODE = MXBODY + MXCELL)
 
        INTEGER NBODY, NCELL
        REAL*8 MASS(MXNODE), POS(MXNODE,NDIM)
        REAL*8 VEL(MXBODY,NDIM), ACC(MXBODY,NDIM), PHI(MXBODY)
        REAL*8 RCRIT2(INCELL:MXNODE), QUAD(INCELL:MXNODE,NQUAD)
        INTEGER SUBP(INCELL:MXNODE,NSUBC), ROOT
        REAL*8 TPOS, TVEL, RSIZE
        COMMON /NODES/ NBODY, NCELL, MASS, POS, VEL, ACC, PHI,
     &                 RCRIT2, QUAD, SUBP, TPOS, TVEL, RSIZE, ROOT
 
C These definitions apply only during tree construction.

C MID         geometric center of each cell [equiv to POS].
C CLSIZE      size of each cell [equiv to RCRIT2].

	REAL*8 MID(MXNODE,NDIM), CLSIZE(INCELL:MXNODE)
	EQUIVALENCE (MID(1,1), POS(1,1))
	EQUIVALENCE (CLSIZE(INCELL), RCRIT2(INCELL))



C --------------------------
C Input/output unit numbers.
C --------------------------
 
        INTEGER UTERM, UPARS, UBODI, UBODO, UBODF, ULOG
        PARAMETER(UTERM =  6, UPARS = 10, UBODI = 11)
        PARAMETER(UBODO = 12, UBODF = 13, ULOG  = 14)
	
	
	
	
C =============================================================
C TREEGRAV: routines to perform hierarchical force calculation.
C =============================================================



C --------------------------------------------------------
C ACCEL: routine to compute the acceleration and potential
C for all bodies in the system.
C --------------------------------------------------------

      SUBROUTINE ACCEL
 
	INCLUDE 'treedefs.f'
        DOUBLE PRECISION CPUT1, CPUT2
	INTEGER P

C       ----------------------------------------
C       Initialize timing for force calculation.
C       ----------------------------------------
        CALL SECOND(CPUT1)

C       --------------------------------------------
C       Initialize the force evaluation diagnostics.
C       --------------------------------------------
        NBTOT = 0
	NCTOT = 0
        NTMAX = 0
C	---------------------------------------------------
C	Loop over bodies, computing force for each in turn.
C	---------------------------------------------------
	DO 10 P = 1, NBODY
	  CALL TRWALK(P)

 10	CONTINUE
C       -----------------------------------------------
C       Compute average number of force terms per body.
C       -----------------------------------------------
        NTAVG = (NBTOT + NCTOT) / NBODY 
C       -------------------------------------
C       Compute timing for force calculation.
C       -------------------------------------
        CALL SECOND(CPUT2)
        CPUACC = CPUT2 - CPUT1
      END





C --------------------------------------------------------------
C TRWALK: recursive routine to walk the tree computing forces on
C particle P.
C --------------------------------------------------------------
 
      SUBROUTINE TRWALK(P)
      INTEGER P

	INCLUDE 'treedefs.f'
	INTEGER MXSPTR
	PARAMETER(MXSPTR = 256)
	REAL*8 EPS2, PHI0, ACC0(NDIM), POS0(NDIM)
        REAL*8 DX, DY, DZ, DR2, DR2INV, DRINV, PHIM, DR5INV, PHIQ
	INTEGER Q, NBTERM, NCTERM, SPTR, STACK(MXSPTR), K
	LOGICAL SKPSLF

	EPS2 = EPS*EPS
C	----------------------------------------------------------
C	Zero potential and acceleration for subsequent summations.
C	----------------------------------------------------------
        PHI0 = 0.0
        ACC0(1) = 0.0
        ACC0(2) = 0.0
        ACC0(3) = 0.0
C       -----------------------------------------
C       Copy position of P for quicker reference.
C       -----------------------------------------
        POS0(1) = POS(P,1)
        POS0(2) = POS(P,2)
        POS0(3) = POS(P,3)
C	----------------------------------------------
C	Initialize counters for number of force terms.
C	----------------------------------------------
        NBTERM = 0
        NCTERM = 0
	SKPSLF = .FALSE.
C	----------------------------------
C	Push the root cell onto the stack.
C	----------------------------------
        SPTR = 1
        STACK(SPTR) = ROOT
C	-------------------------------------
C	Loop while nodes on stack to process.
C	-------------------------------------
  10    IF (SPTR .GT. 0) THEN
C	  --------------------------
C	  Pop node off top of stack.
C	  --------------------------
          Q = STACK(SPTR)
          SPTR = SPTR - 1
C         ---------------------------------------------
C         Compute distance to center-of-mass of node Q.
C         ---------------------------------------------
          DX = POS0(1) - POS(Q,1)
          DY = POS0(2) - POS(Q,2)
          DZ = POS0(3) - POS(Q,3)
          DR2 = DX*DX + DY*DY + DZ*DZ
C	  -------------------------------
C	  Classify Q as a body or a cell.
C	  -------------------------------
          IF (Q .LT. INCELL) THEN
C	    -----------------------------------
C	    A body: check for self-interaction.
C	    -----------------------------------
	    IF (Q .NE. P) THEN
C             ------------------------------
C             Compute body-body interaction.
C             ------------------------------
              DR2INV = 1.0 / (DR2 + EPS2)
              PHIM = MASS(Q) * SQRT(DR2INV)
              PHI0 = PHI0 - PHIM
              PHIM = PHIM * DR2INV
              ACC0(1) = ACC0(1) - PHIM * DX
              ACC0(2) = ACC0(2) - PHIM * DY
              ACC0(3) = ACC0(3) - PHIM * DZ
	      NBTERM = NBTERM + 1
	    ELSE
C	      -------------------------------------------
C	      Remember that self-interaction was skipped.
C	      -------------------------------------------
	      SKPSLF = .TRUE.
            ENDIF
          ELSE
C           --------------------------------------------
C           A cell: test if interaction can be accepted.
C           --------------------------------------------
	    IF (DR2 .GE. RCRIT2(Q)) THEN
C             ----------------------------------------
C             Accepted: compute body-cell interaction.
C             ----------------------------------------
              DR2INV = 1.0 / (DR2 + EPS2)
              DRINV = SQRT(DR2INV)
              PHIM = MASS(Q) * DRINV
              PHI0 = PHI0 - PHIM
              PHIM = PHIM * DR2INV
              ACC0(1) = ACC0(1) - PHIM * DX
              ACC0(2) = ACC0(2) - PHIM * DY
              ACC0(3) = ACC0(3) - PHIM * DZ
C	      ------------------------------------
C	      Optionally include quadrupole terms.
C	      ------------------------------------
	      IF (USQUAD) THEN
                DR5INV = DR2INV * DR2INV * DRINV
                PHIQ = DR5INV *
     &              (0.5 * ((DX*DX - DZ*DZ) * QUAD(Q,1) +
     &                      (DY*DY - DZ*DZ) * QUAD(Q,4)) +
     &               DX*DY * QUAD(Q,2) + DX*DZ * QUAD(Q,3) +
     &               DY*DZ * QUAD(Q,5))
                PHI0 = PHI0 - PHIQ
                PHIQ = 5.0 * PHIQ * DR2INV
                ACC0(1) = ACC0(1) - PHIQ*DX + DR5INV *
     &              (DX*QUAD(Q,1) + DY*QUAD(Q,2) + DZ*QUAD(Q,3))
                ACC0(2) = ACC0(2) - PHIQ*DY + DR5INV *
     &              (DX*QUAD(Q,2) + DY*QUAD(Q,4) + DZ*QUAD(Q,5))
                ACC0(3) = ACC0(3) - PHIQ*DZ + DR5INV *
     &              (DX*QUAD(Q,3) + DY*QUAD(Q,5) -
     &               DZ*(QUAD(Q,1) + QUAD(Q,4)))
	      ENDIF
	      NCTERM = NCTERM + 1
            ELSE
C	      -----------------------------------
C	      Rejected: examine children of cell.
C	      -----------------------------------
              DO 20 K = 1, NSUBC
C		--------------------------------------
C		Push existing children onto the stack.
C		--------------------------------------
                IF (SUBP(Q,K) .NE. NULL) THEN
		  IF (SPTR .GE. MXSPTR)
     &		    CALL TERROR(' TRWALK: STACK OVERFLOW')
                  SPTR = SPTR + 1
                  STACK(SPTR) = SUBP(Q,K)
                ENDIF
 20           CONTINUE
	    ENDIF
          ENDIF
          GOTO 10
        ENDIF
C       ---------------------------------------------------
C       Check that self-interaction was explicitly skipped.
C       ---------------------------------------------------
        IF (.NOT. SKPSLF)
     &    CALL TERROR(' TRWALK: MISSED SELF-INTERACTION')
C       ----------------------------------------------
C       Copy total potential and acceleration to body.
C       ----------------------------------------------
        PHI(P) = PHI0
        ACC(P,1) = ACC0(1)
        ACC(P,2) = ACC0(2)
        ACC(P,3) = ACC0(3)
C       -------------------------------------
C       Update force calculation diagnostics.
C       -------------------------------------
        NBTOT = NBTOT + NBTERM
        NCTOT = NCTOT + NCTERM
        NTMAX = MAX(NTMAX, NCTERM + NBTERM)
      END


C ==================================
C TREEIO: I/O routines for TREECODE.
C ==================================

C --------------------------------------------------------------------
C INPARM: read in following input parameters:
C
C        hdline    : identification string for the run.
C        nsteps    : number of timesteps.
C        nout      : output system state once every nout steps.
C        dtime     : the timestep.
C        theta     : error tolerance; 0.0 => exact (PP) calculation.
C        eps       : potential softening parameter.
C        usquad    : option to include (.TRUE.) quadrupole terms.

C --------------------------------------------------------------------

      SUBROUTINE INPARM
 
	INCLUDE 'treedefs.f'
        CHARACTER*8 PARSFL
        PARAMETER(PARSFL = 'treepars')
 
C       -----------------------------------------------------
C       Open parameter file, read parameters, close the file.
C       -----------------------------------------------------
        OPEN(UNIT = UPARS, FILE = PARSFL, STATUS = 'OLD')
        READ (UPARS, '(A)') HDLINE

        READ (UPARS, *) NSTEPS, NOUT, DTIME, THETA, EPS, USQUAD

        CLOSE(UNIT = UPARS)
      END

C ---------------------------------------------------------
C GETBDS: read in particle data, assumed to be of the form:
C
C       nbody		: number of bodies.
C       ndim		: number of space dimensions.
C       time		: initial value of time.
C       mass(1)		: mass of first particle.
C       .......	
C       mass(n)		: mass of last particle.
C       x(1) y(1) z(1)	: position of first particle.
C       ..............
C       x(n) y(n) z(n)	: position of last particle.
C       u(1) v(1) w(1)	: velocity of first particle.
C       ..............
C       u(n) v(n) w(n)	: velocity of last particle.
C ---------------------------------------------------------

      SUBROUTINE GETBDS

	INCLUDE 'treedefs.f'
        CHARACTER*8 BODIFL
        PARAMETER(BODIFL = 'treebodi')
        INTEGER INDIM, P, K

C       --------------------
C       Open body data file.
C       --------------------

        OPEN(UNIT = UBODI, FILE = BODIFL, STATUS = 'OLD')

C       ------------------
C       Read in body data.
C       ------------------

        READ (UBODI, *) NBODY
        READ (UBODI, *) INDIM

C       ----------------------------------------------------------
C       Terminate the simulation if NBODY or INDIM not consistent.
C       ----------------------------------------------------------
        IF (NBODY .LE. 0 .OR. NBODY .GT. MXBODY .OR. INDIM .NE. NDIM)
     &    CALL TERROR(' GETBDS: INCONSISTENT OR ILLEGAL INPUTS')
C       --------------------------------------------
C       Read time, masses, positions and velocities.
C       --------------------------------------------

        READ (UBODI, *) TNOW
        DO 10 P = 1, NBODY
          READ (UBODI, *) MASS(P)
  10    CONTINUE
        DO 20 P = 1, NBODY
          READ (UBODI, *) (POS(P,K), K = 1, NDIM)
  20    CONTINUE
        DO 30 P = 1, NBODY
          READ (UBODI, *) (VEL(P,K), K = 1, NDIM)
  30    CONTINUE

C       --------------------
C       Close up input file.
C       --------------------
        CLOSE(UNIT = UBODI)
      END

C ----------------------------------------------------
C BEGOUT: initialize disk files for subsequent output.
C ----------------------------------------------------

      SUBROUTINE BEGOUT 

	INCLUDE 'treedefs.f'
        CHARACTER*8 BODOFL, BODFFL, LGFILE
        PARAMETER(BODOFL = 'treebodo')
        PARAMETER(BODFFL = 'treebodf')
        PARAMETER(LGFILE = 'treelogs')
 
C       --------------------------------
C       Open log file and output header.
C       --------------------------------
        OPEN(UNIT = ULOG, FILE = LGFILE, STATUS = 'NEW')
        CALL OUTHDR
C       ----------------------------
C       Open body data output files.
C       ----------------------------

        OPEN(UNIT = UBODO, FILE = BODOFL, STATUS = 'NEW')
        OPEN(UNIT = UBODF, FILE = BODFFL, STATUS = 'NEW')

      END
 
C ----------------------------------------------------------
C OUTHDR: write header to log file listing input parameters.
C ----------------------------------------------------------

      SUBROUTINE OUTHDR
 
	INCLUDE 'treedefs.f'
 
        WRITE (ULOG, '(/)')
        WRITE (ULOG, '(1X,72(''*''))')
        WRITE (ULOG, '(1X,''*'',70X,''*'')')
        WRITE (ULOG, '(1X,''*'',19X,1A32,19X,''*'')') HDLINE
        WRITE (ULOG, '(1X,''*'',70X,''*'')')
        WRITE (ULOG, '(1X,72(''*''))')
        WRITE (ULOG, '(1X,''*'',70X,''*'')')
        WRITE (ULOG, 30) NBODY, NSTEPS, NOUT, DTIME
 30     FORMAT(1X, '*', 4X, 'NBODY =', 1I7, 4X, 'NSTEPS =', 1I4, 4X,
     &         'NOUT =', 1I4, 4X, 'DTIME =', 1F7.3, 4X, '*')
        WRITE (ULOG, '(1X,''*'',70X,''*'')')

        WRITE (ULOG, 40) USQUAD, EPS, THETA
 40     FORMAT(1X, '*', 4X, 'USEQUAD =', 1L2, 7X, 'EPS =', 1F6.3, 5X,
     &         'THETA =', 1F5.2, 2X, 7X, 3X, 8X, '*')

        WRITE (ULOG, '(1X,''*'',70X,''*'')')

	WRITE (ULOG, '(1X,''*'',4X,1A10,1A30,26X,''*'')')
     &	       'OPTIONS:  ', 'IMPROVED ACCEPTANCE CRITERION '




        WRITE (ULOG, '(1X,''*'',70X,''*'')')
        WRITE (ULOG, '(1X,72(''*''))')
      END

C ---------------------------------------------------
C OUTTIM: write force calculation timing to log file.
C ---------------------------------------------------
 
      SUBROUTINE OUTTIM

	INCLUDE 'treedefs.f'

        WRITE (ULOG, '(/,1X,''     CPU TIME USED:'',3A16)')
     &         'MKTREE', 'ACCEL', 'TOTAL'
        WRITE (ULOG, '(1X,''       (SECONDS)   '',3F16.2)')
     &         CPUMKT, CPUACC, CPUMKT + CPUACC
      END

C --------------------------------------------------------
C OUTLOG: write force calculation diagnostics to log file.
C --------------------------------------------------------

      SUBROUTINE OUTLOG
 
	INCLUDE 'treedefs.f'
        DOUBLE PRECISION CPUT
 
C       -----------------------------
C       Get system-specific cpu time.
C       -----------------------------
        CALL SECOND(CPUT)
        CPUT = CPUT - CPUT0
C       -------------------------------------------------
C       OUTPUT CPU TIME AND FORCE EVALUATION DIAGNOSTICS.
C       -------------------------------------------------
        WRITE (ULOG, '(//)')

        WRITE (ULOG, '(1X,2A9,2A10,2A8,A9)') 'TIME', 'NCELL',
     &        'NBTOT', 'NCTOT', 'NTMAX', 'NTAVG', 'CPUTIME'
        WRITE (ULOG, '(1X,F9.3,I9,2I10,2I8,F9.2)')  TNOW, NCELL,
     &              NBTOT, NCTOT, NTMAX, NTAVG, CPUT/60.0

      END

C -------------------------------------------------
C OUTDAG: write N-body diagnostic data to log file.
C -------------------------------------------------
 
      SUBROUTINE OUTDAG

	INCLUDE 'treedefs.f'
        INTEGER K, IPRINT
        DATA IPRINT /0/

        WRITE (*, '(1X,I4,1X,6(1PE12.4))') IPRINT,
     &              (CMPOS(K), K = 1, NDIM), (CMVEL(K), K = 1, NDIM)
        IPRINT = IPRINT+1
C       ----------------------------------------------------------------
C       Write mass, energy, angular momentum, center of mass quantities.
C       ----------------------------------------------------------------
        WRITE (ULOG, '(/)')
        WRITE (ULOG, '(1X,4A16)') 'ETOT', 'EKIN', 'EPOT', 'MASS'
        WRITE (ULOG, '(1X,3F16.8,F16.8)') ETOT, EKTOT, EPTOT, MTOT
        WRITE (ULOG, '(/)')
        WRITE (ULOG, '(1X,16X,3A16)') 'X', 'Y', 'Z'
        WRITE (ULOG, '(1X, 8X,A8,3E16.6)')
     &         'JTOT', AMVEC(1), AMVEC(2), AMVEC(3)
        WRITE (ULOG, '(1X, 8X,A8,3E16.6)')
     &         'CMPOS', (CMPOS(K), K = 1, NDIM)
        WRITE (ULOG, '(1X, 8X,A8,3E16.6)')
     &         'CMVEL', (CMVEL(K), K = 1, NDIM)
      END

C -----------------------------------------------------------
C OUTERR: output error messages to the log file and terminal.
C -----------------------------------------------------------

      SUBROUTINE OUTERR(MSG)
      CHARACTER*(*) MSG

	INCLUDE 'treedefs.f'
 
C       ------------------------------------------------------
C       Write the message, surrounded by stars for visibility.
C       ------------------------------------------------------
        WRITE (ULOG, '(/,1X,72(''*''))')
        WRITE (ULOG, '(/,A)') MSG
        WRITE (ULOG, '(/,1X,72(''*''))')
C       ---------------------------
C       Repeat message to terminal.
C	---------------------------
        WRITE (UTERM, '(/,1X,72(''*''))')
        WRITE (UTERM, '(/,A)') MSG
        WRITE (UTERM, '(/,1X,72(''*''))')
      END

C -----------------------------------------------
C OUTCPU: output cpu timing data to the log file.
C -----------------------------------------------

      SUBROUTINE OUTCPU

	INCLUDE 'treedefs.f'
        DOUBLE PRECISION CPUT

C       -----------------------------
C       Get system-specific cpu time.
C       -----------------------------
        CALL SECOND(CPUT)
        CPUT = CPUT - CPUT0
        WRITE (ULOG, '(//,'' ELAPSED CPU TIME (SECONDS) : '',F16.2)')
     &              CPUT
      END

C ------------------------------------------------------
C PUTBDS: write body data to output file or final file.
C ------------------------------------------------------







      SUBROUTINE PUTBDS(FINAL)
      LOGICAL FINAL
 
	INCLUDE 'treedefs.f'
 
C       ------------------------------------
C       Decide which file to use for output.
C       ------------------------------------
        IF (FINAL) THEN
C         -------------------------------------------
C         Output final coordinates, including masses.
C         -------------------------------------------

          WRITE (UBODF,  '(I20)') NBODY
          WRITE (UBODF,  '(I20)') NDIM
          WRITE (UBODF,  '(E20.12E2)') TNOW

          CALL PUTMAS(UBODF)
          CALL PUTPOS(UBODF)
          CALL PUTVEL(UBODF)
	ELSE
C	  ---------------------------------
C	  Output particle coordinates only.
C	  ---------------------------------

          WRITE (UBODO,  '(I20)') NBODY
          WRITE (UBODO,  '(I20)') NDIM
          WRITE (UBODO,  '(E20.12E2)') TNOW

          CALL PUTPOS(UBODO)
          CALL PUTVEL(UBODO)
        ENDIF
      END

C -------------------------------
C PUTMAS: output body mass array.
C -------------------------------

      SUBROUTINE PUTMAS(UBODY)
      INTEGER UBODY

	INCLUDE 'treedefs.f'
        INTEGER P


        DO 10 P = 1, NBODY
          WRITE (UBODY,  '(E20.12E2)') MASS(P)
  10    CONTINUE

      END

C -----------------------------------
C PUTPOS: output body position array.
C -----------------------------------

      SUBROUTINE PUTPOS(UBODY)
      INTEGER UBODY

	INCLUDE 'treedefs.f'
        INTEGER K, P


        DO 10 P = 1, NBODY
          WRITE (UBODY,  '(3E20.12E2)') (POS(P,K), K = 1, NDIM)
  10    CONTINUE

      END

C -----------------------------------
C PUTVEL: output body velocity array.
C -----------------------------------

      SUBROUTINE PUTVEL(UBODY)
      INTEGER UBODY

	INCLUDE 'treedefs.f'
        INTEGER K, P


        DO 10 P = 1, NBODY
          WRITE (UBODY,  '(3E20.12E2)') (VEL(P,K), K = 1, NDIM)
  10    CONTINUE

      END
 
C ----------------------------------------------
C STPOUT: terminate output and close open files.
C ----------------------------------------------

      SUBROUTINE STPOUT
 
	INCLUDE 'treedefs.f'
 
        WRITE (ULOG, '(//,1X,''CALCULATION TERMINATED'')')
C       ---------------------
C       Close the open files.
C       ---------------------
        CLOSE(UNIT = UBODO)
        CLOSE(UNIT = UBODF)
        CLOSE(UNIT = ULOG)
      END
C ================================================================
C TREELOAD: routines to handle tree construction and verification.
C ================================================================
 
C ----------------------------------------------------------------
C MKTREE: initialize the tree structure for the force calculation.
C ----------------------------------------------------------------
 
      SUBROUTINE MKTREE
 
        INCLUDE 'treedefs.f'
        DOUBLE PRECISION CPUT1, CPUT2
 
C       ----------------------------------
C       Start timing of tree construction.
C       ----------------------------------
        CALL SECOND(CPUT1)
C       --------------------------------------
C       Expand root volume to hold all bodies.
C       --------------------------------------
	CALL EXPBOX
C	--------------------------
C       Load bodies into the tree.
C	--------------------------
	CALL LDTREE
C       ------------------------------------------------
C       Compute masses, center of mass coordinates, etc.
C       ------------------------------------------------
        CALL HACKCM
C       -------------------------------------
C       Compute timing for tree construction.
C       -------------------------------------
        CALL SECOND(CPUT2)
        CPUMKT = CPUT2 - CPUT1
      END
 
C -----------------------------------------------------
C EXPBOX: enlarge system cube to include all particles.
C -----------------------------------------------------
 
      SUBROUTINE EXPBOX
 
        INCLUDE 'treedefs.f'
	REAL*8 XYZMAX
        INTEGER J, I
 
C       ------------------------------
C       Find maximum coordinate value.
C       ------------------------------
	XYZMAX = 0
        DO 10 J = 1, NDIM
	  DO 20 I = 1, NBODY
	    XYZMAX = MAX(XYZMAX, ABS(POS(I,J)))
  20	  CONTINUE
  10	CONTINUE
C	-----------------------------------------
C	Expand box by factors of 2 until it fits.
C	-----------------------------------------
  30	IF (XYZMAX .GE. RSIZE/2.0) THEN
	  RSIZE = 2.0 * RSIZE
	  GOTO 30
	ENDIF
      END



C ---------------------------------------------------------------------
C LDTREE: construct tree body-by-body.  This phase initializes the SUBP
C array and loads the geometric midpoint into the MID of each cell.
C ---------------------------------------------------------------------

      SUBROUTINE LDTREE

	INCLUDE 'treedefs.f'
        INTEGER MKCELL, K, P

C       ---------------------------------------
C       Deallocate current tree, begin new one.
C       ---------------------------------------
        NCELL = 0
        ROOT = MKCELL()
C	------------------------------------------
C	Initialize midpoint and size of root cell.
C	------------------------------------------
	DO 10 K = 1, NDIM
	  MID(ROOT,K) = 0.0
  10	CONTINUE
	CLSIZE(ROOT) = RSIZE
C       ---------------------------------------------
C       Load bodies into the new tree, one at a time.
C       ---------------------------------------------
        DO 20 P = 1, NBODY
          CALL LDBODY(P)
  20    CONTINUE
      END
 
C ----------------------------------------
C LDBODY: load body P into tree structure.
C ----------------------------------------
 
      SUBROUTINE LDBODY(P)
      INTEGER P
 
        INCLUDE 'treedefs.f'
        INTEGER Q, QIND, SBINDX, MKCELL, C, K, P0

C       ---------------------------------------------
C       Start Q,QIND pair in correct subcell of root.
C       ---------------------------------------------
        Q = ROOT
        QIND = SBINDX(P, Q)
C       -----------------------------------------------------
C       Loop descending tree until an empty subcell is found.
C       -----------------------------------------------------
  20    IF (SUBP(Q, QIND) .NE. NULL) THEN
C         --------------------------------------
C         On reaching another body, extend tree.
C         --------------------------------------
          IF (SUBP(Q, QIND) .LT. INCELL) THEN
C           -------------------------------------------
C           Allocate an empty cell to hold both bodies.
C           -------------------------------------------
            C = MKCELL()
C           ------------------------------------------------------
C           Locate midpoint of new cell wrt. parent, and set size.
C           ------------------------------------------------------
            DO 30 K = 1, NDIM
              IF (POS(P,K) .GE. MID(Q,K)) THEN
                MID(C,K) = MID(Q,K) + CLSIZE(Q)/4.0
              ELSE
                MID(C,K) = MID(Q,K) - CLSIZE(Q)/4.0
              ENDIF
  30        CONTINUE
	    CLSIZE(C) = CLSIZE(Q) / 2.0
C           ------------------------------------------------------
C           Store old body in appropriate subcell within new cell.
C           ------------------------------------------------------
            P0 = SUBP(Q, QIND)
            SUBP(C, SBINDX(P0, C)) = P0
C           ---------------------------------------------
C           Link new cell into tree in place of old body.
C           ---------------------------------------------
            SUBP(Q, QIND) = C
          ENDIF
C         --------------------------------------------------------
C         At this point, the node indexed by Q,QIND is known to be
C	  a cell, so advance to the next level of tree, and loop.
C         --------------------------------------------------------
          Q = SUBP(Q, QIND)
          QIND = SBINDX(P, Q)
          GOTO 20
        ENDIF
C       ---------------------------------------------
C       Found place in tree for P, so store it there.
C       ---------------------------------------------
        SUBP(Q, QIND) = P
      END
 
C -------------------------------------------------------
C SBINDX: compute subcell index for node P within cell Q.
C -------------------------------------------------------
 
      INTEGER FUNCTION SBINDX(P, Q)
      INTEGER P, Q
 
        INCLUDE 'treedefs.f'
        INTEGER K
 
C       ---------------------------------------------------
C       Initialize subindex to point to lower left subcell.
C       ---------------------------------------------------
        SBINDX = 1
C       ---------------------------------
C       Loop over all spatial dimensions.
C       ---------------------------------
        DO 10 K = 1, NDIM
          IF (POS(P,K) .GE. MID(Q,K))
     &      SBINDX = SBINDX + 2 ** (3 - K)
 10     CONTINUE
      END
 
C ---------------------------------------------------------
C MKCELL: function to allocate a cell, returning its index.
C ---------------------------------------------------------
 
      INTEGER FUNCTION MKCELL()
 
        INCLUDE 'treedefs.f'
        INTEGER I
 
C       ----------------------------------------------------------
C       Terminate simulation if no remaining space for a new cell.
C       ----------------------------------------------------------
        IF (NCELL .GE. MXCELL)
     &    CALL TERROR(' MKCELL: NO MORE MEMORY')
C       ----------------------------------------------------
C       Increment cell counter, initialize new cell pointer.
C       ----------------------------------------------------
        NCELL = NCELL + 1
        MKCELL = NCELL + MXBODY
C       --------------------------------------
C       Zero pointers to subcells of new cell.
C       --------------------------------------
        DO 10 I = 1, NSUBC
          SUBP(MKCELL,I) = NULL
 10     CONTINUE
      END
 
C ----------------------------------------------------------------
C HACKCM: compute cell masses, c.m. positions, check tree structure,
C assign critical radii, and compute quadrupole moments.  Whew!
C ----------------------------------------------------------------
 
      SUBROUTINE HACKCM
 
        INCLUDE 'treedefs.f'
        INTEGER IND(MXCELL), P, Q, I, J, K, L, M, N
	REAL*8 POS0(NDIM), DIST2
 
C       ---------------------------------------
C       List cells in order of decreasing size.
C       ---------------------------------------
        CALL BFLIST(IND)
C       --------------------------------------------
C       Loop processing cells from smallest to root.
C       --------------------------------------------
        DO 10 I = NCELL, 1, -1
          P = IND(I)
C         --------------------------------------------------------------
C         Zero accumulators for this cell.  A temporary variable is used
C	  for the c. of m. so as to preserve the stored midpoints.
C         --------------------------------------------------------------
          MASS(P) = 0.0
          DO 20 K = 1, NDIM
            POS0(K) = 0.0
  20      CONTINUE
C         -------------------------------------------------------------
C         Compute cell properties as sum of properties of its subcells.
C         -------------------------------------------------------------
          DO 30 J = 1, NSUBC
            Q = SUBP(P,J)
C           ------------------------------
C           Only access cells which exist.
C           ------------------------------
            IF (Q .NE. NULL) THEN
C             -------------------------------------------------------
C             Sum properties of subcells to obtain values for cell P.
C             -------------------------------------------------------
              MASS(P) = MASS(P) + MASS(Q)
              DO 40 K = 1, NDIM
                POS0(K) = POS0(K) + MASS(Q) * POS(Q,K)
  40          CONTINUE
            ENDIF
  30      CONTINUE
C         --------------------------------------------------------
C         Normalize center of mass coordinates by total cell mass.
C         --------------------------------------------------------
          DO 50 K = 1, NDIM
            POS0(K) = POS0(K) / MASS(P)
  50      CONTINUE 
C         -----------------------------------------------------------------
C         Check tree, compute cm-to-mid distance, and assign cell position.
C         -----------------------------------------------------------------
          DIST2 = 0.0
          DO 60 K = 1, NDIM
            IF (POS0(K) .LT. MID(P,K) - CLSIZE(P)/2.0 .OR.
     &		  POS0(K) .GE. MID(P,K) + CLSIZE(P)/2.0) THEN
              WRITE(ULOG, '(/,1X,''TREE ERROR'',2I6,3E14.6)')
     &              P, K, POS0(K), MID(P,K), CLSIZE(P)
              CALL TERROR(' HACKCM: TREE STRUCTURE ERROR')
            ENDIF
            DIST2 = DIST2 + (POS0(K) - MID(P,K))**2
C	    --------------------------------------------------------
C	    Copy cm position to cell.  This overwrites the midpoint.
C	    --------------------------------------------------------
	    POS(P,K) = POS0(K)
  60      CONTINUE

C	  ------------------------------------------------------------
C	  Assign critical radius for cell, adding offset from midpoint
C	  for more accurate forces.  This overwrites the cell size.
C	  ------------------------------------------------------------
          RCRIT2(P) = (CLSIZE(P) / THETA + SQRT(DIST2))**2

  10    CONTINUE
C	----------------------------------------
C	Compute quadrupole moments, if required.
C	----------------------------------------
	IF (USQUAD) THEN
C         -------------------------------
C         Loop processing cells as above.
C         -------------------------------
          DO 70 I = NCELL, 1, -1
            P = IND(I)
C           --------------------------------------------
C           Zero accumulator for quad moments of cell P.
C           --------------------------------------------
            DO 80 K = 1, NQUAD
              QUAD(P,K) = 0.0
  80        CONTINUE
C           --------------------------------
C           Loop over descendents of cell P.
C           --------------------------------
	    DO 90 J = 1, NSUBC
	      Q = SUBP(P,J)
	      IF (Q .NE. NULL) THEN
C               --------------------------------------------------------
C               Sum properties of subcell Q to obtain values for cell P.
C               --------------------------------------------------------
                DO 100 M = 1, MIN(2,NDIM)
                  DO 110 N = M, NDIM
                    L = (M-1) * (NDIM-1) + N
                    QUAD(P,L) = QUAD(P,L) + 3.0 * MASS(Q) * 
     &                  (POS(Q,M) - POS(P,M)) * (POS(Q,N) - POS(P,N))
                    IF (M .EQ. N) THEN
                      DO 120 K = 1, NDIM
                        QUAD(P,L) = QUAD(P,L) - MASS(Q) * 
     &                      (POS(Q,K) - POS(P,K))**2
 120                  CONTINUE
                    ENDIF
C                   -------------------------------------------
C                   If Q itself is a cell, add its moments too.
C                   -------------------------------------------
                    IF (Q .GE. INCELL)
     &                QUAD(P,L) = QUAD(P,L) + QUAD(Q,L)
 110              CONTINUE
 100            CONTINUE
	      ENDIF
  90        CONTINUE
  70     CONTINUE
	ENDIF
      END

C -----------------------------------------------------------------
C BFLIST: list cells in breadth-first order, from largest (root) to
C smallest.  Thanks to Jun Makino for this elegant routine.
C -----------------------------------------------------------------
 
      SUBROUTINE BFLIST(IND)
      INTEGER IND(*)
 
        INCLUDE 'treedefs.f'
	INTEGER FACELL, LACELL, NACELL, K, I
 
C	-----------------------------------------
C	Start scan with root as only active cell.
C	-----------------------------------------
	IND(1) = ROOT
	FACELL = 1
	LACELL = 1
C	-----------------------------------
C	Loop while active cells to process.
C	-----------------------------------
  10	IF (FACELL .LE. LACELL) THEN
C	  ----------------------------------------------
C	  Start counting active cells in next iteration.
C	  ---------------------------------------------- 
	  NACELL = LACELL
C	  ---------------------------------------
C	  Loop over subcells of each active cell.
C	  ---------------------------------------
	  DO 20 K = 1, NSUBC
	    DO 30 I = FACELL, LACELL
C	      -------------------------------------------
C	      Add all cells on next level to active list.
C	      -------------------------------------------
	      IF (SUBP(IND(I),K) .GE. INCELL) THEN
		NACELL = NACELL + 1
		IND(NACELL) = SUBP(IND(I),K)
	      ENDIF
  30	    CONTINUE
  20	  CONTINUE
C	  ------------------------------------------------------
C	  Advance first and last active cell indicies, and loop.
C	  ------------------------------------------------------
	  FACELL = LACELL + 1
	  LACELL = NACELL
	  GOTO 10
	ENDIF
C	--------------------------------------------------
C	Above loop should list all cells; check the count.
C	--------------------------------------------------
	IF (NACELL .NE. NCELL)
     &    CALL TERROR('  BFLIST: INCONSISTENT CELL COUNT')
      END


C ==================================
C TREEIO: I/O routines for TREECODE.
C ==================================

C --------------------------------------------------------------------
C INPARM: read in following input parameters:
C
C        hdline    : identification string for the run.
C        nsteps    : number of timesteps.
C        nout      : output system state once every nout steps.
C        dtime     : the timestep.
C        theta     : error tolerance; 0.0 => exact (PP) calculation.
C        eps       : potential softening parameter.
C        usquad    : option to include (.TRUE.) quadrupole terms.

C --------------------------------------------------------------------

      SUBROUTINE INPARM
 
	INCLUDE 'treedefs.f'
        CHARACTER*8 PARSFL
        PARAMETER(PARSFL = 'treepars')
 
C       -----------------------------------------------------
C       Open parameter file, read parameters, close the file.
C       -----------------------------------------------------
        OPEN(UNIT = UPARS, FILE = PARSFL, STATUS = 'OLD')
        READ (UPARS, '(A)') HDLINE

        READ (UPARS, *) NSTEPS, NOUT, DTIME, THETA, EPS, USQUAD

        CLOSE(UNIT = UPARS)
      END

C ---------------------------------------------------------
C GETBDS: read in particle data, assumed to be of the form:
C
C       nbody		: number of bodies.
C       ndim		: number of space dimensions.
C       time		: initial value of time.
C       mass(1)		: mass of first particle.
C       .......	
C       mass(n)		: mass of last particle.
C       x(1) y(1) z(1)	: position of first particle.
C       ..............
C       x(n) y(n) z(n)	: position of last particle.
C       u(1) v(1) w(1)	: velocity of first particle.
C       ..............
C       u(n) v(n) w(n)	: velocity of last particle.
C ---------------------------------------------------------

      SUBROUTINE GETBDS

	INCLUDE 'treedefs.f'
        CHARACTER*8 BODIFL
        PARAMETER(BODIFL = 'treebodi')
        INTEGER INDIM, P, K

C       --------------------
C       Open body data file.
C       --------------------

        OPEN(UNIT = UBODI, FILE = BODIFL, STATUS = 'OLD')

C       ------------------
C       Read in body data.
C       ------------------

        READ (UBODI, *) NBODY
        READ (UBODI, *) INDIM

C       ----------------------------------------------------------
C       Terminate the simulation if NBODY or INDIM not consistent.
C       ----------------------------------------------------------
        IF (NBODY .LE. 0 .OR. NBODY .GT. MXBODY .OR. INDIM .NE. NDIM)
     &    CALL TERROR(' GETBDS: INCONSISTENT OR ILLEGAL INPUTS')
C       --------------------------------------------
C       Read time, masses, positions and velocities.
C       --------------------------------------------

        READ (UBODI, *) TNOW
        DO 10 P = 1, NBODY
          READ (UBODI, *) MASS(P)
  10    CONTINUE
        DO 20 P = 1, NBODY
          READ (UBODI, *) (POS(P,K), K = 1, NDIM)
  20    CONTINUE
        DO 30 P = 1, NBODY
          READ (UBODI, *) (VEL(P,K), K = 1, NDIM)
  30    CONTINUE

C       --------------------
C       Close up input file.
C       --------------------
        CLOSE(UNIT = UBODI)
      END

C ----------------------------------------------------
C BEGOUT: initialize disk files for subsequent output.
C ----------------------------------------------------

      SUBROUTINE BEGOUT 

	INCLUDE 'treedefs.f'
        CHARACTER*8 BODOFL, BODFFL, LGFILE
        PARAMETER(BODOFL = 'treebodo')
        PARAMETER(BODFFL = 'treebodf')
        PARAMETER(LGFILE = 'treelogs')
 
C       --------------------------------
C       Open log file and output header.
C       --------------------------------
        OPEN(UNIT = ULOG, FILE = LGFILE, STATUS = 'NEW')
        CALL OUTHDR
C       ----------------------------
C       Open body data output files.
C       ----------------------------

        OPEN(UNIT = UBODO, FILE = BODOFL, STATUS = 'NEW')
        OPEN(UNIT = UBODF, FILE = BODFFL, STATUS = 'NEW')

      END
 
C ----------------------------------------------------------
C OUTHDR: write header to log file listing input parameters.
C ----------------------------------------------------------

      SUBROUTINE OUTHDR
 
	INCLUDE 'treedefs.f'
 
        WRITE (ULOG, '(/)')
        WRITE (ULOG, '(1X,72(''*''))')
        WRITE (ULOG, '(1X,''*'',70X,''*'')')
        WRITE (ULOG, '(1X,''*'',19X,1A32,19X,''*'')') HDLINE
        WRITE (ULOG, '(1X,''*'',70X,''*'')')
        WRITE (ULOG, '(1X,72(''*''))')
        WRITE (ULOG, '(1X,''*'',70X,''*'')')
        WRITE (ULOG, 30) NBODY, NSTEPS, NOUT, DTIME
 30     FORMAT(1X, '*', 4X, 'NBODY =', 1I7, 4X, 'NSTEPS =', 1I4, 4X,
     &         'NOUT =', 1I4, 4X, 'DTIME =', 1F7.3, 4X, '*')
        WRITE (ULOG, '(1X,''*'',70X,''*'')')

        WRITE (ULOG, 40) USQUAD, EPS, THETA
 40     FORMAT(1X, '*', 4X, 'USEQUAD =', 1L2, 7X, 'EPS =', 1F6.3, 5X,
     &         'THETA =', 1F5.2, 2X, 7X, 3X, 8X, '*')

        WRITE (ULOG, '(1X,''*'',70X,''*'')')

	WRITE (ULOG, '(1X,''*'',4X,1A10,1A30,26X,''*'')')
     &	       'OPTIONS:  ', 'IMPROVED ACCEPTANCE CRITERION '




        WRITE (ULOG, '(1X,''*'',70X,''*'')')
        WRITE (ULOG, '(1X,72(''*''))')
      END

C ---------------------------------------------------
C OUTTIM: write force calculation timing to log file.
C ---------------------------------------------------
 
      SUBROUTINE OUTTIM

	INCLUDE 'treedefs.f'

        WRITE (ULOG, '(/,1X,''     CPU TIME USED:'',3A16)')
     &         'MKTREE', 'ACCEL', 'TOTAL'
        WRITE (ULOG, '(1X,''       (SECONDS)   '',3F16.2)')
     &         CPUMKT, CPUACC, CPUMKT + CPUACC
      END

C --------------------------------------------------------
C OUTLOG: write force calculation diagnostics to log file.
C --------------------------------------------------------

      SUBROUTINE OUTLOG
 
	INCLUDE 'treedefs.f'
        DOUBLE PRECISION CPUT
 
C       -----------------------------
C       Get system-specific cpu time.
C       -----------------------------
        CALL SECOND(CPUT)
        CPUT = CPUT - CPUT0
C       -------------------------------------------------
C       OUTPUT CPU TIME AND FORCE EVALUATION DIAGNOSTICS.
C       -------------------------------------------------
        WRITE (ULOG, '(//)')

        WRITE (ULOG, '(1X,2A9,2A10,2A8,A9)') 'TIME', 'NCELL',
     &        'NBTOT', 'NCTOT', 'NTMAX', 'NTAVG', 'CPUTIME'
        WRITE (ULOG, '(1X,F9.3,I9,2I10,2I8,F9.2)')  TNOW, NCELL,
     &              NBTOT, NCTOT, NTMAX, NTAVG, CPUT/60.0

      END

C -------------------------------------------------
C OUTDAG: write N-body diagnostic data to log file.
C -------------------------------------------------
 
      SUBROUTINE OUTDAG

	INCLUDE 'treedefs.f'
        INTEGER K, IPRINT
        DATA IPRINT /0/

        WRITE (*, '(1X,I4,1X,6(1PE12.4))') IPRINT,
     &              (CMPOS(K), K = 1, NDIM), (CMVEL(K), K = 1, NDIM)
        IPRINT = IPRINT+1
C       ----------------------------------------------------------------
C       Write mass, energy, angular momentum, center of mass quantities.
C       ----------------------------------------------------------------
        WRITE (ULOG, '(/)')
        WRITE (ULOG, '(1X,4A16)') 'ETOT', 'EKIN', 'EPOT', 'MASS'
        WRITE (ULOG, '(1X,3F16.8,F16.8)') ETOT, EKTOT, EPTOT, MTOT
        WRITE (ULOG, '(/)')
        WRITE (ULOG, '(1X,16X,3A16)') 'X', 'Y', 'Z'
        WRITE (ULOG, '(1X, 8X,A8,3E16.6)')
     &         'JTOT', AMVEC(1), AMVEC(2), AMVEC(3)
        WRITE (ULOG, '(1X, 8X,A8,3E16.6)')
     &         'CMPOS', (CMPOS(K), K = 1, NDIM)
        WRITE (ULOG, '(1X, 8X,A8,3E16.6)')
     &         'CMVEL', (CMVEL(K), K = 1, NDIM)
      END

C -----------------------------------------------------------
C OUTERR: output error messages to the log file and terminal.
C -----------------------------------------------------------

      SUBROUTINE OUTERR(MSG)
      CHARACTER*(*) MSG

	INCLUDE 'treedefs.f'
 
C       ------------------------------------------------------
C       Write the message, surrounded by stars for visibility.
C       ------------------------------------------------------
        WRITE (ULOG, '(/,1X,72(''*''))')
        WRITE (ULOG, '(/,A)') MSG
        WRITE (ULOG, '(/,1X,72(''*''))')
C       ---------------------------
C       Repeat message to terminal.
C	---------------------------
        WRITE (UTERM, '(/,1X,72(''*''))')
        WRITE (UTERM, '(/,A)') MSG
        WRITE (UTERM, '(/,1X,72(''*''))')
      END

C -----------------------------------------------
C OUTCPU: output cpu timing data to the log file.
C -----------------------------------------------

      SUBROUTINE OUTCPU

	INCLUDE 'treedefs.f'
        DOUBLE PRECISION CPUT

C       -----------------------------
C       Get system-specific cpu time.
C       -----------------------------
        CALL SECOND(CPUT)
        CPUT = CPUT - CPUT0
        WRITE (ULOG, '(//,'' ELAPSED CPU TIME (SECONDS) : '',F16.2)')
     &              CPUT
      END

C ------------------------------------------------------
C PUTBDS: write body data to output file or final file.
C ------------------------------------------------------







      SUBROUTINE PUTBDS(FINAL)
      LOGICAL FINAL
 
	INCLUDE 'treedefs.f'
 
C       ------------------------------------
C       Decide which file to use for output.
C       ------------------------------------
        IF (FINAL) THEN
C         -------------------------------------------
C         Output final coordinates, including masses.
C         -------------------------------------------

          WRITE (UBODF,  '(I20)') NBODY
          WRITE (UBODF,  '(I20)') NDIM
          WRITE (UBODF,  '(E20.12E2)') TNOW

          CALL PUTMAS(UBODF)
          CALL PUTPOS(UBODF)
          CALL PUTVEL(UBODF)
	ELSE
C	  ---------------------------------
C	  Output particle coordinates only.
C	  ---------------------------------

          WRITE (UBODO,  '(I20)') NBODY
          WRITE (UBODO,  '(I20)') NDIM
          WRITE (UBODO,  '(E20.12E2)') TNOW

          CALL PUTPOS(UBODO)
          CALL PUTVEL(UBODO)
        ENDIF
      END

C -------------------------------
C PUTMAS: output body mass array.
C -------------------------------

      SUBROUTINE PUTMAS(UBODY)
      INTEGER UBODY

	INCLUDE 'treedefs.f'
        INTEGER P


        DO 10 P = 1, NBODY
          WRITE (UBODY,  '(E20.12E2)') MASS(P)
  10    CONTINUE

      END

C -----------------------------------
C PUTPOS: output body position array.
C -----------------------------------

      SUBROUTINE PUTPOS(UBODY)
      INTEGER UBODY

	INCLUDE 'treedefs.f'
        INTEGER K, P


        DO 10 P = 1, NBODY
          WRITE (UBODY,  '(3E20.12E2)') (POS(P,K), K = 1, NDIM)
  10    CONTINUE

      END

C -----------------------------------
C PUTVEL: output body velocity array.
C -----------------------------------

      SUBROUTINE PUTVEL(UBODY)
      INTEGER UBODY

	INCLUDE 'treedefs.f'
        INTEGER K, P


        DO 10 P = 1, NBODY
          WRITE (UBODY,  '(3E20.12E2)') (VEL(P,K), K = 1, NDIM)
  10    CONTINUE

      END
 
C ----------------------------------------------
C STPOUT: terminate output and close open files.
C ----------------------------------------------

      SUBROUTINE STPOUT
 
	INCLUDE 'treedefs.f'
 
        WRITE (ULOG, '(//,1X,''CALCULATION TERMINATED'')')
C       ---------------------
C       Close the open files.
C       ---------------------
        CLOSE(UNIT = UBODO)
        CLOSE(UNIT = UBODF)
        CLOSE(UNIT = ULOG)
      END


/*
 * SECOND: returns elapsed CPU in seconds.  This version can be called
 * from fortran routines in double precision mode.
 */

#include <sys/types.h>
#include <sys/times.h>
#include <sys/param.h>

#ifndef HZ
#  include <time.h>
#  define HZ CLK_TCK
#endif

second_(t)			
double *t;
{
    struct tms buffer;
        
    if (times(&buffer) == -1) {
	printf("times() call failed\n");
	exit(1);
    }
    *t =  buffer.tms_utime / (double) HZ;
}



OFF-AXIS PARABOLIC COLLISION    
         768
           8
  0.03125000
  1.00000000
  0.02500000
     .FALSE.
           8

# Compile UNIX (SUN) version of treecode.

FFLAGS = -O 

OBJECTS  = treecode.o treeio.o treeload.o treegrav.o second.o

treecode: $(OBJECTS)
	f77 $(FFLAGS) -o treecode \
	    $(OBJECTS) -lm

treecode.o: treedefs.f treecode.f
	f77 $(FFLAGS) -c treecode.f

treeio.o: treedefs.f treeio.f
	f77 $(FFLAGS) -c treeio.f

treeload.o: treedefs.f treeload.f
	f77 $(FFLAGS) -c treeload.f

treegrav.o: treedefs.f treegrav.f
	f77 $(FFLAGS) -c treegrav.f

second.o: second.c
	cc -c second.c











	
