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
instar.f
      SUBROUTINE INSTAR
*
*
*       Initialization of stars.
*       ------------------------
*
      INCLUDE 'common6.h'
      REAL*8 TSCLS(20),LUMS(10),GB(10),TM,TN
      REAL*8 M0,M1,RM,LUM,AGE,MC,RCC
      REAL*8 MENV,RENV,K2,K3
      PARAMETER(K3=0.21D0)
      REAL*8 JSPIN,OSPIN
      REAL*8 VROTF
      EXTERNAL VROTF
*
*
*       Initialize mass loss variables & counters.
      TPHYS = 0.d0
      ZMRG = 0.d0
      ZMHE = 0.d0
      ZMRS = 0.d0
      ZMWD = 0.d0
      ZMSN = 0.d0
      ZMDOT = 0.d0
      NMDOT = 0
      NRG = 0
      NHE = 0
      NRS = 0
      NWD = 0
      NSN = 0
      NBH = 0
      NTZ = 0
      NBS = 0
      NKICK = 0
      NBKICK = 0
*
*NB4 NEW
      ZMNH = 0.d0
      ZMBH = 0.d0
      ZMSY = 0.d0
      NROCHE = 0
      NCHAOS = 0
      IQCOLL = 0
      IBLUE = 0
      NCHA = 0
      NSP = 0
      NHG = 0
      NNH = 0
      NBR = 0
      NAS = 0
      NRO = 0
      NDD = 0
      NSPIR = 0
      NCIRC = 0
      NSLP = 0
      NCONT = 0
      NCOAL = 0
      NCE = 0
      INSTAB = 0
      NEINT = 0
      NEMOD = 0
      NHYP = 0
      NHYPC = 0.0
      NGB = 0
      NMS = N
*
      TMDOT = 1.0d+10
*NB6  IF (KZ(27).EQ.0) THEN
*         TSTAR = TSCALE
*     END IF
*
      WRITE (6,9)  ZPARS(11), ZPARS(12), ZMET
 9    FORMAT(//,12X,'ABUNDANCES: X =',F6.3,' Y =',F6.3,' Z =',F6.3)
*NB6  zpars(11)=xhyd
*     zpars(12)=yhel
*
*       Calculate scale factor for spin angular momentum.
      SPNFAC = ZMBAR*SU**2/(1.0D+06*TSTAR)
*
      EPOCH1 = EPOCH0
      DO 10 I = 1,N
*
*       Obtain stellar parameters at current epoch.
          IF(KZ(12).EQ.2)THEN
             READ(12,*)M1,KW,M0,EPOCH1,OSPIN
          ELSE
             M1 = BODY(I)*ZMBAR
             M0 = M1
             IF(KSTAR(I).GT.1)THEN
                KW = KSTAR(I)
             ELSE
*       Include optional pre-mainsequence evolution.
                IF (M1.LT.8.0.AND.KZ(41).GT.0) THEN
                    KW = -1
                ELSE
                    KW = 1
                END IF
*               IF(M0.LE.0.01D0) KW = 10
*               IF(M0.GE.100.D0) KW = 14
                IF (KZ(45).GT.0.AND.M0.GT.9.0.AND.I.LE.KZ(24)) KW = 14
             ENDIF
          ENDIF
          MC = 0.D0
          AGE = TIME*TSTAR - EPOCH1
          CALL star(KW,M0,M1,TM,TN,TSCLS,LUMS,GB,ZPARS)
*       Define preMS EPOCH & AGE if relevant.
          IF (KW.EQ.-1) THEN
              EPOCH(I) = TSCLS(15)
              AGE = TIME*TSTAR - EPOCH(I)
          END IF
          CALL hrdiag(M0,AGE,M1,TM,TN,TSCLS,LUMS,GB,ZPARS,
     &                RM,LUM,KW,MC,RCC,MENV,RENV,K2)
*
*       Assign initial spin angular momentum. 
          IF(KZ(22).EQ.3)THEN
             JSPIN = (K2*(M1-MC)*RM**2 + K3*MC*RCC**2)*OSPIN
          ELSE
             OSPIN = 45.35d0*VROTF(M1)/RM
             JSPIN = K2*M1*RM**2*OSPIN
             IF(KW.GT.1) JSPIN = 0.D0
          ENDIF
*
*       Convert from solar radii to scaled units (assume Sun = 1/215 AU).
          RADIUS(I) = RM/SU
          ZLMSTY(I) = LUM
          SPIN(I) = JSPIN/SPNFAC
*
*       Check neutron star option for GR capture (avoid large masses).
          IF (KZ(27).EQ.3.AND.KZ(28).EQ.4) THEN
              RADIUS(I) = 1.0D-12/(3.0*RBAR)
              KW = 13
              TEV(I) = 1000.0
              M0 = 25.0
              EPOCH(I) = -15.0/TSTAR
              IF (I.EQ.1) WRITE (6,5)  M1, KW, RADIUS(I)*SU
    5         FORMAT (/,12X,'FIRST STAR:    M K* R/SU ',F7.2,I4,1P,E9.1)
          END IF
*
*       Initialize the stellar classification type (KW = 0 - 15).
          KSTAR(I) = KW
*
*       Save the initial mass of all the stars in sequential order.
          BODY(I) = M1/ZMBAR
          BODY0(I) = M0/ZMBAR
*
*       Set initial look-up time.
          EPOCH(I) = TIME*TSTAR - AGE
          TEV0(I) = TIME
          CALL TRDOT(I,DTM,M1)
          TEV(I) = DTM
          IF (KW.GE.13) TEV(I) = 0.0
*
*       Determine the time for next stellar evolution check.
          IF (TEV(I).LT.TMDOT) THEN
              TMDOT = TEV(I)
          END IF
          IF (I.EQ.1.AND.KZ(41).GT.0) THEN
              WRITE (6,8)  M1, TEV(I), RADIUS(I)*SU
    8         FORMAT (/,12X,'BEGIN STAR #1    M TEV r*  ',
     &                       F7.2,1P,2E10.2)
          END IF
*
   10 CONTINUE
*
*       Define first quantized step < 1000 yrs (minimum interval for MDOT).
*       (changed to 100 yr to be consistent with trdot: 2/8/02)
      DT = 1.0d-04/TSCALE
      CALL STEPK(DT,DTN)
      IF(DTN*TSCALE.LT.100.0) DTN = 2.d0*DTN
      STEPX = DTN
*
*        Ensure binary components will be updated at the same time.
      DO 15 I = 1,NBIN0
         I1 = 2*I - 1
         I2 = I1 + 1
         TEV(I1) = MIN(TEV(I1),TEV(I2))
         TEV(I1) = MIN(TEV(I1),10.D0*STEPX)
         TMDOT = MIN(TMDOT,TEV(I1))
         TEV(I2) = TEV(I1)
   15 CONTINUE
*
*       Initialize stellar collision matrix.
*
      ktype(0,0) = 1
      do 20 j = 1,6
         ktype(0,j) = j
         ktype(1,j) = j
 20   continue
      ktype(0,7) = 4
      ktype(1,7) = 4
      do 25 j = 8,12
         if(j.ne.10)then
            ktype(0,j) = 6
         else
            ktype(0,j) = 3
         endif
         ktype(1,j) = ktype(0,j)
 25   continue
      ktype(2,2) = 3
      do 30 i = 3,14
         ktype(i,i) = i
 30   continue
      ktype(5,5) = 4
      ktype(7,7) = 1
      ktype(10,10) = 15
*       Change for CO+CO owing to Tout theory (21/11/08).
      ktype(11,11) = 12
      ktype(13,13) = 14
      do 35 i = 2,5
         do 40 j = i+1,12
            ktype(i,j) = 4
 40      continue
 35   continue
      ktype(2,3) = 3
      ktype(2,6) = 5
      ktype(2,10) = 3
      ktype(2,11) = 5
      ktype(2,12) = 5
      ktype(3,6) = 5
      ktype(3,10) = 3
      ktype(3,11) = 5
      ktype(3,12) = 5
      ktype(6,7) = 4
      ktype(6,8) = 6
      ktype(6,9) = 6
      ktype(6,10) = 5
      ktype(6,11) = 6
      ktype(6,12) = 6
      ktype(7,8) = 8
      ktype(7,9) = 9
      ktype(7,10) = 7
      ktype(7,11) = 9
      ktype(7,12) = 9
      ktype(8,9) = 9
      ktype(8,10) = 7
      ktype(8,11) = 9
      ktype(8,12) = 9
      ktype(9,10) = 7
      ktype(9,11) = 9
      ktype(9,12) = 9
      ktype(10,11) = 9
      ktype(10,12) = 9
      ktype(11,12) = 12
      do 45 i = 0,12
         ktype(i,13) = 13
         ktype(i,14) = 14
 45   continue
      ktype(13,14) = 14
*
*       Increase common-envelope cases by 100.
      do 50 i = 0,9
         do 55 j = i,14
            if(i.le.1.or.i.eq.7)then
               if(j.ge.2.and.j.le.9.and.j.ne.7)then
                  ktype(i,j) = ktype(i,j) + 100
               endif
            else
               ktype(i,j) = ktype(i,j) + 100
            endif
 55      continue
 50   continue
*
*       Assign the remaining values by symmetry.
      do 60 i = 1,14
         do 65 j = 0,i-1
            ktype(i,j) = ktype(j,i)
 65      continue
 60   continue
*
      WRITE (6,75)  KTYPE
   75 FORMAT (/,11X,' KTYPE: ',15I4,14(/,19X,15I4))
*
      RETURN
      END
back to top