chlist.f

Go to the documentation of this file.

      SUBROUTINE chlist(I)
*
*
*       Perturber list for chain regularization.
*       -----------------------------------------
*
      include 'common6.h'
      REAL*8  m,mass,mc,mij,mkk
      parameter(nmx=10,nmx3=3*nmx,nmxm=nmx*(nmx-1)/2)
      common/chain1/  xch(nmx3),vch(nmx3),m(nmx),
     &                zz(nmx3),wc(nmx3),mc(nmx),
     &                xi(nmx3),pi(nmx3),mass,rinv(nmxm),rsum,mkk(nmx),
     &                mij(nmx,nmx),tkk(nmx),tk1(nmx),iname(nmx),nn
      common/chainc/  xc(3,ncmax),uc(3,ncmax),bodyc(ncmax),ich,
     &                listc(lmax)
      common/cpert/  rgrav,gpert,ipert,npert
*
*
*       Prepare perturber selection using maximum of RSUM & RGRAV.
      rpert = max(rsum,rgrav)
*       Restrict effective size to RMIN (energy may be near zero).
      rpert = min(rpert,rmin)
      rcrit2 = 2.0*rpert**2/body(i)
      rcrit3 = rcrit2*rpert/gmin
*       Base fast search on maximum binary mass (2*BODY1).
      rcrit2 = 2.0*rcrit2*body1*cmsep2
      pmax = 0.0
*
*       Select new perturbers from chain c.m. neighbour list.
      nnb1 = 1
      nnb2 = list(1,i) + 1
      DO 10 l = 2,nnb2
          j = list(l,i)
          w1 = x(1,j) - x(1,i)
          w2 = x(2,j) - x(2,i)
          w3 = x(3,j) - x(3,i)
          rsep2 = w1*w1 + w2*w2 + w3*w3
*       Include any merged c.m. bodies in the fast test.
          IF (rsep2.LT.rcrit2.OR.name(j).LT.0) THEN
              rij3 = rsep2*sqrt(rsep2)
*       Estimate perturbed distance from tidal limit approximation.
              IF (rij3.LT.body(j)*rcrit3) THEN
                  nnb1 = nnb1 + 1
                  listc(nnb1) = j
                  pmax = max(body(j)/rij3,pmax)
              END IF
          END IF
   10 CONTINUE
*
*       Save perturber membership.
      listc(1) = nnb1 - 1
*
*       Form current perturbation from nearest body (effective value RPERT).
      gpert = 2.0*pmax*rpert**3/body(ich)
*
*       Obtain actual perturbation (note GAMX zero first time).
      CALL chpert(gamx)
*
*     WRITE (6,20)  ICH, NNB2-1, LISTC(1), RSUM, RPERT, GPERT, GAMX
*  20 FORMAT (' CHLIST:   ICH NB NP RSUM RPERT GPERT GX ',3I4,1P,4E9.1)
*
      IF (gamx.GT.0.0d0) THEN
          gpert = gamx
      END IF
      npert = listc(1)

*       Ensure consistent perturbation indicator after re-determination.
      IF (gpert.GT.1.0d-06.AND.npert.GT.0) THEN
          ipert = 1
      ELSE
          ipert = 0
      END IF
*
      RETURN
*
      END