PROGRAM CIRCE C-------------------------------------------------------- C C DOES ITS THING TO FIND GALAXIES IN SELECTED CIRCLES C C MODIFIED 9/11/83 TO ALSO WORK IN ANNULI JPH C MODIFIED 8/8/84 TO SPEED UP SEARCH C MODIFIED 8/8/84 TO TAKE CARE OF ROUNDOFF JUNK JPH C MODIFIED 9/87 TO WORK ON CFAZWICKY C Moddified 10/01 to go to zcat2000 format C Modified 01/02 to go to zcat2000 format C searches J2000 coordinates N.Martimbeau C Modified Apr 2002 for new format for velocities C because of merge with ZBIG. N.Martimbeau C C-------------------------------------------------------- CHARACTER*17 NAME CHARACTER*15 CLUSTER CHARACTER*118 DATA CHARACTER*1 SIGN,MINUS,CCCVEL CHARACTER*7 CVEL, CCVEL INTEGER VEL REAL velreal C NOTE THAT THE DIMENSION MUST BE BIGGER THAN THE SIZE OF ZCAT COMMON/CHAR/NAME(500000),DATA(500000),CVEL(500000) COMMON/NUM/RA(500000),DEC(500000),BMAG(500000),VEL(500000) COMMON/LOOK/LOOK(400) DATA MINUS/'-'/ Q=180./3.14159 NNN=0 DO 96, J=1,360 96 LOOK(J) = 1 LOOK(361) = 0 LOOK(362) = 0 IRATEST = 1 c open(1,FILE='/dsk/extra/catalogs/zcat.dat',STATUS='OLD') c open(1,FILE='msample.out',STATUS='OLD') c open(1,FILE='zcat.dat',STATUS='OLD') open(1,FILE='zcat.2000.dat',STATUS='OLD') c open(1,FILE='uzcJ2000cen6.cen20.notin',STATUS='OLD') c open(2,FILE='circle.cen',STATUS='OLD') c open(2,FILE='south.cen',STATUS='OLD') c open(2,FILE='warpfireii.cen',STATUS='OLD') c open(2,FILE='a3558.cen',STATUS='OLD') c open(2,FILE='barmby.cen',STATUS='OLD') c open(2,FILE='/home/huchra/rosat/voges/circle.in',STATUS='OLD') c - status='unknown') c open(2,FILE='/home/huchra/2mass/a262.cen',STATUS='OLD') c open(2,FILE='/d4/fang4/chen/cluster.cen',STATUS='OLD') c open(2,FILE='virgo.cen',STATUS='OLD') open(2,FILE='circle.cen',STATUS='OLD') c open(3,file='/home/huchra/rosat/voges/circle.out', c open(3,file='/home/huchra/2mass/a262.zcat', c - status='unknown') c open(3,file='barmby.out',status='unknown') open(3,file='circle.out',status='unknown') C open(20,file='test.err',status='unknown') type 877 877 format(/' do you want to exclude zero velocities? Y=1: '$) 878 format(i1) accept 878, ivtest type 888 888 format(/' do you want to cut in velocity? Y=1: '$) accept 878, ivcut ivmin=-1000 ivmax=99999 if(ivcut.ne.1) go to 898 type 889 889 format(/' enter ivmin and ivmax: '$) accept *, ivmin,ivmax 898 continue DO 19 J=1,500000 5 READ (1,100,END=20,ERR=18) NAME(J),IR,IR1,RRA,SIGN,ID,ID1,ID2, -BMAG(J),CVEL(J),DATA(J) 100 FORMAT(A17,I2,I2,F4.1,A1,3I2,F5.2,A7,A118) C test read C write(20,100)NAME(J),IR,IR1,RRA,SIGN,ID,ID1,ID2, C -BMAG(J),CVEL(J),DATA(J) C IF(BMAG(J).EQ.0.0.OR.BMAG(J).GT.14.5) GO TO 5 C test CVEL for find out if velocity C in z or v format (F7.4 or I7) CCVEL = CVEL(J) ivelchar = 0 do 45 ij=1,7 read(CCVEL(ij:ij),40) CCCVEL 40 format(a1) if(CCCVEL.eq.'.') ivelchar = ivelcar + 1 45 continue if(ivelchar.eq.0) goto 50 read(CCVEL(1:7),47) velreal 47 format(f7.4) VEL(J)= INT(velreal * 299762.458) C write(20,48) CVEL(J), VEL(J) C 48 format(' CVEL= ',a7,' VEL = ',i7) goto 52 50 read(CCVEL(1:7),51) VEL(J) 51 format(i7) C write(20,48) CVEL(J), VEL(J) C resume program 52 IF(ivtest.eq.1.and.VEL(J).EQ.0.0) GO TO 5 if(vel(j).lt.ivmin.or.vel(j).gt.ivmax) go to 5 RA(J)=15.*(IR+FLOAT(IR1)/60.+ RRA/3600.) C SET LOOKUP TABLE FOR "HOURS" IN ZCAT IF(RA(J).LT.FLOAT(IRATEST)) GO TO 7 IRATEST = IRATEST+1 LOOK(IRATEST) = J 7 ISS = 1 IF(SIGN.EQ.MINUS.OR.ID.LT.0.OR.ID1.LT.0.OR.ID2.LT.0) * ISS=-1 ID = IABS(ID) ID1 = IABS(ID1) ID2 = IABS(ID2) DEC(J)=(ID+FLOAT(ID1)/60.+FLOAT(ID2)/3600.)*ISS C TYPE 220,J,NAME(J),RA(J),DEC(J) C 220 FORMAT(I7,3X,A17,2F15.5) NNN=NNN+1 GO TO 19 18 TYPE 130,NAME(J) 130 FORMAT(//' ERROR IN READ AT ',A17) 19 CONTINUE 20 TYPE 131,NNN 131 FORMAT(////' THERE ARE ',I6,' GALAXIES IN THE CATALOG'//) TYPE 132 132 FORMAT(5X,'LOOKUP TABLE FOR RA'/5X,' RA # ',/) DO 88 I = 1,25 JJJ=I-1 KKK=JJJ*15+1 88 TYPE 133,JJJ,LOOK(KKK),KKK 133 FORMAT(8X,I2.2,2X,I6,10X,I6) C NOW START CIRCLE LOOP OVER VARIOUS CENTERS DO 30 J = 1,100000 READ (2,200,END=35,ERR=35)CLUSTER,RAV,DEV,CIR,CIRM IF(CIR.EQ.0.0) GO TO 35 200 FORMAT(A15,4F10.4) IIR = RAV/15.0 ARAI = RAV/15.0 -FLOAT(IIR) ARAI=ARAI*60.0 ! TURN INTO MINUTES IID1 = DEV IF(DEV.GE.0.0) IID2 = 60.*(DEV-IID1) IF(DEV.LT.0.0) IID2 = -60.*(DEV-IID1) write(3,80) CLUSTER,CIR,RAV,DEV,CIRM,IIR,ARAI,IID1,IID2 80 FORMAT(////,1x,A15,3X,'GALAXIES WITHIN',F8.3,' DEGREES ' -2F10.4,' ANNULUS ='F8.3,' COORDS 'I2.2,F5.1,2X,I3,I3/) c TYPE 81, CLUSTER,CIR,RAV,DEV,CIRM c 81 FORMAT(///,1X,A15,3X,'GALAXIES WITHIN',F8.3,' DEGREES ' c -2F10.4,' ANNULUS ='F8.3) CALL CIRCLE(RAV,DEV,CIR,CIRM,NNN) 30 CONTINUE 35 CONTINUE CLOSE(1) CLOSE(2) CLOSE(3) C CLOSE(20) STOP END SUBROUTINE CIRCLE(RAV,DEV,CIR,CIRM,NNN) C C THIS PROGRAM GOES INTO ZCAT AND EXTRACTS ALL THE GALAXIES C IN THE VICINITY OF RAV AND DEV (IN DECIMAL DEGREES) - WITHIN C A CIRCLE OF SIZE CIR (ALSO IN DECIMAL DEGREES). C AN ANNULUS CAN ALSO BE SELECTED IF CIRM (IN DECIMAL DEGREES) C IS NONZERO C C DATA IS TRANSFERED BY MEANS OF A COMMON BLOCK C C THERE IS TYPED OUTPUT FOR EACH CENTER C CHARACTER*1 SIGN CHARACTER*17 NAME CHARACTER*118 DATA CHARACTER*7 CVEL COMMON/CHAR/NAME(500000),DATA(500000),CVEL(500000) COMMON/NUM/RA(500000),DEC(500000),BMAG(500000),VEL(500000) COMMON/LOOK/LOOK(400) CA(B,C,A)=SIN(B)*SIN(C)+COS(B)*COS(C)*COS(A) Q=180./3.14159 NIN = 0 NMINUS = 1 LOOKER = 1 RLO=0 RALIMM = RAV-CIR/COS(DEV/Q) RALIMP = RAV+CIR/COS(DEV/Q) c TYPE 2000,RALIMM,RALIMP c2000 FORMAT(' RALIMM AND RALIMP ',5X,2F10.4,//) IF(RALIMM.LT.0) GO TO 116 IF(RALIMP .GT. 360) GO TO 117 LOOKER=RALIMM + 1.00 NMINUS=LOOK(LOOKER) GO TO 118 116 RLO = 360. + RALIMM RALIMM = 0 GO TO 118 117 RLO = RALIMM RALIMM=0 RALIMP = RALIMP - 360. 118 CONTINUE RAV=RAV/Q DEV=DEV/Q CIRC=CIR/Q CIRCM=CIRM/Q IF(NMINUS.LT.1) NMINUS=1 IF(NMINUS.GT.NNN) NMINUS=1 DO 5 J=NMINUS,NNN IF(RA(J).LT.RALIMM) GO TO 5 IF( RA(J).GT. RALIMP.AND. RLO.EQ.0) GO TO 15 IF( RA(J).LT. RLO.AND. RA(J) .GT. RALIMP) GO TO 5 RAD = RA(J)/Q DE = DEC(J)/Q DIFF=RAD-RAV THET=CA(DEV,DE,DIFF) THETA=0.0 IF(THET.LT.1.0.AND.THET.GT.-1.0) THETA=ACOS(THET) THETA=ABS(THETA) IF(THETA.GT.CIRC) GO TO 5 IF(THETA.LT.CIRCM) GO TO 5 NIN=NIN+1 THETA=THETA*Q C DECODE RA AND DEC INTO OLD FORMAT SIGN = '+' IF(DEC(J).LT.0.0) SIGN = '-' DD=ABS(DEC(J)) + .000000001 ID=DD ID1=(DD-ID)*60. + 0.001 ID2=(DD-ID-FLOAT(ID1)/60.)*3600. + 0.01 RR=RA(J)/15. IR=RR IR1=(RR-IR)*60. + 0.001 RRA=(RR-IR-FLOAT(IR1)/60.)*3600. + 0.001 write(3,100)NAME(J),IR,IR1,RRA,SIGN,ID,ID1,ID2, -BMAG(J),CVEL(J),DATA(J),THETA 100 FORMAT(A17,I2.2,I2.2,F4.1,A1,3I2.2,F5.2,A7,A118,4X,F9.4) 5 CONTINUE 15 write(3,105)NIN 105 FORMAT(5X,'THE NUMBER OF GALAXIES FOUND',I10,/) NSEARCH = J-NMINUS + 1 c TYPE 114,NSEARCH c 114 FORMAT(9X,'THE NUMBER OF GALAXIES SEARCHED WAS ',I7) c TYPE 112,NMINUS,NAME(NMINUS),RA(NMINUS),DEC(NMINUS) c 112 FORMAT(' THE FIRST GALAXY SEARCHED WAS ', c *5X,I5,3X,A17,3X,2F15.4) c TYPE 111,J,NAME(J),RA(J),DEC(J) c 111 FORMAT(' THE LAST GALAXY SEARCHED WAS ', c *5X,I5,3X,A17,3X,2F15.4,/) RETURN END