Nbody6
giant.f
Go to the documentation of this file.
1  SUBROUTINE giant(IPAIR,I,W,Q,WSCALE,QSCALE,XN,QL)
2 *
3 *
4 * Structure constants of giant star.
5 * ----------------------------------
6 *
7 * Theory of Rosemary Mardling, Ap. J. XX, YYY, 1995.
8 * @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
9 *
10  include 'common6.h'
11  common/modes/ eb0(ntmax),zj0(ntmax),ecrit(ntmax),ar(ntmax),
12  & br(ntmax),eosc(4,ntmax),edec(ntmax),tosc(ntmax),
13  & rp(ntmax),es(ntmax),cm(2,ntmax),iosc(ntmax),
14  & namec(ntmax)
15  REAL*8 ww(6),qq(6),w(2),q(2),wscale(2),qscale(2),sw(2)
16  DATA ww /2.119,3.113,8.175,3.742,4.953,9.413/
17  DATA qq /0.4909,0.4219,0.2372,0.4677,0.3560,0.1519/
18  DATA a0,a1,a2,a3 /0.944525,-0.392030,6.01655d-02,-3.34790d-03/
19  DATA b0,b1,b2 /-0.3789,1.481,-0.1018/
20  DATA c0,c1,c2,c3 /1.452104,3.923872,-11.88722,13.46106/
21  DATA e0,e1,e2,e3 /1.934977,2.214222,-4.855796,4.025394/
22 *
23 *
24 * Determine the appropriate chaos index (adopt NCHAOS+1 if not found).
25  ic = 0
26  j = n + ipair
27  DO 1 k = 1,nchaos
28  IF (namec(k).EQ.name(j)) ic = k
29  1 CONTINUE
30 *
31 * Decide between first & second binary component for saving core mass.
32  i1 = 2*ipair - 1
33  i2 = i1 + 1
34  l = 1
35 * Note possibility I = I2 on first call.
37  IF (i.EQ.i2) l = 2
38  END IF
39 *
40 * Set typical core mass of 0.3/0.5 Msun for general binary in next bin.
41  IF (ic.EQ.0) THEN
42  ic = nchaos + 1
43  cm(l,ic) = (0.3 + 0.1*float(kstar(i) - 3))/zmbar
44 * Include rare case of hyperbolic encounter as the first event.
45  ELSE IF (cm(l,ic).LE.0.0d0) THEN
46  cm(l,ic) = (0.3 + 0.1*float(kstar(i) - 3))/zmbar
47  END IF
48  IF(kstar(i).EQ.9) cm(l,ic) = 0.5*body(i)
49 *
50 * Form ratio of core mass and mass.
51  sig = cm(l,ic)/body(i)
52 *
53 * Include safety check on mass ratio just in case.
54  IF (sig.GT.0.9.OR.sig.LT.0.0) THEN
55 * WRITE (6,5) IC, KSTAR(I), NAME(I), BODY0(I)*ZMBAR,
56 * & BODY(I)*ZMBAR, CM(L,IC)*ZMBAR
57 * 5 FORMAT (' WARNING! GIANT IC K* NM M0 M MC ',
58 * & 2I4,I6,3F7.2)
59  sig = 0.9
60  cm(l,ic) = 0.9*body(i)
61  END IF
62 *
63 * Define mass, core mass, radius, envelope mass and luminosity in S.U.
64  zm = body(i)*zmbar
65  zmc = cm(l,ic)*zmbar
66  rsi = radius(i)*su
67  zme = zm - zmc
68 * Obtain L^{1/3} from GB L(Mc) relation for Pop II M = 0.8Msun.
69  zl = 1.98d+05*zmc**6
70 * Evaluate damping constant from Zahn's theory (R.M. 13/5/97).
71 * FAC = (GM)^{1/2}*M_{env}^{1/3)/(R^{5/6}*L^{1/3}) = 8.48D+03 for S.U.
72  ql = 8.48d+03*sqrt(zm)*(zme/zl)**0.33/rsi**0.833
73 *
74 * Set effective frequencies, overlap integrals and structure constants.
75  DO 10 k = 1,2
76  k1 = 3*k - 2
77  IF (k.EQ.1) THEN
78  sw(k) = ((c3*sig + c2)*sig + c1)*sig + c0
79  ELSE
80  sw(k) = ((e3*sig + e2)*sig + e1)*sig + e0
81  END IF
82  w(k) = sw(k)**2
83  q(k) = ((a3*sw(k) + a2)*sw(k) + a1)*sw(k) + a0
84  wscale(k) = sqrt(w(k)/ww(k1))
85  qscale(k) = (q(k)/qq(k1)/wscale(k))**2
86  qscale(k) = max(qscale(k),0.0001d0)
87  10 CONTINUE
88 *
89 * Evaluate new polytropic index.
90  xn = (b2*sw(1) + b1)*sw(1) + b0
91 * WRITE (24,20) IC, IPAIR, KSTAR(J), CM(L,IC)/BODY(I), RSI, XN, QL
92 * 20 FORMAT (' GIANT: IC KS K* MC/M R* n Q ',3I4,3F6.2,F7.1)
93 * CALL FLUSH(24)
94 *
95 * Include warning if n > 5 (note limit QSCALE >= 0.0001).
96 * QSM = MIN(QSCALE(1),QSCALE(2))
97 * IF (XN.GE.5.0.OR.QSM.LT.0.00011) THEN
98 * WRITE (6,30) IC, IPAIR, KSTAR(J), CM(L,IC)/BODY(I),
99 * & RADIUS(I)*SU, QSM, XN, QL
100 * 30 FORMAT (' GIANT: WARNING! IC KS K* MC/M R/R0 QSM n QL ',
101 * & 3I4,F6.2,F7.1,F8.4,F6.2,F7.1)
102 * END IF
103
104  RETURN
105 *
106  END