PROGRAM MSAMPLE C C THIS TAKES VARIOUS CUTS IN ZCAT, IR IN THE MCG OR ESO OR IRAS C CATALOGS IN ZCAT FORMAT AND OUTPUTS THEM INTO C MSAMPLE.DAT C C NOTE: UNLESS OTHERWISE IDICATED, READS TYPES AS ALPHANUMERIC C AND DOES FUDGE CORRECTIONS FOR MAGNITUDES AS IN ZCOM UNLESS C OTHERWISE ASKED C LATEST VERSION J.P.H. 4/21/88 C MODIFIED TO ACCEPT INTERACTIVE INPUTS JPH C MODIFIED TO CUT ON VELOCITY SOURCES 5/4/88 JPH C MODIFIED TO IMPROVE INPUT AND OUTPUT FORMATS 8/31/91 JPH C MODIFIED YET AGAIN FOR OUTPUT FORMATS 11/29/92 JPH C Modified for new J2000 format for ZCAT 04/02 NM C & new "j" mag for 2dF objects CHARACTER*1 SIGN,S,FLAG,ASTER,AUG,MSS,YN CHARACTER*1 VEL CHARACTER*2 TTYP,QTYP(39),VSS,VPSS CHARACTER*3 ATYP,TELLMAG,TELLVEL,IVERR CHARACTER*4 DD1,DD2,DIST CHARACTER*5 AM,IUGC CHARACTER*7 IVVVV CHARACTER*6 BT CHARACTER*10 INAME CHARACTER*17 NAME CHARACTER*66 COMMENTS CHARACTER*15 COORDS1950 DIMENSION VTYP(39) DIMENSION ISCUT(2,20) REAL velreal DATA S,ASTER/'-','*'/ DATA QTYP/'-7','-6','-5','-4','-3','-2','-1',' 0',' 1', *' 2',' 3',' 4',' 5',' 6',' 7',' 8',' 9','10','11','12', *'15','16','20','25',' ','30','35','40','45','50','-9', *'26','24','27','31','32','33',' ','22'/ DATA VTYP/ -7 , -6 , -5 , -4 , -3 , -2 , -1 , 0 , 1 , * 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 , 11 , 12 , * 15 , 16 , 20 , 25 , 21 , 30 , 35 , 40 , 45 , 50 , -9 , * 26 , 24 , 27 , 31 , 32 , 33 , 21 , 22/ C THE NEXT SET OF STATEMENTS CONTAIN THE BASIC DELIMITERS C IN DEC, BII AND MAGNITUDE C AND INPUT ROUTINES FOR NEW STUFF TYPE 800 800 FORMAT(//' PROGRAM SAMPLE ',//10X,'ENTER INFO AS REQUIRED',/ -/,10X,'YES OR NO QUESTIONS REQUIRE A Y OR N: DEFAULT IS N',//) TYPE 901 901 FORMAT(2X,'WHAT CATALOG DO YOU WISH TO SEARCH? ',/, *7X,'ZCAT = Z',/ C *7X,'ZBIG = B',/ *7x,'2mass = 2',/ *7X,'ZWICKY-NILSON = N',/ *7X,'ESOCAT = E',/ *7X,'VV-MCG = V',/ *7X,'IRASGAL = I',/ *7X,'ABELL = A',/ *7X,'VELOCIT.DAT = P',/ *7X,' RETURN = ZCAT',/ C -' ENTER CATALOG CODE (Z,B,2,N,E,V,I,A,P) : '$) -' ENTER CATALOG CODE (Z,2,N,E,V,I,A,P) : '$) ACCEPT 902,YN 902 FORMAT(A1) INAME = ' ' IF(YN.EQ.'Z') INAME = ' ZCAT ' IF(YN.eq.'2') INAME = ' 2MASS ' C IF(YN.EQ.'B') INAME = ' ZBIG ' IF(YN.EQ.'N') INAME = ' ZNCAT ' IF(YN.EQ.'E') INAME = ' ESOCAT ' IF(YN.EQ.'V') INAME = ' VVMCG ' IF(YN.EQ.'I') INAME = ' IRASCAT ' IF(YN.EQ.'A') INAME = ' ABELLCAT ' IF(YN.EQ.'z') INAME = ' ZCAT ' C IF(YN.EQ.'b') INAME = ' ZBIG ' IF(YN.EQ.'P') INAME = ' VELOCITY ' IF(YN.EQ.'p') INAME = ' VELOCITY ' IF(YN.EQ.'n') INAME = ' ZNCAT ' IF(YN.EQ.'e') INAME = ' ESOCAT ' IF(YN.EQ.'v') INAME = ' VVMCG ' IF(YN.EQ.'i') INAME = ' IRASCAT ' IF(YN.EQ.'a') INAME = ' ABELLCAT ' IF(YN.EQ.'Z') GO TO 66 if(yn.eq.'2') go to 77 C IF(YN.EQ.'B') GO TO 71 IF(YN.EQ.'N') GO TO 61 IF(YN.EQ.'E') GO TO 62 IF(YN.EQ.'V') GO TO 63 IF(YN.EQ.'I') GO TO 68 IF(YN.EQ.'A') GO TO 69 IF(YN.eq.'2') go to 77 IF(YN.EQ.'z') GO TO 66 IF(YN.EQ.'n') GO TO 61 IF(YN.EQ.'e') GO TO 62 IF(YN.EQ.'v') GO TO 63 IF(YN.EQ.'i') GO TO 68 IF(YN.EQ.'a') GO TO 69 IF(YN.EQ.'P') GO TO 70 IF(YN.EQ.'p') GO TO 70 C ZCAT 66 CONTINUE c OPEN(UNIT=1,FILE='/dsk/extra/catalogs/zcat.dat',STATUS='OLD', c - ERR=9977) OPEN(UNIT=1,FILE='zcat.2000.dat',STATUS='OLD', - ERR=9977) GO TO 40 9977 write(6,*) 'Error opening input file ' stop 9977 C ZWICKY-NILSON 61 CONTINUE C OPEN(UNIT=1,FILE='/dsk/extra/catalogs/zn.zform',ERR=9977) OPEN(UNIT=1,FILE='zn.zform',ERR=9977) GO TO 40 C ESOCAT 62 CONTINUE OPEN(UNIT=1,FILE='ESOZFORM.DAT',STATUS='OLD') GO TO 40 C VV-MCG CATALOG 63 CONTINUE OPEN(UNIT=1,FILE='MCGZFORM.DAT',STATUS='OLD') GO TO 40 C IRAS 1.95 JY CATALOG 68 CONTINUE OPEN(UNIT=1,FILE='IRASZFORM.DAT',STATUS='OLD') GO TO 40 C ABELL CATALOG 69 CONTINUE OPEN(UNIT=1,FILE='ABELLZFORM.DAT',STATUS='OLD') C VELOCITY.DAT = PUBLIC ZCAT 70 CONTINUE C OPEN(UNIT=1,FILE='/dsk/images/pub/catalogs/velocity.dat') OPEN(UNIT=1,FILE='velocity.dat') go to 40 C ZBIG C 71 CONTINUE C OPEN(UNIT=1,FILE='ZBIG.DAT',STATUS='OLD') C GO TO 40 77 CONTINUE c OPEN(UNIT=1,File='galsz2.dat',status='old',err=9977) c OPEN(UNIT=1,File='/home/huchra/z/tmassv3.zcat', c * status='old',err=9977) OPEN(UNIT=1,File='/home/huchra/z/xsc.zcat', * status='old',err=9977) C DECLINATION RANGE 40 DMIN= 0.0 ! DECIMAL DEGREES -90 TO 90 DMAX= 90.0 TYPE 801,DMIN,DMAX 801 FORMAT(2X,'CURRENT DMIN - DMAX ARE: ',2F7.2, -' DO YOU WISH TO CHANGE? (Y/N): '$) ACCEPT 802,YN 802 FORMAT(A1) IF(YN.NE.'Y'.AND.YN.NE.'y') GO TO 700 TYPE 803 803 FORMAT(/3X,'INPUT DMIN AND DMAX (DECIMAL DEGREES): ',$) ACCEPT *,DMIN,DMAX C RIGHT ASCENSION RANGE 700 RMAX= 17.0 ! DECIMAL HOURS IE. 0 TO 24 RMIN= 8.0 TYPE 804,RMIN,RMAX 804 FORMAT(2X,'CURRENT RMIN - RMAX ARE: ',2F7.2, -' DO YOU WISH TO CHANGE? (Y/N): '$) ACCEPT 802,YN IF(YN.NE.'Y'.AND.YN.NE.'y') GO TO 701 TYPE 805 805 FORMAT(/3X,'INPUT RMIN AND RMAX (DECIMAL HOURS): ',$) ACCEPT *,RMIN,RMAX C GALACTIC LATITUDE RANGE 701 BUPPER=90. BCUT= 30.0 ! ABSOLUTE VALUE OF MINIMUM BII BMAX=90. BMIN=-90. TYPE 806 806 FORMAT(2X,'DO YOU WISH TO CUT IN GALACTIC COORDS?(Y/N): '$) ACCEPT 802,YN IGAL = 0 ! IF IGAL = 0 DO NOT CHECK LII AND BII IF(YN.NE.'Y'.AND.YN.NE.'y') GO TO 702 IGAL = 1 TYPE 807,BMIN,BMAX,BCUT 807 FORMAT(2X,'CURRENT BMIN, BMAX AND BCUT ARE: ',3F7.2, -' DO YOU WISH TO CHANGE? (Y/N): '$) ACCEPT 802,YN IF(YN.NE.'Y'.AND.YN.NE.'y') GO TO 702 TYPE 808 808 FORMAT(/3X,'INPUT BMIN, BMAX AND BCUT (DECIMAL DEGREES): ',$) ACCEPT *,BMIN,BMAX,BCUT C MAGNITUDE CUTS 702 ALIM= 15.5 AMIN=0.0 TYPE 809,AMIN,ALIM 809 FORMAT(2X,'CURRENT MAGNITUDE LIMITS ARE: ',2F8.2, -' DO YOU WISH TO CHANGE? (Y/N): '$) ACCEPT 802,YN IF(YN.NE.'Y'.AND.YN.NE.'y') GO TO 703 TYPE 810 810 FORMAT(/3X,'INPUT AMIN AND ALIM: ',$) ACCEPT *,AMIN,ALIM ICUTMAG=0 ! DO NOT EXCLUDE ZERO MAGS 703 TYPE 811 811 FORMAT(2X,'DO YOU WISH TO EXCLUDE OBJECTS WITHOUT MAGS?', -' (Y/N): ',$) ACCEPT 802,YN IF(YN.EQ.'Y'.OR.YN.EQ.'y') ICUTMAG = 1 ! EXCLUDE ZERO MAGS IFUDGE = 1 ! FUDGE THE MAGS FOR DIFF SOURCES (1=NO, 0=YES) TYPE 812 812 FORMAT(2X,'DO YOU WISH TO FUDGE THE MAGNITUDES? (Y/N): ',$) ACCEPT 802,YN IF(YN.EQ.'Y'.OR.YN.EQ.'y') IFUDGE = 0 IFUNK = 0 ! IFUNK = 0 TAKES ALL MAGS, = 1 CUTS OUT WIERDOS TYPE 843 843 FORMAT(2X,'DO YOU WISH TO ELIMINATE FUNKY MAGNITUDES? (Y/N): ',$) ACCEPT 802,YN IF(YN.EQ.'Y'.OR.YN.EQ.'y') IFUNK = 1 IF(IFUNK.EQ.1) TYPE 844 844 FORMAT(2X,' MAG SOURCES .NE. 0-9 or H, A or j' -' WILL BE ELIMINATED ') C VELOCITY CUTS IVMIN=-1000 ! minimum velocity IVMAX=99999 ! maximum velocity IEXCLUDE = 0 ! exclude zero velocities (1=yes) TYPE 813 813 FORMAT(2X,'DO YOU WISH TO EXCLUDE ZERO VELOCITY OBJECTS?' -' (Y/N): ',$) ACCEPT 802,YN IF(YN.EQ.'Y'.OR.YN.EQ.'y') IEXCLUDE = 1 TYPE 814,IVMIN,IVMAX 814 FORMAT(2X,'CURRENT VELOCITY LIMITS ARE:',2I6, -' DO YOU WISH TO CHANGE? (Y/N): '$) ACCEPT 802,YN IF(YN.NE.'Y'.AND.YN.NE.'y') GO TO 704 TYPE 815 815 FORMAT(/3X,'INPUT IVMIN AND IVMAX (INTEGERS): ',$) ACCEPT *,IVMIN,IVMAX 704 ITYPMIN = -10 ITYPMAX = 99 ITTEST = 0 TYPE 818 818 FORMAT(2x,'CURRENTLY STARS, ETC. WILL NOT BE EXCLUDED',/ - 10X,'DO YOU WISH TO CUT ON TYPE? (Y/N): ',$) ACCEPT 802,YN IF(YN.NE.'Y'.AND.YN.NE.'y') GO TO 707 ITTEST = 1 ITYPMAX=22 TYPE 816,ITYPMIN,ITYPMAX 816 FORMAT(2X,'CURRENT MORPHOLOGICAL TYPE LIMITS ARE: ',2I5, -' DO YOU WISH TO CHANGE? (Y/N): '$) ACCEPT 802,YN IF(YN.NE.'Y'.AND.YN.NE.'y') GO TO 707 TYPE 817 817 FORMAT(/3X,'INPUT ITYPMIN AND ITYPMAX ', - 5X'(NOTE THEY ARE ENCODED, BLANK=21): ',$) ACCEPT *,ITYPMIN,ITYPMAX 707 ISEARCHTYPE = 0 ! DO SEARCH INSIDE MAGNITUDE BOUNDS TYPE 819,AMIN,ALIM 819 FORMAT(2X,'CURRENT MAGNITUDE LIMITS ARE: ',F6.2,' TO ',F6.2, -' DO YOU WISH TO DO AN INVERTED SEARCH? (Y/N): '$) ACCEPT 802,YN IF(YN.NE.'Y'.AND.YN.NE.'y') GO TO 708 ISEARCHTYPE = 1 ! DO SEARCH OUTSIDE MAGNITUDE BOUNDS 708 ISOURCECUT = 0 ! DO NOT CUT ON SOURCES TYPE 820 820 FORMAT(2X,' DO YOU WISH TO CUT ON VELOCITY SOURCES? (Y/N): '$) ACCEPT 802,YN IF(YN.NE.'Y'.AND.YN.NE.'y') GO TO 705 ISOURCECUT = 1 ! LETS CUT ON SOURCES TYPE 821 821 FORMAT(2X,' INPUT NUMBER OF RANGES : ',$) ACCEPT *,NSOURCERANGE ! 1 FOR A SINGLE SOURCE IF(NSOURCERANGE.GT.20) TYPE 824 824 FORMAT(//////' TOO MANY --- TRY AGAIN '/////) type 877, nsourcerange 877 format(5x,'ranges=',i5) DO 822 III=1,NSOURCERANGE TYPE 823,III ACCEPT *,ISCUT(1,III),ISCUT(2,III) 822 CONTINUE 823 FORMAT(5X,'ENTER SOURCE RANGE',i5,': ',$) C END DELIMITER SECTION 705 NGAL=0 NVEL=0 Q=180./3.141592654 C DO 87 I=1,20 ! ENCODE TYPES C 87 VTYP(I) = -8 + I C VTYP(21) = 15 C VTYP(22) = 16 C VTYP(23) = 20 C VTYP(24) = 25 C VTYP(25) = -9 OPEN(UNIT=2,FILE='msample.out',STATUS='unknown') OPEN(UNIT=3,FILE='msample.err',STATUS='unknown') open(unit=4,file='msample.count',status='unknown') C open(unit=20,file='test.err',status='unknown') C UNIT 3 IS USED TO OUTPUT ZERO VELOCITY OBJECTS C ERRORS ARE TYPED OUT AS WELL WRITE(2,401)INAME,DMIN,DMAX,RMIN,RMAX,AMIN,ALIM,ITYPMIN, -ITYPMAX,BMIN,BMAX,IVMIN,IVMAX WRITE(3,401)INAME,DMIN,DMAX,RMIN,RMAX,AMIN,ALIM,ITYPMIN, -ITYPMAX,BMIN,BMAX,IVMIN,IVMAX TYPE 401,INAME,DMIN,DMAX,RMIN,RMAX,AMIN,ALIM,ITYPMIN, -ITYPMAX,BMIN,BMAX,IVMIN,IVMAX 401 FORMAT(/5X,'DATA FROM',A10,'SAMPLE LIMITS ARE',/ -10X,'DECLINATION BETWEEN ',F6.2,' AND ',F6.2,' DEGREES',/ -10X,'RIGHT ASCENSION BETWEEN ',F6.2,' AND ',F6.2,' HOURS',/ -10X,'MAGNITUDES BETWEEN ',F6.2,' AND ',F6.2,9X,/ -10X,'TYPES BETWEEN ',I6,' AND ',I6,/ -10X,'GALACTIC LATITUDE BETWEEN ',F6.2,' AND ',F6.2,' DEGREES', - /,10X,'VELOCITIES BETWEEN ',I6,' AND ',I6,' KM/S') if(igal.ne.0) write(3,654) BCUT if(igal.ne.0) write(2,654) BCUT if(igal.ne.0) type 654, BCUT 654 format(12x,'AND ABOVE ABS BL = ',f6.2,' DEGREES') TELLMAG = 'NOT' TELLVEL = 'NOT' IF(ICUTMAG.EQ.1) TELLMAG = ' ' IF(IEXCLUDE.EQ.1) TELLVEL = ' ' WRITE (3,601) TELLMAG,TELLVEL WRITE (2,601) TELLMAG,TELLVEL TYPE 601, TELLMAG,TELLVEL 601 FORMAT(10X,'GALAXIES WITHOUT MAGNITUDES ARE ',A3,' EXCLUDED',/ - 10X,'GALAXIES WITHOUT VELOCITIES ARE ',A3,' EXCLUDED') IF(IFUNK.EQ.1) TYPE 611 611 FORMAT(10X,'GALAXIES WITH FUNKY MAGNITUDES ARE EXCLUDED') IF(ISOURCECUT.EQ.0) GO TO 605 WRITE (3,604) NSOURCERANGE WRITE (2,604) NSOURCERANGE TYPE 604, NSOURCERANGE 604 FORMAT(10X,'CUT ALSO ON ',I2,' SOURCE RANGES : ') WRITE (3,602) (ISCUT(1,III),ISCUT(2,III),III=1, -NSOURCERANGE) WRITE (2,602) (ISCUT(1,III),ISCUT(2,III),III=1, -NSOURCERANGE) TYPE 602, (ISCUT(1,III),ISCUT(2,III),III=1, -NSOURCERANGE) 602 FORMAT(20X,I4,' TO ',I4) 605 WRITE(3,449) C TYPE 449 449 FORMAT(' LISTING OF ZERO VELOCITY OBJECTS',//) C TYPE 459 C WRITE(3,459) C 459 FORMAT(//' DRESSLER SAMPLE - GALAXIES BETWEEN ',/ C -15X,'-33 < BII < +50 ',/15X,'290 < LII < 350 ',//) KKTEST=0 DO 10 J=1,1500000 c type 606,J 606 format(' at ',i6) 1 KKTEST=KKTEST+1 C READ(1,100,END=99,ERR=98) NAME,IRA,IR,ARA,SIGN,ID1, C -ID2,ID3,AM,IVVVV,IVERR,MSS,VSS,VPSS,TTYP,ATYP,DD1, C - DD2,BT,IUGC,AUG,DIST,FLAG,COMMENTS READ(1,100,END=99,ERR=98) NAME,IRA,IR,ARA,SIGN,ID1, ! J2000 format -ID2,ID3,AM,IVVVV,IVERR,MSS,VSS,VPSS,TTYP,ATYP,DD1, - DD2,BT,IUGC,AUG,DIST,FLAG,COORDS1950,COMMENTS C test to find out if the read is successfull C write(20,100) NAME,IRA,IR,ARA,SIGN,ID1, ! J2000 format C -ID2,ID3,AM,IVVVV,IVERR,MSS,VSS,VPSS,TTYP,ATYP,DD1, C - DD2,BT,IUGC,AUG,DIST,FLAG,COORDS1950,COMMENTS C SEPARATE FORMATS FOR DIFFERENT CATALOGS C EXERCISE CARE WITH THESE!! c 100 FORMAT(A11,2I2.2,F4.1,A1,3I2.2,F5.2,I5,I3,A1,I2,I2, ! numeric fomat c -A2,A3,2A4,F6.2,I5,A1,F4.1,A1,A45) C 100 FORMAT(A11,2I2.2,F4.1,A1,3I2.2,A5,A5,A3,A1,2A2, ! alpha format C -A2,A3,2A4,A6,A5,A1,A4,A1,A45) 100 FORMAT(A17,2I2.2,F4.1,A1,3I2.2,A5,A7,A3,A1,2A2, ! J2000 alpha format -A2,A3,2A4,A6,A5,A1,A4,A1,A15,A66) GO TO 7 C ERROR OUTPUT SECTION 98 WRITE(3,445) KKTEST TYPE 445, KKTEST C WRITE(3,100) NAME, IRA,IR,ARA,SIGN,ID1,ID2,ID3,AM, C - IVVVV,IVERR,MSS,VSS,VPSS,TTYP,ATYP,DD1,DD2,BT,IUGC,AUG, C - DIST,FLAG,COMMENTS C TYPE 100, NAME, IRA,IR,ARA,SIGN,ID1,ID2,ID3,AM, C - IVVVV,IVERR,MSS,VSS,VPSS,TTYP,ATYP,DD1,DD2,BT,IUGC,AUG, C - DIST,FLAG,COMMENTS WRITE(3,100) NAME,IRA,IR,ARA,SIGN,ID1, ! J2000 format - ID2,ID3,AM,IVVVV,IVERR,MSS,VSS,VPSS,TTYP,ATYP,DD1, - DD2,BT,IUGC,AUG,DIST,FLAG,COORDS1950,COMMENTS TYPE 100, NAME,IRA,IR,ARA,SIGN,ID1, ! J2000 format - ID2,ID3,AM,IVVVV,IVERR,MSS,VSS,VPSS,TTYP,ATYP,DD1, - DD2,BT,IUGC,AUG,DIST,FLAG,COORDS1950,COMMENTS C DECODE MAG,VEL, ETC 7 continue c write(4,197) KKTEST c 197 format(i6) READ(AM(1:5),20) ZMAG 20 FORMAT(F5.2) C test IVVVV to find out if velocity C in z or v format (F7.4 or I7) ivelchar = 0 do 15 ij=1,7 read(IVVVV(ij:ij),14) vel 14 format(a1) if(vel.eq.'.') ivelchar = ivelchar + 1 15 continue if(ivelchar.eq.0) goto 18 read(IVVVV(1:7),23) velreal 23 format(f7.4) IVEL = INT(velreal * 299762.458) C write(20,24) IVVVV, IVEL C 24 format(' IVVV = ',a7,' IVEL = ',i7) goto 16 18 READ(IVVVV(1:7),19) IVEL 19 FORMAT(I7) C write(20,24) IVVVV, IVEL 16 ITEST=IRA+IR+ID1+ID2+IVEL IF (ITEST.EQ.0) GO TO 1 READ(VSS(1:2),21) IVSS READ(VPSS(1:2),21) IVPSS 21 FORMAT(I2) C SET UP ITYP ITYP=0 DO 86 KK=1,39 IF(TTYP.EQ.QTYP(KK)) ITYP = VTYP(KK) 86 CONTINUE C SPECIAL SECTION TO ZERO OUT UNAVAILABLE VELOCITIES C IF (IVSS.LT.0) IVEL = 0 C IF (IVSS.LT.0) IVVVV = ' ' C IF(IVSS.LT.0) IVERR = ' ' C CUT FOR SEVEN SAMURAI SAMPLE C IF(FLAG.EQ.ASTER) WRITE(3,100) C - NAME, IRA,IR,ARA,SIGN,ID1,ID2,ID3,AM, C - IVVVV,IVERR,MSS,VSS,VPSS,TTYP,ATYP,DD1,DD2,BT,IUGC, C - AUG,DIST,FLAG,COMMENTS IF(FLAG.EQ.'0') FLAG = ' ' C FIX MAGNITUDES BY FUDGE FACTORS IF(IFUDGE.NE.0) GO TO 91 IF(MSS.EQ.'3') ZMAG=ZMAG+1.38 ! Tully-Fisher IF(MSS.EQ.'4') ZMAG=ZMAG+0.34 ! Rubin-Ford Thonnard-Roberts-Graham IF(MSS.EQ.'5') ZMAG=ZMAG+0.5 ! not yet fixed, Markarian too faint IF(MSS.EQ.'6') ZMAG=ZMAG+0.4 ! BT IF(MSS.EQ.'A') ZMAG=ZMAG+0.4 ! BT SURROGATE FROM RC3 IF(MSS.EQ.'7') ZMAG=ZMAG+0.5 ! VV IF(MSS.EQ.'R'.AND.ITYP.LE.1) ZMAG=ZMAG+1.8 ! go to 1 ! RED MAGNITUDES FOR ELLIPTICALS B-R = 1.8 IF(MSS.EQ.'R'.AND.ITYP.GT.1) ZMAG=ZMAG+1.4 ! go to 1 ! RED MAGNITUDES FOR SPIRALS B-R = 1.4 IF(MSS.EQ.'r'.AND.ITYP.LE.1) ZMAG=ZMAG+1.8 ! go to 1 ! RED MAGNITUDES FOR ELLIPTICALS B-R = 1.8 IF(MSS.EQ.'r'.AND.ITYP.GT.1) ZMAG=ZMAG+1.4 ! go to 1 ! RED MAGNITUDES FOR SPIRALS B-R = 1.4 IF(MSS.EQ.'V'.AND.ITYP.LE.1) ZMAG=ZMAG+1.0 ! go to 1 ! VISUAL MAGNITUDES FOR ELLIPTICAL B-V = 1.0 IF(MSS.EQ.'V'.AND.ITYP.GT.1) ZMAG=ZMAG+0.7 ! go to 1 ! VISUAL MAGNITUDES FOR SPIRALS B-V = 0.7 IF(MSS.EQ.'W'.AND.ITYP.LE.1) ZMAG=ZMAG+1.0 ! go to 1 ! VISUAL MAGNITUDES FOR ELLIPTICAL B-V = 1.0 IF(MSS.EQ.'W'.AND.ITYP.GT.1) ZMAG=ZMAG+0.7 ! go to 1 ! VISUAL MAGNITUDES FOR SPIRALS B-V = 0.7 IF(MSS.EQ.'v'.AND.ITYP.LE.1) ZMAG=ZMAG+1.0 ! go to 1 ! VISUAL MAGNITUDES FOR ELLIPTICAL B-V = 1.0 IF(MSS.EQ.'v'.AND.ITYP.GT.1) ZMAG=ZMAG+0.7 ! go to 1 ! VISUAL MAGNITUDES FOR SPIRALS B-V = 0.7 IF(MSS.EQ.'G') ZMAG=ZMAG+1.7 ! go to 1 ! Guide Star Catalog IF(MSS.EQ.'I'.AND.ITYP.LE.1) ZMAG=ZMAG+2.7 ! go to 1 ! VISUAL MAGNITUDES FOR ELLIPTICAL B-V = 1.0 IF(MSS.EQ.'I'.AND.ITYP.GT.1) ZMAG=ZMAG+2.3 ! go to 1 ! VISUAL MAGNITUDES FOR SPIRALS B-V = 0.7 C IF(MSS.EQ.'j') ZMAG=ZMAG+x.xx ! to be supplied by John C GET RID OF CENTURY SURVEY OBJECTS? IF(MSS.EQ.'D'.AND.ITYP.LE.1) go to 1 ! ZMAG=ZMAG+1.8 ! RED MAGNITUDES FOR ELLIPTICALS B-R = 1.8 IF(MSS.EQ.'D'.AND.ITYP.GT.1) go to 1 ! ZMAG=ZMAG+1.4 ! RED MAGNITUDES FOR SPIRALS B-R = 1.4 91 CONTINUE IF(IFUNK.EQ.0) GO TO 92 ! KEEP ALL MAGNITUDES IF(MSS.EQ.' ') GO TO 92 IF(MSS.EQ.'0') GO TO 92 IF(MSS.EQ.'1') GO TO 92 IF(MSS.EQ.'2') GO TO 92 IF(MSS.EQ.'3') GO TO 92 IF(MSS.EQ.'4') GO TO 92 IF(MSS.EQ.'5') GO TO 92 IF(MSS.EQ.'6') GO TO 92 IF(MSS.EQ.'7') GO TO 92 IF(MSS.EQ.'8') GO TO 92 IF(MSS.EQ.'9') GO TO 92 IF(MSS.EQ.'A') GO TO 92 IF(MSS.EQ.'H') GO TO 92 IF(MSS.EQ.'j') GO TO 92 GO TO 1 ! ALL OTHER MAGS ELIMINATED 92 CONTINUE IVSSS=100*IVSS+IVPSS IF(ISOURCECUT.EQ.0) GO TO 791 ! DON'T CUT ON SOURCES DO 792 III = 1,NSOURCERANGE IF(IVSSS.GE.ISCUT(1,III).AND.IVSSS.LE.ISCUT(2,III)) GO TO 791 792 CONTINUE GO TO 1 791 RA=IRA ARB=IR+ARA/60. D1=ID1 D2=ID2 D3=ID3 88 IF(SIGN.EQ.S) D1=-D1 IF(D1.LT.0.0.OR.SIGN.EQ.S) D2=-D2 IF(D1.LT.0.0.OR.SIGN.EQ.S.OR.D2.LT.0.0) D3=-D3 DECCO=D1 + D2/60. +D3/3600. RECCO=RA + ARB/60. C --------------- END INPUT SECTION ---------- C MAGNITUDE CUT C IF(FLAG.EQ.ASTER) GO TO 22 ! FOR DRESSLER IF(ICUTMAG.EQ.1.AND.ZMAG.EQ.0.0) GO TO 1 IF(ISEARCHTYPE.EQ.1) GO TO 322 IF(ZMAG.GT.ALIM.OR.ZMAG.LT.AMIN) GO TO 1 GO TO 22 322 IF(ZMAG.LT.ALIM.AND.ZMAG.GT.AMIN) GO TO 1 22 CONTINUE C VELOCITY CUT IF(IVEL.GT.IVMAX) GO TO 1 IF(IVEL.LT.IVMIN) GO TO 1 IF(IEXCLUDE.EQ.1.AND.IVEL.EQ.0) GO TO 1 C MORPHOLOGICAL TYPE CUT IF(ITTEST.EQ.0) GO TO 610 c type 879,name,ttyp,atyp,ityp c 879 format(1x,a17,3x,a2,a3,2x,i4) IF(ITYP.LT.ITYPMIN.OR.ITYP.GT.ITYPMAX) GO TO 1 610 CONTINUE C DANVERS FORM FOR INCLINATION WITH R(UGC) TRANSFORMED TO R(RC2) C NOTE THAT DIAMETERS NOW ENCODED AS ALPHANUMERIC C IF(DD1.EQ.0.0) GO TO 1 C IF(DD2.EQ.0.0) GO TO 1 C GAGA = (1.042*(DD2/DD1)**1.79-0.042) C IF(GAGA.LT.0.00) GAGA=1.0E-05 C IF(GAGA.GT.1.0) GAGA=1.0 C AXIS=Q*ACOS(SQRT(GAGA)) +3.0 C IF(AXIS.LE.45.0.OR.AXIS.GE.85.) GO TO 1 C COORDINATE CUTS IF(DECCO.LT.DMIN.OR.DECCO.GE.DMAX) GO TO 1 IF(RMAX.GT.RMIN) GO TO 6 IF(RECCO.GT.RMAX.AND.RECCO.LT.RMIN) GO TO 1 ! CASE FOR SGP GO TO 8 6 CONTINUE IF(RECCO.LT.RMIN) GO TO 1 IF(RECCO.GT.RMAX) GO TO 99 8 CONTINUE C GALACTIC COORDINATE CUT IF(IGAL.EQ.0) GO TO 600 CALL CONV(RA,ARB,D1,D2,TL,TB) TBA =ABS(TB) type 655, name,recco,decco,tba 655 format(2x,a17,2f10.5,2x,f7.3) IF(TBA.LT.BCUT) GO TO 1 IF(TB.LT.BMIN.OR.TB.GT.BMAX) GO TO 1 600 CONTINUE C FOR DRESSLER'S SAMPLE C IF(TB.LT.-33.0.OR.TB.GE.+50.0) GO TO 1 C IF(TL.LT.290.0.OR.TL.GE.350.0) GO TO 1 C -------------------------------------------------------------------- C C OUTPUT SECTION C ____________________________________________________________________ NT=NT+1 IF(IVEL.NE.0) NVEL=NVEL+1 IF(IVEL.EQ.0) WRITE(3,100) ! ZERO VELOCITY OBJECTS - NAME,IRA,IR,ARA,SIGN,ID1,ID2,ID3,AM, - IVVVV,IVERR,MSS,VSS,VPSS,TTYP,ATYP,DD1,DD2,BT,IUGC, - AUG,DIST,FLAG,COORDS1950,COMMENTS ID1=ABS(D1) ID2=ABS(D2) IRS=ARA ARA1=ARA-IRS NGAL=NGAL+1 C WRITE(2,101) NAME,IRA,IR,IRS,ARA,SIGN,ID1,ID2,ID3,AM, C - IVVVV,IVERR,MSS,VSS,VPSS,TTYP,ATYP,DD1,DD2,BT,IUGC, C - AUG,DIST,FLAG,COMMENTS WRITE(2,101)NAME,IRA,IR,ARA,SIGN,ID1, ! J2000 format -ID2,ID3,AM,IVVVV,IVERR,MSS,VSS,VPSS,TTYP,ATYP,DD1, - DD2,BT,IUGC,AUG,DIST,FLAG,COORDS1950,COMMENTS C 101 FORMAT(A11,3I2.2,F2.1,A1,3I2.2,F5.2,I5,I3,A1,I2,I2.2, ! NUMERIC FORMAT C -A2,A3,2A4,F6.2,I5,A1,F4.1,A1,A45) C 101 FORMAT(A11,3I2.2,F2.1,A1,3I2.2,A5,A5,A3,A1,2A2, ! ALPHA FORMAT C -A2,A3,2A4,A6,A5,A1,A4,A1,A45) 101 FORMAT(A17,2I2.2,F4.1,A1,3I2.2,A5,A7,A3,A1,2A2, ! J2000 alpha format -A2,A3,2A4,A6,A5,A1,A4,A1,A15,A66) C WRITE(2,110) 110 FORMAT(10X) 10 CONTINUE 445 FORMAT(//' ERROR IN READ AT ',I6/) 99 WRITE(3,444) NGAL,NVEL TYPE 444,NGAL,NVEL TYPE 446,J,NAME,IRA,IR,ARA 446 FORMAT(//' LAST GALAXY SEARCHED', I7,2X,A17,I4,I3,F5.1) WRITE(2,444) NGAL, NVEL 444 FORMAT(///5X,'NUMBER OF GALAXIES IS ',I6,/ -7X,'NUMBER WITH VELOCITIES IS ',I6///) CLOSE(UNIT=1) CLOSE(UNIT=2) CLOSE(UNIT=3) CLOSE(UNIT=4) C CLOSE(UNIT=20) STOP 9999 END SUBROUTINE CONV(RAHR,RAMIN,DDEG,DMIN,TLL,TBB) C--------CONVERTS FROM RA AND DEC TO L2 AND B2.RAHR=HRS OF RA,RAMIN= C--------MINUTES OF RA,DDEG=DEGREES OF DEC,DMIN=MINUTES OF DEC,TL=L2 DEGREES C---------TB=B2 IN DEGREES REAL*8 QQ,RAANG,RANGC,DANG,TA,TB,TL,C,S,AC,TLC,SD,CD,SR,CR, *STEST QQ=3.141592654/180. C = 0.460199785 S = 0.887815385 AC = 4.926191814 TLC = 0.575958653 RAANG = (15.*RAHR+0.25*RAMIN)*QQ RANGC = RAANG + 1.356993493 DANG = (DDEG+(DMIN/60.))*0.0174532925 SD = DSIN(DANG) CD = DCOS(DANG) SR = DSIN(RANGC) CR = DCOS(RANGC) TB = DASIN(-CD*SR*S+SD*C) TA=DCOS(TB) TB = TB*57.29577951 IF(DABS(TB).EQ.90.) GO TO 90 STEST = CD*SR*C+SD*S TL = (CD*CR/TA) IF(TL.GE.1.00) TL=1.00000000000 IF(TL.LE.-1.000) TL=-1.00000000 TL=DACOS(TL) IF(STEST.LT.0) TL = 6.28318531 -TL TL = TL + TLC TL = TL*57.29577951 GO TO 100 90 TL = 0 100 CONTINUE TBB=TB TLL=TL RETURN END