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 C MODIFIED TO CUT ON VELOCITY SOURCES 5/4/88 CHARACTER*1 SIGN,S,FLAG,ASTER,AUG,MSS,YN CHARACTER*10 NAME,DUMMY,INAME CHARACTER*20 COMMENTS CHARACTER*3 ATYP,TELLMAG,TELLVEL CHARACTER*2 VPSS,TTYP,QTYP(30) DIMENSION VTYP(30) DIMENSION ISCUT(2,20) INTEGER VSS 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'/ 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',/ *7X,'ZWICKY-NILSON = N',/ *7X,'ESOCAT = E',/ *7X,'VV-MCG = V',/ *7X,'IRASGAL = I',/ -' ENTER CATALOG CODE (Z,N,E,V,I) : '$) ACCEPT 902,YN 902 FORMAT(A1) IF(YN.EQ.'Z') INAME = ' ZCAT ' 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.'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 C ZCAT 66 CONTINUE OPEN(UNIT=1,FILE='SYSUTIL:[CATALOGS]ZCAT.DAT',STATUS='OLD', -READONLY) GO TO 40 C ZWICKY-NILSON 61 CONTINUE OPEN(UNIT=1,FILE='SYSUTIL:[CATALOGS]ZNCATZFORM.DAT', -STATUS='OLD',READONLY) GO TO 40 C ESOCAT 62 CONTINUE OPEN(UNIT=1,FILE='SYSUTIL:[CATALOGS]ESOZFORM.DAT',STATUS='OLD', -READONLY) GO TO 40 C VV-MCG CATALOG 63 CONTINUE OPEN(UNIT=1,FILE='SYSUTIL:[CATALOGS]MCGZFORM.DAT',STATUS='OLD', -READONLY) GO TO 40 C IRAS 1.95 JY CATALOG 68 CONTINUE OPEN(UNIT=1,FILE='USER:[HUCHRA.IRAS]IRASZFORM.DAT',STATUS='OLD', -READONLY) 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 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 = 24 ITTEST = 0 TYPE 818 818 FORMAT(2X,'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 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 (NOTE THEY ARE' -' ENCODED): ',$) 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 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 '/////) DO 822 III=1,NSOURCERANGE TYPE 823,III ACCEPT *,ISCUT(1,III),ISCUT(2,III) 822 CONTINUE 823 FORMAT(5X,'ENTER SOURCE RANGE ',I2,' (2xI2) : '$) C END DELIMITER SECTION 705 NGAL=0 NVEL=0 Q=180./3.141592654 DO 87 I=1,20 ! ENCODE TYPES 87 VTYP(I) = -8 + I VTYP(21) = 15 VTYP(22) = 16 VTYP(23) = 20 VTYP(24) = 25 VTYP(25) = -9 OPEN(UNIT=2,FILE='SYSUTIL:[CATALOGS]MSAMPLE.OUT',STATUS='NEW') 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 WRITE(3,401)INAME,DMIN,DMAX,RMIN,RMAX,AMIN,ALIM,ITYPMIN, -ITYPMAX,BMIN,BMAX TYPE 401,INAME,DMIN,DMAX,RMIN,RMAX,AMIN,ALIM,ITYPMIN, -ITYPMAX,BMIN,BMAX 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,' AND',/ -10X,'TYPES BETWEEN ',I6,' AND ',I6,/ -10X,'GALACTIC LATITUDE BETWEEN ',F6.2,' AND ',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(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,I3,' TO ',I3) 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 ',//) DO 10 J=1,50000 1 READ(1,100,END=99,ERR=98) NAME,IRA,IR,ARA,SIGN,ID1, -ID2,ID3,AM,IVVVV,IVERR,MSS,VSS,VPSS,TTYP,ATYP,DD1, - DD2,BT,IUGC,AUG,DIST,FLAG,COMMENTS GO TO 7 C ERROR OUTPUT SECTION 98 WRITE(3,445) TYPE 445 TYPE 100, NAME, IRA,IR,ARA,SIGN,ID1,ID2,ID3,AM, - IVVVV,IVERR,MSS,VSS,VPSS,TTYP,ATYP,DD1,DD2,BT,IUGC,AUG, - DIST,FLAG,COMMENTS C SEPARATE FORMATS FOR DIFFERENT CATALOGS C EXERCISE CARE WITH THESE!! 100 FORMAT(1X,A10,2I2,F4.1,A1,3I2,F5.2,I5,I3,A1,I2,A2, -A2,A3,2F4.1,F6.2,I5,A1,F4.1,A1,A20) 7 ITEST=IRA+IR+ID1+ID2+IVVVV IF (ITEST.EQ.0) GO TO 1 C SET UP ITYP ITYP=0 DO 86 KK=1,30 IF(TTYP.EQ.QTYP(KK)) ITYP = VTYP(KK) 86 CONTINUE C SPECIAL SECTION TO ZERO OUT UNAVAILABLE VELOCITIES C IF (VSS.LT.0) IVVVV = 0 C IF(VSS.LT.0) IVERR = 0 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') AM=AM+1.38 ! Tully-Fisher IF(MSS.EQ.'4') AM=AM+0.34 ! Rubin-Ford Thonnard-Roberts-Graham IF(MSS.EQ.'5') AM=AM+0.5 ! not yet fixed, Markarian too faint IF(MSS.EQ.'6') AM=AM+0.4 ! BT IF(MSS.EQ.'7') AM=AM+0.5 ! VV IF(MSS.EQ.'R'.AND.ITYP.LE.1) AM=AM+1.8 ! go to 1 ! RED MAGNITUDES FOR ELLIPTICALS B-R = 1.8 IF(MSS.EQ.'R'.AND.ITYP.GT.1) AM=AM+1.4 ! go to 1 ! RED MAGNITUDES FOR SPIRALS B-R = 1.4 IF(MSS.EQ.'V'.AND.ITYP.LE.1) AM=AM+1.0 ! go to 1 ! VISUAL MAGNITUDES FOR ELLIPTICALS B-V = 1.0 IF(MSS.EQ.'V'.AND.ITYP.GT.1) AM=AM+0.7 ! go to 1 ! VISUAL MAGNITUDES FOR SPIRALS B-V = 0.7 91 CONTINUE IF(ISOURCECUT.EQ.0) GO TO 791 ! DON'T CUT ON SOURCES DO 792 III = 1,NSOURCERANGE IF(VSS.GE.ISCUT(1,III).AND.VSS.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.AM.EQ.0.0) GO TO 1 IF(ISEARCHTYPE.EQ.1) GO TO 322 IF(AM.GT.ALIM.OR.AM.LT.AMIN) GO TO 1 GO TO 22 322 IF(AM.LT.ALIM.AND.AM.GT.AMIN) GO TO 1 22 CONTINUE C VELOCITY CUT IF(IVVVV.GT.IVMAX) GO TO 1 IF(IVVVV.LT.IVMIN) GO TO 1 IF(IEXCLUDE.EQ.1.AND.IVVVV.EQ.0) GO TO 1 C MORPHOLOGICAL TYPE CUT IF(ITTEST.EQ.0) GO TO 610 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 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) 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(IVVVV.NE.0) NVEL=NVEL+1 IF(IVVVV.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,COMMENTS ID1=ABS(D1) ID2=ABS(D2) NGAL=NGAL+1 WRITE(2,101) FLAG,NAME,IRA,IR,ARA,SIGN,ID1,ID2,ID3,AM, - IVVVV,IVERR,MSS,VSS,VPSS,TTYP,ATYP,DD1,DD2,BT,IUGC, - AUG,DIST,FLAG,COMMENTS 101 FORMAT(A1,A10,2I2,F4.1,A1,3I2,F5.2,I5,I3,A1,I2,A2, -A2,A3,2F4.1,F6.2,I5,A1,F4.1,A1,A20) C WRITE(2,110) 110 FORMAT(10X) 10 CONTINUE 445 FORMAT(//' ERROR IN READ AT '/) 99 WRITE(3,444) NGAL,NVEL TYPE 444,NGAL,NVEL TYPE 446,J,NAME,IRA,IR,ARA 446 FORMAT(//' LAST GALAXY SEARCHED', I7,A11,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) STOP 9999 END