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