c c-----------------------------------------------------| c Approximative correction for emission lines "dm" | c Eq. (6) in NewA, 2007, ... | c-----------------------------------------------------| c dm = -2.5log[1 + 2.507/C_f*Sum(P_f*I*sigma)] | c or | c dm = -2.5log[1 + 1/C_f*Sum(P_f*F)] | c-----------------------------------------------------| c C_f - Eq. (7), quantities in Table 1 | c P_f - filter transmissivity at lambda_i | c I - line maximum in units of the local continuum | c sigma - Gaussian half-width of the line | c F - line flux in units of the local continuum | c-----------------------------------------------------| c INPUT: file with (lambda, I, sigma) | c or | c (lambda, F) | c=====================================================| c program dml implicit double precision (a-h,o-z) dimension al(5000),f(5000),ai(5000),sigma(5000) character*30 in c c Coeficients of polynomial approximation of filter transmissivities c (Table 1 in the paper) c U,B,V: c-------------------------------------------------------------------- data u3,u2,u1,u0/-5.04073e-9,4.94417e-5,-0.159591,169.886/ data b3,b2,b1,b0/1.117625e-9,-1.650755e-5,0.080085,-127.018/ data v3,v2,v1,v0/1.353101e-9,-2.412044e-5,0.142117,-276.231/ c Rc: data r5,r4,r3/1.104315E-16,-4.10712E-12,6.09087E-8/ data r2,r1,r0/-4.50068E-4,1.65606d0,-2425.10/ c Rj: data rj5,rj4,rj3/-1.54735e-17,6.03503e-13,-9.19664e-09/ data rj2,rj1,rj0/6.8274e-05,-0.246383,345.733/ c Cf: data cu,cb,cv,cr,crj/567.1,1017.2,876.1,1452.0,2070.0/ c c-------------------------------------------------------------------- c 15 format(a30) c c------------------------------------------------- c c Type of the input file: 1 = lambda,F c 2 = lambda,I,sigma c 5252 write(*,52) 52 format(2x,'Type of the input file:'/ * 9x,'1 = lambda,F '/ * 9x,'2 = lambda,I,sigma '/ * 2x,'Your case: ',$) read(*,*,err=5252)jump goto(1111,2222)jump goto 5252 c c - reading data from the file: c 1111 write(*,30) 30 format(1x,'Input file [lambda,F]: ',$) read(*,15)in open(1,file=in,status='old') c------------------------------------------------- do 31 i=1,5000 31 read(1,*,end=32)al(i),f(i) 32 ndat=i-1 goto 3333 c 2222 write(*,33) 33 format(1x,'Input file [lambda,I,sigma]: ',$) read(*,15)in open(1,file=in,status='old') c------------------------------------------------- do 34 i=1,5000 34 read(1,*,end=35)al(i),ai(i),sigma(i) 35 ndat=i-1 c c================================================== c 3333 pu=0.0d0 pb=0.0d0 pv=0.0d0 prc=0.0d0 prj=0.0d0 c goto(111,222)jump c--11111111111111111111111111111111111111111111111111111111111-- c-- U -- 111 do 40 i=1,ndat if((al(i).gt.3010.0).and.(al(i).lt.4000.0))then pol_u=u3*al(i)**3+u2*al(i)**2+u1*al(i)+u0 pu=pu+pol_u*f(i) endif 40 continue c pu=0.8*pu du=-2.5*log10(1.d0+pu/cu) write(*,'(2x,a,f9.2)')' DU =',du c c-- B -- do 41 i=1,ndat if((al(i).gt.3720.0).and.(al(i).lt.5460.0))then pol_b=b3*al(i)**3+b2*al(i)**2+b1*al(i)+b0 pb=pb+pol_b*f(i) endif 41 continue c db=-2.5*log10(1.d0+pb/cb) write(*,'(2x,a,f9.2)')' DB =',db c c-- V -- do 42 i=1,ndat if((al(i).gt.4840.0).and.(al(i).lt.6600.0))then pol_v=v3*al(i)**3+v2*al(i)**2+v1*al(i)+v0 pv=pv+pol_v*f(i) endif 42 continue c dv=-2.5*log10(1.d0+pv/cv) write(*,'(2x,a,f9.2)')' DV =',dv c c-- Rc -- do 43 i=1,ndat if((al(i).gt.5530.0).and.(al(i).lt.8600.0))then pol_r1=r5*al(i)**5+r4*al(i)**4 pol_r2=r3*al(i)**3+r2*al(i)**2+r1*al(i)+r0 pol_r=pol_r1+pol_r2 prc=prc+pol_r*f(i) endif 43 continue c dr=-2.5*log10(1.d0+prc/cr) write(*,'(2x,a,f9.2)')' DRc=',dr c c-- Rj -- do 44 i=1,ndat if((al(i).gt.5200.0).and.(al(i).lt.9200.0))then pol_rj1=rj5*al(i)**5+rj4*al(i)**4 pol_rj2=rj3*al(i)**3+rj2*al(i)**2+rj1*al(i)+rj0 pol_rj=pol_rj1+pol_rj2 prj=prj+pol_rj*f(i) endif 44 continue c drj=-2.5*log10(1.d0+prj/crj) write(*,'(2x,a,f9.2)')' DRj=',drj goto 1000 c c--22222222222222222222222222222222222222222222222222222222222-- c c-- U -- 222 do 45 i=1,ndat if((al(i).gt.3010.0).and.(al(i).lt.4000.0))then pol_u=u3*al(i)**3+u2*al(i)**2+u1*al(i)+u0 pu=pu+2.507*pol_u*sigma(i)*ai(i) endif 45 continue c pu=0.8*pu du=-2.5*log10(1.d0+pu/cu) write(*,'(2x,a,f9.2)')' DU =',du c c-- B -- do 46 i=1,ndat if((al(i).gt.3720.0).and.(al(i).lt.5460.0))then pol_b=b3*al(i)**3+b2*al(i)**2+b1*al(i)+b0 pb=pb+2.507*pol_b*sigma(i)*ai(i) endif 46 continue c db=-2.5*log10(1.d0+pb/cb) write(*,'(2x,a,f9.2)')' DB =',db c c-- V -- do 47 i=1,ndat if((al(i).gt.4840.0).and.(al(i).lt.6600.0))then pol_v=v3*al(i)**3+v2*al(i)**2+v1*al(i)+v0 pv=pv+2.507*pol_v*sigma(i)*ai(i) endif 47 continue c dv=-2.5*log10(1.d0+pv/cv) write(*,'(2x,a,f9.2)')' DV =',dv c c-- Rc -- do 48 i=1,ndat if((al(i).gt.5530.0).and.(al(i).lt.8600.0))then pol_r1=r5*al(i)**5+r4*al(i)**4 pol_r2=r3*al(i)**3+r2*al(i)**2+r1*al(i)+r0 pol_r=pol_r1+pol_r2 prc=prc+2.507*pol_r*sigma(i)*ai(i) endif 48 continue c dr=-2.5*log10(1.d0+prc/cr) write(*,'(2x,a,f9.2)')' DRc=',dr c c-- Rj -- do 49 i=1,ndat if((al(i).gt.5200.0).and.(al(i).lt.9200.0))then pol_rj1=rj5*al(i)**5+rj4*al(i)**4 pol_rj2=rj3*al(i)**3+rj2*al(i)**2+rj1*al(i)+rj0 pol_rj=pol_rj1+pol_rj2 prj=prj+2.507*pol_rj*sigma(i)*ai(i) endif 49 continue c drj=-2.5*log10(1.d0+prj/crj) write(*,'(2x,a,f9.2)')' DRj=',drj c c------------------------------------------------------------ c 1000 stop end c------------------------------------------