events.f

Go to the documentation of this file.

      SUBROUTINE events
*
*
*       Output of mass loss or tidal capture events.
*       --------------------------------------------
*
      include 'common6.h'
      INTEGER  ntype(17)
      real*8 thookf,tbgbf
      external thookf,tbgbf
*
*
*       Check counter for stellar evolution events.
      IF (nmdot.GT.0) THEN
          DO 5 j = 1,16
              ntype(j) = 0
    5     CONTINUE
*
          km = 1
          zmx = 0.0
          DO 10 j = 1,n
              kw = kstar(j) + 1
              kw = min(kw,16)
              kw = max(kw,1)
              ntype(kw) = ntype(kw) + 1
              km = max(km,kw)
              zmx = max(body(j),zmx)
   10     CONTINUE
*
          WRITE (6,15)
   15     FORMAT (/,6x,'NMDOT   NRG  NHE  NRS  NNH  NWD  NSN  NBH  NBS',
     &               '  ZMRG  ZMHE   ZMRS  ZMNH  ZMWD  ZMSN   ZMDOT',
     &               '  NTYPE')
          WRITE (6,20)  nmdot, nrg, nhe, nrs, nnh, nwd, nsn, nbh, nbs,
     &                  zmrg, zmhe, zmrs, zmnh, zmwd, zmsn, zmdot,
     &                  (ntype(j),j=1,km)
   20     FORMAT (' #4',i9,8i5,2f6.1,f7.1,3f6.1,f8.1,i7,i6,9i4,i5,4i4)
      END IF
*
*       Determine turnoff mass at current cluster age (cf. routine STAR).
      IF (time.LE.0.0d0) THEN
          turn = body1*zmbar
      ELSE
          tphys = (time + toff)*tstar
          turn = body1*zmbar
          turn2 = 2.0*turn
   25     tm = max(zpars(8),thookf(turn))*tbgbf(turn)
          IF (tm.GT.tphys) THEN
              turn = 1.01*turn
          ELSE
              turn = 0.985*turn
          END IF
          IF (abs(tm - tphys).GT.1.0.AND.turn.LT.turn2) go to 25
      END IF
*
*       Check output for tidal capture, collisions or coalescence.
      IF (ndiss + ncoll + ncoal.GT.0.OR.egrav.LT.0.0d0) THEN
*       Form the net energy gain in binary interactions.
          degrav = ebin + esub + ebesc + emesc + emerge + egrav - ebin0
          WRITE (6,30)
   30     FORMAT (/,5x,'NDISS  NTIDE  NSYNC  NCOLL  NCOAL  NDD  NCIRC',
     &                 '  NROCHE  NRO  NCE  NHYP  NHYPC    EBIN ',
     &                 '  EMERGE  ECOLL  EMDOT  ECDOT  EKICK  ESESC ',
     &                 '  EBESC  EMESC  DEGRAV   EBIND  MAXM')
          WRITE (6,35)  ndiss, ntide, nsync, ncoll, ncoal, ndd, ncirc,
     &                  nroche, nro, nce, nhyp, nhypc, ebin, emerge,
     &                  ecoll, emdot, ecdot, ekick, esesc, ebesc,
     &                  emesc, degrav, e(3), zmx*smu
   35     FORMAT (' #5',i8,i6,3i7,i5,i7,i8,2i5,i6,i7,3f8.3,4f7.3,f8.3,
     &                  f7.3,2f8.3,f6.1)
      END IF
*
      RETURN
*
      END