https://github.com/florentrenaud/nbody6tt
Raw File
Tip revision: 8a4716382ead3ece116c48a4ae5c65f8c9534437 authored by Florent on 29 January 2015, 12:19:28 UTC
Nbody6 - 29 January 2015 (added GPU2/Build/.gitkeep)
Tip revision: 8a47163
hmdot.f
      SUBROUTINE HMDOT(J,IMERGE,M1,KW,MC,DMS,RNEW,ITERM)
*
*
*       Mass loss from inner hierarchical binary.
*       -----------------------------------------
*
      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),IFLAGM(MMAX)
      REAL*8  BODYI(2),W(2)
      REAL*8  M1,MC
      LOGICAL IQUIT
*
*
*       Define merger termination index and relevant KS/c.m. indices.
      ITERM = 0
      IPAIR = KSPAIR
      I1 = 2*IPAIR - 1
      ICM = N + IPAIR
*
*       Include quitting conditions to avoid large changes at end-point.
      IQUIT = .FALSE.
*     IF (RADIUS(J)*SU.GT.500.0) IQUIT = .TRUE.
*     IF (BODY0(J)*ZMBAR.GT.15.0.AND.KSTAR(J).GE.4) IQUIT = .TRUE.
*     IF (ABS(M1 - MC).LT.0.1*M1.OR.MC.GT.1.4) IQUIT = .TRUE.
*     IF (BODY0(J)*ZMBAR - M1.GT.0.5*M1) IQUIT = .TRUE.
*       Note that tidal dissipation needs full KS for rectification in MDOT.
*     IF (KSTARM(IMERGE).LT.0.OR.BODY(ICM).EQ.0.0D0) IQUIT = .TRUE.
      IF (BODY(ICM).EQ.0.0D0) IQUIT = .TRUE.
*
*       Quit for mis-identification, advanced evolution or double merger.
      IF (J.LE.0.OR.IQUIT) THEN
          ITERM = 1
          GO TO 50
      END IF
*
*       Update radius for #J and copy #I1 for MDOT & HCORR in case of ghost.
      RSTAR = RNEW
      IF (J.GT.I1) THEN
          RADIUS(J) = RNEW
          RSTAR = RADIUS(I1)
*       Return RNEW for copying back to RADIUS(I1) on ghost & DM/M < 0.01.
      END IF
*
*       Skip further modifications on zero mass loss of same type.
      IF (ABS(DMS/M1).EQ.0.0D0.AND.KW.EQ.KSTAR(J)) GO TO 50
*
*       Set two-body elements for outer orbit and inner semi-major axis.
      SEMI = -0.5*BODY(ICM)/H(IPAIR)
      ECC2 = (1.0 - R(IPAIR)/SEMI)**2 + TDOT2(IPAIR)**2/(BODY(ICM)*SEMI)
      ECC1 = SQRT(ECC2)
      ZMB0 = CM(1,IMERGE) + CM(2,IMERGE)
      SEMI0 = -0.5*ZMB0/HM(IMERGE)
*
*       Form modified mass ratio and semi-major axes from M*A = const.
      DM = DMS/ZMBAR
      ZMB = ZMB0 - DM
      SEMI1 = SEMI*(ZMB0 + BODY(2*IPAIR))/(ZMB + BODY(2*IPAIR))
      SEMI2 = SEMI0*ZMB0/ZMB
      PMIN = SEMI1*(1.0 - ECC1)
*
*       Evaluate old separation, square regularized velocity, t'' & ECC.
      RI = 0.0D0
      V20 = 0.0
      TD2 = 0.0
      DO 10 K = 1,4
          RI = RI + UM(K,IMERGE)**2
          V20 = V20 + UMDOT(K,IMERGE)**2
          TD2 = TD2 + 2.0*UM(K,IMERGE)*UMDOT(K,IMERGE)
   10 CONTINUE
      ECC2 = (1.0 - RI/SEMI0)**2 + TD2**2/(SEMI0*ZMB0)
      ECC = SQRT(ECC2)
*
*       Determine inclination (use #I1 as first KS component).
      CALL HIMAX(I1,IMERGE,ECC,SEMI0,EMAX,EMIN,ZI,TG,EDAV)
*
*       Evaluate the general stability function (Mardling 2008).
      IF (ECC1.LT.1.0) THEN
          EOUT = ECC1
*       Increase tolerance near sensitive stability boundary (RM 10/2008).
          IF (EOUT.GT.0.9) THEN
              DE = 0.5*(1.0 - EOUT)
              DE = MIN(DE,0.01D0)
*       Add extra amount 0.011 to avoid switching.
              IF (ECC1.GT.0.9) DE = DE + 0.011
              EOUT = EOUT - DE
              PMIN = SEMI1*(1.0 - EOUT)
          END IF
          NST = NSTAB(SEMI2,SEMI1,ECC,EOUT,ZI,CM(1,IMERGE),
     &                                     CM(2,IMERGE),BODY(2*IPAIR))
          IF (NST.EQ.0) THEN
              PCRIT = 0.99*PMIN
              PCR = stability(CM(1,IMERGE),CM(2,IMERGE),BODY(2*IPAIR),
     &                                          ECC,ECC1,ZI)*SEMI2
          ELSE
              PCRIT = 1.01*PMIN
          END IF
      ELSE
          PCRIT = stability(CM(1,IMERGE),CM(2,IMERGE),BODY(2*IPAIR),
     &                                          ECC,ECC1,ZI)*SEMI2
      END IF
*
*       Update pericentre distance on successful stability test or exit.
      IF (PMIN.GT.PCRIT) THEN
          R0(IPAIR) = PCRIT
      ELSE
          ITERM = 1
          GO TO 50
      END IF
*
*       Check for possible circularization (tidal or sequential).
      RP = SEMI2*(1.0 - ECC)
      IF (KZ(27).GT.0.AND.RP.LT.4.0*RADIUS(J).AND.ECC.GT.0.002.AND.
     &    KSTARM(IMERGE).GE.0) THEN
          TC = 1.0D+10
          IF (KZ(27).EQ.2) THEN
              I2 = 0
*       Identify the ghost by searching single bodies.
              DO 12 K = IFIRST,N
                  IF (BODY(K).EQ.0.0D0.AND.
     &                NAME(K).EQ.NAMEG(IMERGE)) THEN
                      I2 = K
                  END IF
   12         CONTINUE
              IF (I2.GT.0) THEN
                  DO 14 K = 1,2
                      BODYI(K) = CM(K,IMERGE)
   14             CONTINUE
                  TG = 1.0
*       Evaluate the circularization time.
                  CALL HICIRC(RP,ECC,I1,I2,BODYI,TG,TC,EC,ED,W)
                  IF (TC.GT.2000) GO TO 18
              END IF
          END IF
          WRITE (6,15)  NAME(J), KSTAR(J), KSTARM(IMERGE), ECC, DMS,
     &                  RP, RADIUS(J), TC
   15     FORMAT (' HMDOT TERM    NAM K* E DM RP R* TC ',
     &                            I6,2I4,F8.4,F7.3,1P,3E10.2)
          ITERM = 1
          GO TO 50
      ELSE IF (ECC.GT.0.002) THEN
          IF (RP.LT.2.0*RADIUS(J)) THEN
              WRITE (6,15)  NAME(J), KSTAR(J), KSTARM(IMERGE), ECC, DMS,
     &                      RP, RADIUS(J)
              ITERM = 1
              GO TO 50
          END IF
      END IF
*
*       Obtain energy change from M*A = const and H = -M/(2*A) (DCH 8/96).
   18 DH = DM/SEMI0*(1.0 - 0.5*DM/ZMB0)
      HM0 = HM(IMERGE)
      HM(IMERGE) = HM(IMERGE) + DH
*
*       Form KS coordinate & velocity scaling factors (general point is OK).
      SEMI2 = -0.5*ZMB/HM(IMERGE)
      C2 = SQRT(SEMI2/SEMI0)
      V2 = 0.5*(ZMB + HM(IMERGE)*RI*(SEMI2/SEMI0))
      C1 = SQRT(V2/V20)
*
*       Re-scale KS variables to new energy (H < 0: constant eccentricity).
      DO 20 K = 1,4
          UM(K,IMERGE) = C2*UM(K,IMERGE)
          UMDOT(K,IMERGE) = C1*UMDOT(K,IMERGE)
*       Note no need to update XREL & VREL for RESTART (c.m. error cancels).
   20 CONTINUE
*
*       Reduce mass of relevant component (ghost is original second member).
      ZMU0 = CM(1,IMERGE)*CM(2,IMERGE)/ZMB0
      KM = 1
      IF (J.GE.IFIRST) KM = 2
      CM(KM,IMERGE) = CM(KM,IMERGE) - DM
*
*       Include corrections to EMERGE & EMDOT (consistency; no net effect!).
      ZMU = CM(1,IMERGE)*CM(2,IMERGE)/ZMB
      DECORR = ZMU*HM(IMERGE) - ZMU0*HM0
      EMERGE = EMERGE + DECORR
      EMDOT = EMDOT - DECORR
*       Compensate for EMERGE contribution in DEGRAV (cf. EVENTS).
      EGRAV = EGRAV - DECORR
*
*       Correct outer orbit for mass loss (use #I1 in case #J is a ghost).
      CALL HCORR(I1,DM,RSTAR)
*
*       Print some diagnostics on non-zero mass loss.
      IF (DMS.GT.1.0D-03) THEN
          WRITE (6,30)  NAME(J), KSTAR(J), IMERGE, KM, M1, DMS, PMIN,
     &                  PCRIT, SEMI2, SEMI1, DECORR
   30     FORMAT (' HMDOT    NAM K* IM KM M1 DM PM PC A A1 DE ',
     &                       I6,3I4,F6.2,1P,5E10.2,0P,F10.6)
      END IF
*
   50 RETURN
*
      END
back to top