SpectraRust/tlusty/extracted/column.f
2026-03-19 14:05:33 +08:00

51 lines
1.5 KiB
Fortran

subroutine column
c =================
c
c approximate determination of the total disk column
c mass, DMTOT
c
INCLUDE 'IMPLIC.FOR'
INCLUDE 'BASICS.FOR'
INCLUDE 'MODELQ.FOR'
common/relcor/arh,brh,crh,drh
c
parameter (xmdsun = 6.3029e25,
* xmsun = 1.989e33,
* rsun = 6.9598e10,
* grcon = 6.668e-8,
* velc = 2.997925e10,
* rgas = 1.3e8,
* xkram0 = 7.e25,
* xkap0 = 6.4e24,
* chiel = 0.39,
* pi = 3.14159265e0,
* pi4 = 4.*pi)
c
alpha= abs(alphav)
r = rstar*abs(reldst)
ga=xmdot*xmdsun/pi4*sqrt(5.9*grcon*abs(xmstar)/r**3)*drh/arh
c
be=0.77*rgas*xkap0**0.125*(two*qgrav/pi/rgas)**0.0625*sqrt(teff)
be=be*fractv**0.125
al=(sig4p*pi4*teff**4*chiel/velc)**2/(3.*qgrav)
c
dm00=(ga/alpha/be)**0.8
write(6,640) ga,al,be,dm00
640 format(/' new procedure to determine M_tot'/
* ' gam, al, be, dm0 ',1p4e11.3/
* ' iter M delta(M)/M p, jac'/)
itdm=0
10 itdm=itdm+1
p0=alpha*dm00*(al+be*dm00**0.25)-ga
ppr=alpha*(al+1.25*be*dm00**0.25)
ddm0=-p0/ppr
write(6,641) itdm,dm00,ddm0/dm00,p0,ppr
641 format(i4,1p4e11.3)
dm00=dm00+ddm0
if(abs(ddm0/dm00).gt.1.e-2.and.itdm.lt.20) go to 10
dmtot=dm00
visc=3.34379D24*XMDOT/dmtot*BRH*DRH/ARH/ARH
c
return
end