giant2.f

Go to the documentation of this file.

      SUBROUTINE giant2(L,I,W,Q,WSCALE,QSCALE,XN,QL)
*
*
*       Structure constants of giant star (chain version).
*       --------------------------------------------------
*
*       Theory of Rosemary Mardling, Ap. J. XX, YYY, 1995.
*       @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
*
      include 'common6.h'
      parameter(nmx=10,nmx2=2*nmx,nmx3=3*nmx,nmx4=4*nmx,
     &            nmx8=8*nmx,nmxm=nmx*(nmx-1)/2)
      REAL*8  m,mass,mc,mij,mkk
      common/chain1/  xch(nmx3),vch(nmx3),m(nmx),
     &                zz(nmx3),wc(nmx3),mc(nmx),
     &                xi(nmx3),pi(nmx3),mass,rinv(nmxm),rsum,mkk(nmx),
     &                mij(nmx,nmx),tkk(nmx),tk1(nmx),iname(nmx),nn
      common/ccoll2/  qk(nmx4),pk(nmx4),rij(nmx,nmx),SIZE(nmx),vstar1,
     &                ecoll1,rcoll,qperi,istar(nmx),icoll,isync,ndiss1
      common/modes/  eb0(ntmax),zj0(ntmax),ecrit(ntmax),ar(ntmax),
     &               br(ntmax),eosc(4,ntmax),edec(ntmax),tosc(ntmax),
     &               rp(ntmax),es(ntmax),cm(2,ntmax),iosc(ntmax),
     &               namec(ntmax)
      REAL*8  ww(6),qq(6),w(2),q(2),wscale(2),qscale(2),sw(2)
      DATA  ww  /2.119,3.113,8.175,3.742,4.953,9.413/
      DATA  qq  /0.4909,0.4219,0.2372,0.4677,0.3560,0.1519/
      DATA  a0,a1,a2,a3  /0.944525,-0.392030,6.01655d-02,-3.34790d-03/
      DATA  b0,b1,b2  /-0.3789,1.481,-0.1018/
      DATA  c0,c1,c2,c3  /1.455775,3.691069,-10.42117,11.23818/
      DATA  e0,e1,e2,e3  /1.934977,2.214222,-4.855796,4.025394/
*
*
*       Set typical core mass of 0.3/0.5 Msun for chain binary in next bin.
      ic = nchaos + 1
      cm(l,ic) = (0.3 + 0.1*(istar(i) - 3))/zmbar
*
*       Form ratio of core mass and mass.
      sig = cm(l,ic)/m(i)
*
*       Include safety check on mass ratio just in case.
      IF (sig.GT.0.9.OR.sig.LT.0.0) THEN
          WRITE (6,5)  ic, istar(i), i, m(i)*zmbar, cm(l,ic)*zmbar
    5     FORMAT (' WARNING!    GIANT2    IC K* I M MC ',2i4,i6,2f7.2)
          sig = 0.9
          cm(l,ic) = 0.9*m(i)
      END IF
*
*       Define mass, core mass, radius, envelope mass and luminosity in S.U.
      zm = m(i)*zmbar
      zmc = cm(l,ic)*zmbar
      rsi = SIZE(i)*su
      zme = zm - zmc
*       Obtain L^{1/3} from giant relation L = 1.98D+05*M_c^6.
      zl3 = 58.3*zmc**2
*       Evaluate damping constant from Zahn's theory (R.M. 13/5/97).
*       FAC = (GM)^{1/2}*M_{env}^{1/3)/(R^{5/6}*L^{1/3}) = 8.48D+03 for S.U.
      ql = 8.48d+03*sqrt(zm)*(zme/zl3)**0.33/rsi**0.833
*
*       Set effective frequencies, overlap integrals and structure constants.
      DO 10 k = 1,2
          k1 = 3*k - 2
      IF (k.EQ.1) THEN
              sw(k) = ((c3*sig + c2)*sig + c1)*sig + c0
          ELSE
              sw(k) = ((e3*sig + e2)*sig + e1)*sig + e0
      END IF
      w(k) = sw(k)**2
          q(k) = ((a3*sw(k) + a2)*sw(k) + a1)*sw(k) + a0
          wscale(k) = sqrt(w(k)/ww(k1))
          qscale(k) = (q(k)/qq(k1)/wscale(k))**2
          qscale(k) = max(qscale(k),0.0001d0)
   10 CONTINUE
*
*       Evaluate new polytropic index.
      xn = (b2*sw(1) + b1)*sw(1) + b0
*     WRITE (24,20)  IC, IPAIR, ISTAR(J), CM(L,IC)/M(I), XN
*  20 FORMAT (' GIANT:    IC KS K* MC/M R/R0 n ',3I4,2F6.2)
*     CALL FLUSH(24)
*
*       Include warning if n > 5.
*     IF (XN.GE.5.0) THEN
*         WRITE (6,30)  IC, ISTAR(J), CM(L,IC)/M(I),
*    &                  SIZE(I)/RIN, XN
*  30     FORMAT (' GIANT:    WARNING!    IC K* MC/M R/R0 n ',
*    &                                    2I4,F6.2,F6.1,F6.2)
*     END IF

      RETURN
*
      END