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 TAKE CARE OF ROUNDOFF JUNK JPH C MODIFIED 8/8/84 TO SPEED UP SEARCH C MODIFIED 9/87 TO WORK ON CFAZWICKY C C-------------------------------------------------------- CHARACTER*11 NAME CHARACTER *10 CLUSTER CHARACTER*64 DATA CHARACTER*1 SIGN,MINUS C NOTE THAT THE DIMENSION MUST BE BIGGER THAN THE SIZE OF ZCAT COMMON/CHAR/NAME(50000),DATA(50000) COMMON/NUM/RA(50000),DEC(50000),BMAG(50000),IVEL(50000) 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 OPEN(1,FILE='SYSUTIL:[CATALOGS]ZCAT.DAT',READONLY,STATUS='OLD') DO 19 J=1,50000 5 READ (1,100,END=20,ERR=18) NAME(J),IR,IR1,RRA,SIGN,ID,ID1,ID2, -BMAG(J),IVEL(J),DATA(J) 100 FORMAT(A11,I2,I2,F4.1,A1,3I2,F5.2,I5,A64) C IF(BMAG(J).EQ.0.0.OR.BMAG(J).GT.14.5) GO TO 5 C IF(IVEL.EQ.0) 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,A11,2F15.5) NNN=NNN+1 GO TO 19 18 TYPE 130,NAME(J) 130 FORMAT(//' ERROR IN READ AT ',A10) 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,2X,I6,10X,I6) C NOW START CIRCLE LOOP OVER VARIOUS CENTERS DO 30 J = 1,5000 READ (2,200,END=35,ERR=35)CLUSTER,RAV,DEV,CIR,CIRM IF(CIR.EQ.0.0) GO TO 35 200 FORMAT(5X,A10,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) PRINT 80, CLUSTER,CIR,RAV,DEV,CIRM,IIR,ARAI,IID1,IID2 80 FORMAT(////,4X,A10,3X,'GALAXIES WITHIN',F8.3,' DEGREES ' -2F10.4,' ANNULUS ='F8.3,' COORDS 'I2,F5.1,2X,I3,I3/) TYPE 81, CLUSTER,CIR,RAV,DEV,CIRM 81 FORMAT(///,4X,A10,3X,'GALAXIES WITHIN',F8.3,' DEGREES ' -2F10.4,' ANNULUS ='F8.3) CALL CIRCLE(RAV,DEV,CIR,CIRM,NNN) 30 CONTINUE 35 CONTINUE CLOSE(1) STOP END SUBROUTINE CIRCLE(RAV,DEV,CIR,CIRM,NNN) C C THIS PROGRAM GOES INTO ZCAT AND REMOVES 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 THE OUTPUT FILE IS LINKED TO FOR$PRINT C AND THERE IS TYPED OUTPUT FOR EACH CENTER C CHARACTER*1 SIGN CHARACTER*11 NAME CHARACTER*64 DATA COMMON/CHAR/NAME(50000),DATA(50000) COMMON/NUM/RA(50000),DEC(50000),BMAG(50000),IVEL(50000) 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) TYPE 2000,RALIMM,RALIMP 2000 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 PRINT 100,NAME(J),IR,IR1,RRA,SIGN,ID,ID1,ID2, -BMAG(J),IVEL(J),DATA(J),THETA 100 FORMAT(A11,I2,I2,F4.1,A1,3I2,F5.2,I5,A64,4X,F9.4) 5 CONTINUE 15 PRINT 105,NIN 105 FORMAT(5X,'THE NUMBER OF GALAXIES FOUND',I10,/) NSEARCH = J-NMINUS + 1 TYPE 114,NSEARCH 114 FORMAT(9X,'THE NUMBER OF GALAXIES SEARCHED WAS ',I7) TYPE 112,NMINUS,NAME(NMINUS),RA(NMINUS),DEC(NMINUS) 112 FORMAT(' THE FIRST GALAXY SEARCHED WAS ', *5X,I5,3X,A11,3X,2F15.4) TYPE 111,J,NAME(J),RA(J),DEC(J) 111 FORMAT(' THE LAST GALAXY SEARCHED WAS ', *5X,I5,3X,A11,3X,2F15.4,/) RETURN END