CThe data for 1153 galaxies are in ir.cat. The columns are as in our C paper: G.R.Knapp et al. 1989, ApJ Suppl 70, 329. CThe IR flux densities are in Jy, the 1 sigma noise in mJy. These Care *NOT* corrected for the scale differences. The program calc.for C(see source deck below) does this, rounds them off, and Cperforms various manipulations to the optical magnitudes Cthat you may or may not care about. C The redshifts are from C RC2 (Sec.Ref.Cat., deVaucouleurs) C RSA= Rev. Shapley-Ames, Sandage & Tammann 1981, Carnegie C Davies et al. (see Burstein et al. 87, Ap.J.Suppl. 64,601 ('7 Samurai')) C ZCAT = CfA redshift survey (J.P.Huchra, priv.comm.) C Have fun. Jill R. Knapp c Program to correct blue magnitudes and IR fluxes for E/S0 Galaxies c in paper of J.R.Knapp et al. 1989, ApJSuppl. 70, 329 common const,twopi,signt,sign0,ra,alpha common dec,delta,epoch,xl2,xb2 character *1 sign,magtype character *8 name character*9 name1 character*7 mortyp integer r1,r2,r3,d1,d2,d3 real*4 kcor conv = 3.141592653898/180. open (8,file='output.dat',status='mod') rewind 8 open(9,file='color.dat',status='mod') rewind 9 open (3,file='table2',status='old') rewind 3 open(4,file='types.dat',status='old') rewind 4 10 read (3,15,end=60) name,mortyp,r1,r2,r3,sign,d1,d2,d3, 1 bt,magtype,iv,s12,n12,s25,n25,s60,n60,s100,n100 15 format (a8,a5,3i2,1x,a1,3i2,f5.1,a1,i5,f6.2,i3,f6.2,i3, 1 f7.2,i4,f7.2,i4) read (4,16,end=60) name1,color 16 format(1x,a9,29x,f4.2) c c calculate galactic coords l,b from subroutine pregal c ras = r3 decs = d3 call pregal (r1,r2,ras,sign,d1,d2,decs,xl1,xb1) ra=ra/15./conv dec=dec/conv xl = xl1 * conv xb = xb1 * conv c calculate ab if it is zero; correct zwicky magnitudes c = abs(1./sin(xb + 0.00436 - 0.0297*sin(xl) - 0.0175*cos(3*xl))) if (xb .gt. 0.) then sn = 0.1948*cos(xl) + 0.0725*sin(xl) 1 + 0.1168*cos(2*xl) - 0.0921*sin(2*xl) 1 + 0.1147*cos(3*xl) + 0.0784*sin(3*xl) 1 + 0.0479*cos(4*xl) + 0.0847*sin(4*xl) ab = 0.19*(1. + sn*cos(xb))*c else ss = 0.2090*cos(xl) - 0.0133*sin(xl) 1 + 0.1719*cos(2*xl) - 0.0214*sin(2*xl) 1 - 0.1071*cos(3*xl) - 0.0014*sin(3*xl) 1 + 0.0681*cos(4*xl) + 0.0519*sin(4*xl) ab = 0.21*(1. + ss*cos(xb))*c end if if (magtype .eq. 'z') then call zwicky(ra,dec,bt,btc) bt=btc end if v=iv if(iv.eq.0.) v=3500. kcor=1.5e-5*v if(magtype.eq.'b') go to 30 bt=bt-kcor 30 bt0=bt-ab bt0 = int(100.*bt0 + 0.5)/100. if(bt.eq.0.) bt0=0. c Now correct colors for extinction and redshift if(color.eq.0.) go to 40 color = color-ab/4.1 - 9.5e-6*v c 40 continue c c Correct micron flux densities xn12=n12 xn25=n25 xn60=n60 xn100=n100 s12=s12*0.947 s25=s25*0.935 s60=s60*1.028 s100=s100*0.889 xn12=xn12*0.947 xn25=xn25*0.935 xn60=xn60*1.028 xn100=xn100*0.889 c c Put flux densities in mJy c is12=int(1000.*s12 + 0.5) is25=int(1000.*s25 + 0.5) is60=int(1000.*s60 + 0.5) is100=int(1000.*s100 +0.5) n12=int(100.*xn12+0.5)/100. n25=int(100.*xn25+0.5)/100. n60=int(100.*xn60+0.5)/100. n100=int(100.*xn100+0.5)/100. c if(color.eq.0.) go to 44 absm=bt0-25. xlb=(5.48-absm)/2.5 xlb=10.**xlb xl100=9.38e5*s100 rir=xl100/xlb xu100=938*n100 uir=xu100/xlb if(s100.gt.0.) uir=0. c write(9,11) color,rir,uir,mortyp,name1,name c1 format(f9.2,1x,2(1pe10.2),1x,a7,a9,a8) write(9,11) name1,name,color 11 format(1x,a9,a8,f9.2) 44 continue write(8,50) name,mortyp,bt0,iv,is12,n12, 1 is25,n25,is60,n60,is100,n100 50 format(a8,1x,a5,1x,f5.1,1x,i5,2(i5,i4), 1 1x,2(i6,i5)) goto 10 60 continue end SUBROUTINE PREGAL (irah,iram,ras,sign,idecd,idecm,decs,xlx,xbx) c Precesses coordinates to any epoch and calculates l2 and b2 c Modified for epoch=1950,day=0 with mean places; no reads or writes - pec common const,twopi,signt,sign0,ra,alpha common dec,delta,epoch,xl2,xb2 character*1 sign,sign2 const=3.1415926535898/180. twopi=360./3.1415926535898 yr = 1950. day = 0. epoch = 1950. ppoch=yr+day/365.25 ra=(irah+iram/60.+ras/3600.)*15.*const isign=1 if(sign.eq.'-') isign=-1 dec=isign*(idecd+idecm/60.+decs/3600.)*const call preces(1950.) call galcon call preces(ppoch) itest = 0 30 asp=alpha/const/15. dsp=delta/const ih=asp m=(asp-ih)*60. s=(asp-ih-m/60.)*3600. id=dsp idm=(dsp-id)*60. ds=(dsp-id-idm/60.)*3600. id=iabs(id) idm=iabs(idm) ds=abs(ds) sign2='+' if(dsp.lt.0.) sign2='-' xlx=xl2 xbx=xb2 return end c ------------------------------------------------------------- subroutine preces(pepoch) common const,twopi,signt,sign0,ra,alpha common dec,delta,epoch,xl2,xb2 t0=(epoch-1900.)/100. t=(pepoch-epoch)/100. zeta=(2304.25+1.396*t0)*t+0.302*t**2+0.018*t**3 z=zeta+0.791*t**2 theta=(2004.682-0.853*t0)*t-0.426*t**2-0.042*t**3 zeta=const*zeta/3600. z=const*z/3600. theta=const*theta/3600. tth=tan(theta/2.0) q=sin(theta)*(tan(dec)+tth*cos(ra+zeta)) q1=q*sin(ra+zeta)/(1.0-q*cos(ra+zeta)) dra=atan(q1) q2=tth*(cos(ra+zeta)-sin(ra+zeta)*tan(0.5*dra)) ddec=2.*atan(q2) alpha=ra+zeta+z+dra delta=dec+ddec if(alpha.gt.twopi) alpha=alpha-twopi if(alpha.lt.0.0) alpha=alpha+twopi return end c ----------------------------------------------------------------- subroutine galcon common const,twopi,signt,sign0,ra,alpha common dec,delta,epoch,xl2,xb2 alpol=282.25*const delpol=62.6*const q1=cos(delta)*cos(alpha-alpol) q2=cos(delta)*sin(alpha-alpol)*cos(delpol)+sin(delta)*sin(delpol) q3=-cos(delta)*sin(alpha-alpol)*sin(delpol)+sin(delta)*cos(delpol) xl2=(atan2(q2,q1))/const + 33. xb2=(asin(q3))/const if(xl2.gt.360.) xl2=xl2-360. if(xl2.lt.0.) xl2=xl2+360. return end c-------------------------------------------------------------------------- subroutine zwicky(ra,dec,bt,btc) btc=bt if(dec.lt.-3.or.dec.gt.15.) go to 200 if(ra.lt.7.1.or.ra.gt.18.27) goto 200 if(bt.lt.10.) then btc=bt+0.67 go to 500 end if if(bt.ge.10.and.bt.le.12.9) then btc=bt-0.46 go to 500 end if if(bt.ge.13.and.bt.le.13.9) then btc=bt-0.52 go to 500 end if if(bt.ge.14.and.bt.le.14.9) then btc=bt-0.17 go to 500 end if if(bt.ge.15.and.bt.le.15.5) then btc=bt+0.19 go to 500 end if if(bt.ge.15.6.and.bt.le.15.7) then btc=bt+0.48 go to 500 end if 200 if(bt.lt.10.) then btc=bt+0.02 go to 500 end if if(bt.ge.10.and.bt.le.11.9) then btc=bt-0.06 go to 500 end if if(bt.ge.12.and.bt.le.12.9) then btc=bt-0.09 go to 500 end if if(bt.ge.13.and.bt.le.13.9) then btc=bt-0.19 go to 500 end if if(bt.ge.14.and.bt.le.14.9) then btc=bt-0.17 go to 500 end if if(bt.ge.15.and.bt.le.15.5) then btc=bt-0.03 go to 500 end if if(bt.ge.15.6.and.bt.le.15.7) then btc=bt-0.04 go to 500 end if 500 return