newtev.f

Go to the documentation of this file.

      SUBROUTINE newtev(NNB,IX)
*
*
*       New look-up time of hierarchy.
*       ------------------------------
*
      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  m0,m1,mg,tscls(20),lums(10),gb(10)
*
*
*       Initialize iteration counter for binary component.
      iter = 0
*
*       Determine smallest look-up time for single stars.
    1 iter = iter + 1
      tm = 1.1d+10
      DO 5 l = 1,nnb
          i = jlist(l)
*       Include safety check (just in case).
          IF (i.LE.0) go to 5
*       Replace any binary c.m. by primary component.
          IF (i.GT.n) THEN
              i = 2*(i - n) - 1
          END IF
          IF (tev(i).LT.tm) THEN
              tm = tev(i)
              ix = i
          END IF
    5 CONTINUE
*
*       Skip increase of smallest look-up time above 10 Myr.
      IF ((tev(ix) - time)*tstar.GT.10.0) THEN
          go to 20
      END IF
*
*       Distinguish between ghost, single star or KS component.
      IF (body(ix).EQ.0.0d0) THEN
          CALL findm(ix,iterm,mg)
          IF (iterm.LT.0) go to 20
          m1 = mg*smu
      ELSE IF (ix.GE.ifirst) THEN
          m1 = body(ix)*smu
      ELSE
          iter = iter + 1
          ipair = kvec(ix)
          IF (name(n+ipair).GT.0) THEN
              m1 = body(ix)*smu
          ELSE
*       Find the merger index by identifying original c.m. name.
              im = 0
              DO 10 k = 1,nmerge
                  IF (namem(k).EQ.name(n+ipair)) im = k
   10         CONTINUE
              IF (name(n+ipair).LT.-2*nzero) THEN
                  WRITE (6,12)  name(n+ipair), name(i), im
   12             FORMAT (' NEWTEV WARNING    NAMC NAMI IM ',2i7,i4)
              END IF
              IF (im.EQ.0) go to 20
*       Choose relevant component for standard triple first.
              k = 1
              IF (ix.EQ.2*ipair) k = 2
              m1 = cm(k,im)*smu
*       Copy mass from K=3 or K=4 for merged quadruple system.
              IF (cm(3,im).GT.0.0d0) THEN
                  k = k + 2
                  m1 = cm(k,im)*smu
*       Restore mass of second component if quad is excluded.
              ELSE IF (ix.EQ.2*ipair) THEN
                  m1 = body(ix)*smu
              END IF
              IF (m1.EQ.0.0d0) THEN
                  m1 = cm(k,im)*smu
                  WRITE (6,15)  name(ix), k, m1
   15             FORMAT (' DANGER!    NEWTEV    NM K M1 ',2i6,f7.3)
              END IF
          END IF
      END IF
*
*       Obtain stellar evolution time-scales. 
      m0 = body0(ix)*smu
      kw = kstar(ix)
      CALL star(kw,m0,m1,tm,tn,tscls,lums,gb,zpars)
*
*       Determine new time-scale for changes in radius & mass.
      age = tev0(ix)*tstar - epoch(ix)
      CALL trdot2(kw,age,tm,tn,tscls,dtm,dtr)
      dt = dtm/tstar
*
*       Increase look-up time by at most a factor 2 if due in 10 Myr.
      dt = min(dt,10.0d0/tstar)
*       Impose limit to prevent multiple increases without updating.
      dtx = tev0(ix) + 2.0*dt - tev(ix)
      dt = min(dtx,dt)
      dt = max(dt,0.0d0)
      tev(ix) = tev(ix) + dt
*
*       Perform a second iteration for possible binary component.
      IF (iter.LE.2) go to 1
*
   20 RETURN
*
      END