C*********************************************************************C C Testprogram for dust formation and radiative transfer: M-star C C Version: July 2010 C C*********************************************************************C IMPLICIT REAL*8(A-H,O-Z) PARAMETER(KDIM=1000,IFDIM=11,NDIM=80,NSPDIM=11) COMMON/CONST/HP,CL,BK,PM,SIG,GRAV,PI,SUNM,SUNR,SUNL,YEAR,RGAS,PAT COMMON/ABUND/EPSHE,EPSC,EPSN,EPSO,EPSNE,EPSNA,EPSMG,EPSAL,EPSSI, * EPSS,EPSAR,EPSCA,EPSFE,EPSNI COMMON/RMOD/RD(KDIM),TG(KDIM),RHO(KDIM),VV(KDIM),DKAP(KDIM), * GAM(KDIM),FV(KDIM,IFDIM),VDR(KDIM,IFDIM),AV(KDIM,IFDIM),KL,KK COMMON/CMOD/TAU(KDIM),TAL(KDIM),TAH(KDIM),CHIHT(KDIM),KLU COMMON/CFLUX/FLUX(NDIM,4),HFLUX,HS COMMON/CCOL/COLU,COLB,COLV,COLR,COLI,COLJ,COLK,COLL,COLM,COLN, * COLJBB,COLHBB,COLKBB,COLLBB,COLLSBB,COLMBB COMMON/FREQ/DLA(NDIM),DNU(NDIM),GNU(NDIM),DLAMREF,NN,NREF COMMON/CNDUSP/NDUSPO,NDUSPC,NDUSPS,NDUAM COMMON/CRADM/VJ(KDIM),VH(KDIM),VK(KDIM),BV(KDIM,NSPDIM), * SPHF(KDIM),CHIBSP(KDIM,NSPDIM),CHIJSP(KDIM,NSPDIM), * CHIHSP(KDIM,NSPDIM) COMMON/CTEMP/TS(KDIM,NSPDIM),TGH(KDIM) COMMON/CFDU/FDU(KDIM,NSPDIM) CHARACTER*3 ADU,THE,TED CHARACTER*20 DUSTFILE CHARACTER*8 KEYWORD,KEYWORDS(8) LOGICAL FLDU COMMON/CCON/NDONP(NSPDIM),NDON,IFIRSTC,FLDU(NSPDIM),ADU(NSPDIM) DIMENSION TW(NSPDIM),PP(7) 1 FORMAT(I4,1P20E10.3) DATA THE/'erH'/,TED/'fEd'/ DATA KEYWORDS/' TEFF =',' STARL =',' STARM =',' MDOT =', * ' ROUT =',' Z/ZSUN=',' C/O =',' DUST ='/ C --- Stellar parameters --- C Effectiv temperature TEFF=3000D0 C Luminosity (solar luminosities) STARL=2D+4 C Mass (solar masses) STARM=1.0D0 C Mass-loss rate (solar masses per year) DMP=1D-5 C Abundances: scaling factor for metals ZSCALE=1D0 C C/O ratio (= 0 : not changed) CORATIO=0D0 C Name of file with dust data DUSTFILE='dustlist.txt' C --- model parameters --- C outer radius (Stellar radii) ROUT=1D+5 C initial velocity (km/s) VEXP=0.9D0 C initial value for TAUL TAULUC=1D-2 C Number of radial gripdpoints KK=300 C Read parameters from file OPEN(10,FILE='starO.txt',STATUS='OLD',ERR=45) DO K=1,7 READ(10,'(A8,F9.3)') KEYWORD,PP(K) IF(KEYWORD.NE.KEYWORDS(K)) GOTO 40 END DO READ(10,'(A8,A20)') KEYWORD,DUSTFILE IF(KEYWORD.NE.KEYWORDS(8)) GOTO 40 TEFF=PP(1) STARL=PP(2) STARM=PP(3) DMP=PP(4) ROUT=PP(5) ZSCALE=PP(6) CORATIO=PP(7) GOTO 45 40 PRINT*,'Error in file star.txt in line',K STOP 45 CLOSE(10) C --- Initialization of data -- CALL INIWIND(ZSCALE,CORATIO) CALL INIRAD(DUSTFILE) C-----------------------------------------------------------------------C C Oxygen rich element mixture C C-----------------------------------------------------------------------C C -- Element abundances = scaled solar abundances -- CALL ITTEMPL(STARM,STARL,TEFF,DMP,ROUT,VEXP,TAULUC,FOL,XOL, * FPY,XPY,FQU,FIR,FWU,XWU,FCO,FHI,FSP,FCA,FSC,FMS,VWIND,TAUH, * TAULFIN) 15 FORMAT(/,'Stellar parameter:',/,1X,'L :',F10.2,2X,'L_o',/,1X, * 'Teff:',F10.2,/,1X,'M :',F10.2,2X,'M_o') WRITE(6,15) STARL,TEFF,STARM 20 FORMAT(/,'Oxygen rich element mixture:') WRITE(6,20) 21 FORMAT(1X,'C/O :',1PE10.3,2X,'Mpu:',E10.3,2X,'Vex :',E10.3) WRITE(6,21) EPSC/EPSO,DMP,VWIND 22 FORMAT(1X,'fOl :',1PE10.3,2X,'xOl:',E10.3,/,1X,'fPy :',E10.3,2X, * 'xPy :',E10.3,/,1X,'fQu :',E10.3,/,1X,'fFe :',E10.3,/,1X, * 'fWu :',E10.3,2X,'xWu :',E10.3/,1X,'fCo :',E10.3,/,1X, * 'fHi :',E10.3,/,1X,'fSp :',E10.3) WRITE(6,22) FOL,XOL,FPY,XPY,FQU,FIR,FWU,XWU,FCO,FHI,FSP 23 FORMAT(1X,'tau(',0PF3.1,'):',1PE10.3,2X,'tauH:',E10.3,2X, * 'tauL',E10.3,/) WRITE(6,23) DLA(NREF),FLUX(NREF,3),TAUH,DABS(TAULFIN) IF(VWIND.LT.1.5D0*VEXP) THEN 26 FORMAT(1X,'not a dust driven wind, model has to be rejected',/, * 2X,'VWIND',1PE10.3,2x,'VEXP',E10.3) WRITE(6,26) VWIND,VEXP ELSE C model structure OPEN(10,FILE='mstar.da') 25 FORMAT(1X,'N',4X,'r',9X,'T',9X,'v',9X,'rho',7X,'P',9X, * 'gamma',5X,'kapH',6X) WRITE(10,25) STARR=DSQRT(STARL*SUNL/(4D0*PI*SIG*TEFF**4)) DO K=KLU,KK P=RHO(K)*3D0*BK*TG(K)/(7D0*PM) WRITE(10,1) K,RD(K)/STARR,TG(K),VV(K),RHO(K),P,GAM(K),DKAP(K) END DO CLOSE(10) C condensation of dust species OPEN(10,FILE='mstar-f.da') 27 FORMAT(1X,'N',4X,'r',9X,'T',9X, * 'Oli',7X,'xOli',6X,'Pyr',7X,'xPyr',6X,'Qua',7X,'Cor',7X, * 'Hib',7X,'Spi',7X,'Fe',8X,'Wue',7X,'xWue',6X,'Car',7X,'SiC', * 7X,'MgS',7X) WRITE(10,27) DO K=KLU,KK WRITE(10,1) K,RD(K)/STARR,TG(K),FDU(K,1),FV(K,2),FDU(K,2), * FV(K,4),FDU(K,3),FDU(K,4),FDU(K,5),FDU(K,6),FDU(K,7), * FDU(K,8),FV(K,8),FDU(K,9),FDU(K,10),FDU(K,11) END DO CLOSE(10) C drift velocities of dust species OPEN(10,FILE='mstar-v.da') 28 FORMAT(1X,'N',4X,'r',9X,'T',9X,'v',9X, * 'vOli',6X,'vPyr',6X,'vQua',6X,'vFe',7X,'vWue',6X,'vCor',6X, * 'vHib',6X,'vSpi',6X) WRITE(10,28) DO K=KLU,KK WRITE(10,1) K,RD(K)/STARR,TG(K),VV(K),(VDR(K,L),L=1,IFDIM-3) END DO CLOSE(10) C particle radii of dust species OPEN(10,FILE='mstar-a.da') 29 FORMAT(1X,'N',6X,'r',11X,13(A3,9X)) WRITE(10,29) (ADU(N),N=1,NSPDIM) DO K=KLU,KK WRITE(10,'(I5,1P20E12.4)') K,RD(K)/STARR,(AV(K,L),L=1,NSPDIM) END DO CLOSE(10) C temperature structure for dust species OPEN(10,FILE='mstar-t.da') 30 FORMAT(1X,'N',6X,'r',11X,'Tgrau',7X,13(A3,9X)) WRITE(10,30) (ADU(N),N=1,NSPDIM),THE,TED FL=HS*STARR**2 DO K=KLU,KK DO L=1,NSPDIM IF(FDU(K,L).GT.1D-8) THEN TW(L)=TS(K,L) ELSE TW(L)=0D0 END IF END DO HH=FL/RD(K)**2 ERRH=VH(K)/HH-1D0 WRITE(10,'(I5,1P20E12.4)') K,RD(K)/STARR, * TGH(K),(TW(L),L=1,NSPDIM),ERRH,VK(K)/VJ(K) END DO CLOSE(10) c CALL SETDUSTABS c CALL CALCSPECT(STARL,TEFF) c 24 FORMAT(/,1X,'colors:',/,1X,'J-K :',F6.2,/,1X,'H-K :',F6.2,/,1X, c * "K-L':",F6.2) c WRITE(6,24) COLJBB-COLKBB,COLHBB-COLKBB,COLKBB-COLLSBB 32 FORMAT(2X,'N',3X,'lam',7X,'nue',7X,'bb',8X,'Fnu',7X,'Lnue',6X, * 'taunue') C spectrum of dust shell FLMAX=0D0 DO N=1,NN IF(FLUX(N,2).GT.FLMAX) FLMAX=FLUX(N,2) END DO FLFAC=4D0*PI*STARR**2*4D0*PI OPEN(10,FILE='huel-M.sp') WRITE(10,32) DO N=1,NN WRITE(10,1) N,DLA(N),DNU(N),FLUX(N,1)/FLMAX,FLUX(N,2)/FLMAX, * FLUX(N,2)*FLFAC,FLUX(N,3) END DO CLOSE(10) END IF PRINT *,'--- fertig ---' END C*********************************************************************** INCLUDE 'd-v0-4.incl' INCLUDE 'op.incl' INCLUDE 's-v4.incl'