.000755 000151 000145 00000000000 06221555241 011047 5ustar00xpmmpmm000007 1205160 ./hms.f000644 000151 000145 00000002601 06140210413 012051 0ustar00xpmmpmm000007 1205161 SUBROUTINE hms(str,val) c c...Crack String And Create Value c IMPLICIT * NONE CHARACTER*(*) * str DOUBLE PRECISION * val, piece(3), dp, sgn, z INTEGER * nstr, i, j, dpfind CHARACTER*1 * c c c...Initialization c 100 val = 0.0D00 DO i=1,3 piece(i) = 0.0D00 ENDDO j = 1 dpfind = 0 sgn = 1.0D00 nstr = LEN(str) IF (nstr.le.0) RETURN c c...Loop Over The String c DO i=1,nstr c = str(i:i) c c...Parse c IF ((c.eq.'-').or.(c.eq.'e').or.(c.eq.'E') * .or.(c.eq.'s').or.(c.eq.'S')) THEN sgn = -1.0D00 ELSEIF ((c.eq.'+').or.(c.eq.'w').or.(c.eq.'W') * .or.(c.eq.'n').or.(c.eq.'N')) THEN sgn = 1.0D00 ELSEIF ((c.eq.':').or.(c.eq.',').or.(c.eq.' ')) THEN j = j+1 dpfind = 0 IF (j.gt.3) GO TO 110 ELSEIF (c.eq.'.') THEN dpfind = 1 dp = 1.0D00 ELSEIF ((c.ge.'0').and.(c.le.'9')) THEN z = ICHAR(c)-ICHAR('0') IF (dpfind.eq.0) THEN piece(j) = 10.0D00*piece(j) + z ELSE dp = 0.1D00*dp piece(j) = piece(j) + dp*z ENDIF ENDIF ENDDO c c...Return c 110 val = piece(1) + piece(2)/60.0D00 + piece(3)/3600.0D00 RETURN END ./gimme.f000644 000151 000145 00000002361 06140210246 012374 0ustar00xpmmpmm000007 1205706 SUBROUTINE gimme(v1,v2,v3) c c...Get RA,DEC,Size From Command Line Or User c IMPLICIT * NONE DOUBLE PRECISION * v1, v2, v3 INTEGER * nlb, n, IARGC, i, j CHARACTER*64 * lb c 9001 FORMAT (' Enter Alpha: '$) 9002 FORMAT (' Enter Delta: '$) 9003 FORMAT (' Enter Size: '$) 9004 FORMAT (q, a) c 100 n = IARGC() IF (n.ne.3) THEN 110 WRITE (*,9001) READ (*,9004,err=110,end=200) nlb,lb IF (nlb.le.0) GO TO 110 CALL hms(lb(1:nlb),v1) 120 WRITE (*,9002) READ (*,9004,err=120,end=200) nlb,lb IF (nlb.le.0) GO TO 120 CALL hms(lb(1:nlb),v2) 130 WRITE (*,9003) READ (*,9004,err=130,end=200) nlb,lb IF (nlb.le.0) GO TO 130 CALL hms(lb(1:nlb),v3) ELSE DO i=1,3 CALL getarg(i,lb) nlb = 0 DO nlb=LEN(lb),2,-1 IF (lb(nlb:nlb).gt.' ') GO TO 140 ENDDO 140 IF (i.eq.1) THEN CALL hms(lb(1:nlb),v1) ELSEIF (i.eq.2) THEN CALL hms(lb(1:nlb),v2) ELSE CALL hms(lb(1:nlb),v3) ENDIF ENDDO ENDIF RETURN c c...Error c 200 CALL EXIT END ./makefile000644 000151 000145 00000000236 06221552050 012630 0ustar00xpmmpmm000007 1206417 FFLAGS = -O CFLAGS = -O INC = square.inc OBJ = square.o hms.o gimme.o corner.o eatit.o cio.o saveit.o square: $(OBJ) f77 -o square $(OBJ) $(OBJ): $(INC) ./square.f000644 000151 000145 00000001022 06221553435 012610 0ustar00xpmmpmm000007 1205677 PROGRAM square c c...Extract A Square From USNO-A c INCLUDE * 'square.inc' DOUBLE PRECISION * r, d, s INTEGER * i, j c 9001 FORMAT (' Found', i10, ' Entries') c 100 oldzone = -1 scale = 67.14D00 CALL gimme(r,d,s) CALL corner(r,d,s) nsav = 0 DO j=1,ndec DO i=1,nra CALL eatit(rfrst(i),rlast(i),dzone(j),dfrst(j),dlast(j)) ENDDO ENDDO CLOSE (2) WRITE (*,9001) nsav CALL EXIT END ./square.inc000644 000151 000145 00000001057 06221552141 013126 0ustar00xpmmpmm000007 1206516 c IMPLICIT * NONE PARAMETER * nzmax = 10, * nacc = 96, * nchunk = 1*1000*1000, * convert = 3600.0D00*100.0D00 INTEGER * nra, ndec, dzone(NZMAX), frec(NACC), nrec(NACC), * oldzone, buf(3,NCHUNK), nsav DOUBLE PRECISION * rfrst(NZMAX), rlast(NZMAX), dfrst(NZMAX), dlast(NZMAX), * rcent, dcent, scale COMMON * rfrst, rlast, dfrst, dlast, rcent, dcent, scale, * nra, ndec, dzone, frec, nrec, oldzone, buf, nsav c ./README000644 000151 000145 00000003366 06221556060 012025 0ustar00xpmmpmm000007 1206616 Template program for extracting USNO-A entries in something like a square around a specific RA/Dec and size. 1) hms.f is relatively tolerant about accepting decimal, sexagesimal, etc. coordinates, but does not understand everything. 2) eatit.f knows where the catalog is. It assumes that it is all out on a single disk. You may need to hack it to understand about small disks or CD-ROMs. 3) cio.c does the explicit conversion to BIG_ENDIAN on the read (and write) since it was written on a DEC Alpha. You may need to comment that portion of the code out if your native mode is BIG_ENDIAN. 4) saveit.f doesn't do much more than scribble the USNO-A native integers. You may wish to hack this routine to save things in a more useful format. Please remember that the native USNO-A integers are in the following format. (decimal RA)*15*3600*100 ((decimal DEC)+90)*3600*100 (==SPD==south polar distance) SQFFFBBBRRR S = sign is - if corresponding entry in GSC + if no entry Q = quality is 1 if mags are probably wrong, 0 if probably OK FFF = field of original detection. POSS-I MLP numbers start at 1 at the north pole and end at 937 in the -30 zone. Southern fields start at 1 at the south pole and end at 408 in the -35 zone. The following test should work: IF ((zone.le.600).and.(field.le.408)) THEN south(field) ELSE north(field) ENDIF BBB = 10 times the blue (O or J) mag RRR = 10 times the red (E or F) mag USNO-A is divided into 24 zones of SPD each of width 7.5 degrees. The file names integers of SPD*10. ./corner.f000644 000151 000145 00000003145 06221550174 012605 0ustar00xpmmpmm000007 1205776 SUBROUTINE corner(r,d,s) c c...Take Nominal And Compute Corners And Other Search Parameters c INCLUDE * 'square.inc' DOUBLE PRECISION * r, d, s, rd, r1, r2, d1, d2, cd, zmin, zmax INTEGER * i, j, z1, z2 c 9001 FORMAT (' Illegal Input: R=', f10.6, ' D=', f10.6) 9002 FORMAT (' Illegal Size=', f10.6) c c...Sanity Checks c 100 IF ((r.lt.0.0D00).or.(r.ge.24.0D00)) THEN WRITE (*,9001) r,d CALL EXIT ENDIF IF ((d.le.-90.0D00).or.(d.ge.90.0D00)) THEN WRITE (*,9001) r,d CALL EXIT ENDIF IF (s.le.0.0D00) THEN WRITE (*,9002) s CALL EXIT ENDIF c c...Compute The Corners And Number Of RA Chunks c rd = r*15.0D00 rcent = rd dcent = d cd = COSD(d) r1 = rd - s/cd r2 = rd + s/cd IF (r1.lt.0.0D00) THEN nra = 2 rfrst(1) = 0.0D00 rlast(1) = r2 rfrst(2) = 360.0D00+r1 rlast(2) = 360.0D00 ELSEIF (r2.ge.360.0D00) THEN nra = 2 rfrst(1) = 0.0D00 rlast(1) = r2-360.0D00 rfrst(2) = r1 rlast(2) = 360.0D00 ELSE nra = 1 rfrst(1) = r1 rlast(1) = r2 ENDIF c c...Compute Dec Corners And Zones c d1 = d - s d2 = d + s z1 = (d1+90.0D00)/7.5D00 z2 = (d2+90.0D00)/7.5D00 ndec = z2+1-z1 j = 0 DO i=z1,z2 zmin = i*7.5D00 - 90.0D00 zmax = zmin+7.5D00 j = j+1 dzone(j) = i*75 dfrst(j) = MAX(d1,zmin) dlast(j) = MIN(d2,zmax) ENDDO RETURN END ./cio.c000644 000151 000145 00000003616 06140230271 012046 0ustar00xpmmpmm000007 1205154 #include #include #include /* ************************************************************************** * * C_OPENER -- Open A NEW File */ c_opener_(bb) char bb[]; { return(creat(bb,0644)); } /* *************************************************************************** * * C_CLOSER -- Close A File */ c_closer_(fd) int *fd; { return(close(*fd)); } /* *************************************************************************** * * C_WRITER -- Write Into File Implementing BIG_ENDIAN */ c_writer_(fd,buf,n) int *fd, *n; char buf[]; { int i, nn; char b; nn = (*n); for (i=0; i #include #include /* ************************************************************************** * * C_OPENER -- Open A NEW File */ c_opener_(bb) char bb[]; { return(creat(bb,0644)); } /* *************************************************************************** * * C_CLOSER -- Close A File */ c_closer_(fd) int *fd; { return(close(*fd)); } /* *************************************************************************** * * C_WRITER -- Write Into File Implementing BIG_ENDIAN */ c_writer_(fd,buf,n) int *fd, *n; char buf[]; { int i, nn; char b; nn = (*n); for (i=0; i