findm.f

Go to the documentation of this file.

      SUBROUTINE findm(I,ITERM,MG)
*
*
*       Find ghost mass.
*       ----------------
*
      include 'common6.h'
      common/binary/  cm(4,mmax),xrel(3,mmax),vrel(3,mmax),
     &                hm(mmax),um(4,mmax),umdot(4,mmax),tmdis(mmax),
     &                namem(mmax),nameg(mmax),kstarm(mmax),iflag(mmax)
      REAL*8 mg
*
*
*       Distinguish between KS component and single particle or c.m.
      iterm = 0
      IF (i.LT.ifirst) THEN
          ipair = kvec(i)
          icm = n + ipair
*       Consider standard binary, simple hierarchy or high-order system.
          IF (name(icm).GT.0) THEN
              im = 0
*       Obtain merger index for later and identify component of CM.
              DO 3 k = 1,nmerge
                  IF (nameg(k).EQ.name(icm)) im = k
    3         CONTINUE
              IF (im.EQ.0) THEN
                  iterm = -1
                  go to 50
              END IF
              j1 = 2*ipair - 1
              IF (name(j1).EQ.name(i)) k1 = 3
              IF (name(j1+1).EQ.name(i)) k1 = 4
          ELSE IF (name(icm).GE.-2*nzero) THEN
              im = 0
              DO 5 k = 1,nmerge
                  IF (namem(k).EQ.name(icm)) im = k
    5         CONTINUE
              IF (im.EQ.0) THEN
                  iterm = -1
                  go to 50
              END IF
              j1 = 2*ipair - 1
              k1 = 1
              IF (name(j1+1).EQ.name(i)) THEN
                  k1 = 2
              END IF
          ELSE IF (name(icm).LT.-2*nzero) THEN
              im = 0
              DO 6 k = 1,nmerge
                  IF (namem(k).EQ.name(icm)) im = k
    6         CONTINUE
              IF (im.EQ.0) THEN
                  iterm = -1
                  go to 50
              END IF
              jh = 0
*       Search c.m. ghost name to get KS pair index.
              DO 8 j = n+1,ntot
                  IF (name(j).EQ.nameg(im)) jh = j
    8         CONTINUE
              IF (jh.EQ.0) THEN
                  iterm = -1
                  go to 50
              END IF
              jpair = jh - n
              j1 = 2*jpair - 1
*       Compare component names in order to decide appropriate CM index.
              IF (name(j1).EQ.name(i)) THEN
                  k1 = 1
              ELSE IF (name(j1+1).EQ.name(i)) THEN
                  k1 = 2
              ELSE
                  k1 = 2
              END IF
          ELSE
              iterm = -1
              go to 50
          END IF
      ELSE
*       Determine merger index of ghost particle.
          im = 0
          DO 10 k = 1,nmerge
              IF (nameg(k).EQ.name(i)) im = k
   10     CONTINUE
          IF (im.EQ.0) THEN
              iterm = -1
              go to 50
          END IF
          IF (i.LE.n) THEN
              j1 = 0
*       Identify the location of the corresponding KS component.
              DO 15 j = 1,ifirst
                  IF (name(j).EQ.-namem(im)) j1 = j
   15         CONTINUE
              IF (j1.EQ.0) THEN
                  iterm = -1
                  go to 50
              END IF
              ipair = kvec(j1)
*       Decide the relevant component by comparing look-up times.
              k1 = 1
              IF (tev(2*ipair).LT.tev(i)) k1 = 2
          ELSE
              icm = 0
              DO 20 k = n+1,ntot
                  IF (namem(im).EQ.name(k)) icm = k
   20         CONTINUE
              IF (icm.EQ.0) THEN
                  iterm = -1
                  go to 50
              END IF
              ipair = icm - n
              j = i
              k1 = 1
              IF (tev(2*ipair).LT.tev(j)) k1 = 2
          END IF
      END IF
*
*       Copy the desired mass from merger table.
      mg = cm(k1,im)
*
   50 RETURN
*
      END