PROGRAM u3read 
C
C  gfortran -o u3read u3read.f
C  g77  -o u3read u3read.f
C
C  - read UCAC3 binary data file
C  - select RA, Dec, magnitude range
C  - formatted (ASCII) output table 
C
C  090720 DCH   create 
C  090724 CF,NZ minor updates

      IMPLICIT NONE
      CHARACTER*40 filein,fileout,ans
      INTEGER      minn,maxn, ni, no
      INTEGER      k,reclen, ra1,ra2,spd1,spd2,m1,m2
      REAL*8       minr,maxr,mind,maxd,minm,maxm,degmas

* items to read from input files
      INTEGER*4 i, ran, spdn, pmrac, pmdc, id, rn
      INTEGER*2 im1, im2, sigmag, sigra, sigdc, cepra, cepdc, sigpmr, 
     .          sigpmd, jmag, hmag, kmag, smB, smR2, smI
      INTEGER*1 objt, dsf, na1, nu1, us1, cn1, clbl, qfB, qfR2, qfI
      INTEGER*1 icqflg(3), e2mpho(3), catflg(10), g1, c1, leda, x2m

* defaults
      degmas = 60.0d0 * 60.0d0 * 1000.0d0
      filein = '/mnt/dvd/z123'            
      fileout= 'u3read.sample'
      reclen = 84     ! byte

      minr =   0.0d0
      maxr =  24.0d0
      mind = -90.0d0
      maxd =  90.0d0
      minm =   0.0d0
      maxm =  20.0d0
      minn =  1
      maxn =  102000000

* interactive      
      WRITE(*, '(/a)'  ) 'get file names'
      WRITE(*, '(a)'   ) '--------------'
      WRITE(*, '(a, a)') 'current input  path= ', filein
      WRITE(*, '(a, $)') 'new path?      path= '
      READ (*, '(a)'   ) ans
      IF   (ans.NE.' ' ) filein = ans
      
      WRITE(*, '(a, a)') 'current output path= ', fileout
      WRITE(*, '(a, $)') 'new path?      path= '
      READ (*, '(a)'   ) ans
      IF   (ans.NE.' ' ) fileout = ans
      
      WRITE(*, '(/a)') 'set limiting ranges'
      WRITE(*, '( a)') '-------------------'
      
      WRITE (*, '(a,2f7.3)') 'right ascension: ',minr,maxr
      WRITE (*, '(a,$)'    ) 'new limits?  RA= '
      READ  (*, '(a)'      ) ans
      IF    (ans.NE.' '    ) READ(ans,*) minr,maxr
      
      WRITE (*, '(a,2f8.3)') 'declination: ',mind,maxd
      WRITE (*, '(a,$)'    ) 'new limits?  dec= '
      READ  (*, '(a)'      ) ans
      IF    (ans.NE.' '    ) READ(ans, *) mind,maxd
      
      WRITE (*, '(a, 2f7.3)') 'magnitude: ', minm,maxm
      WRITE (*, '(a,$)'     ) 'new limits?  mag= '
      READ  (*, '(a)'       ) ans
      IF    (ans.NE.' '     ) READ(ans, *) minm,maxm
      
      WRITE (*, '(a, 2i11)') 'star number: ', minn, maxn
      WRITE (*, '(a,$)'    ) 'new limits?  num= '
      READ  (*, '(a)'      ) ans
      IF    (ans.NE.' '    ) THEN
        READ(ans,*) minn,maxn
        IF (minn.LE.0) THEN
          WRITE (*,'(a,i9)') 'invalid minn = ',minn
          STOP
        ENDIF
      ENDIF
      
* prepare
      OPEN (11,ACCESS='direct',FILE=filein,RECL=reclen)
      OPEN (12,FILE=fileout)
      ni = 0  ! count number of stars read in
      no = 0  ! count number of stars output

      ra1  = IDNINT (minr * 15.0d0 * degmas)  ! hour to mas
      ra2  = IDNINT (maxr * 15.0d0 * degmas)
      spd1 = IDNINT ((mind+90.0d0) * degmas)  ! deg to mas
      spd2 = IDNINT ((maxd+90.0d0) * degmas) 
      m1   = IDNINT (minm * 1.0d3)            ! mag to mmag
      m2   = IDNINT (maxm * 1.0d3)

* loop all stars
      DO k=minn, maxn
        READ (11,REC=k,ERR=99) 
     .       ran,spdn,im1,im2,sigmag,objt,dsf,sigra,sigdc,na1,nu1,us1
     .       ,cn1,cepra,cepdc,pmrac,pmdc,sigpmr,sigpmd,id,jmag
     .       ,hmag,kmag,icqflg,e2mpho,smB,smR2,smI,clbl,qfB,qfR2,qfI
     .       ,catflg, g1, c1, leda, x2m, rn

        ni = ni + 1
        IF (MOD(k,100000).EQ.1) WRITE(*, *) 'read rec = ',k

        IF (spdn.GE.spd1.AND.spdn.LE.spd2) THEN
          IF (ran.GE.ra1.AND.ran.LE.ra2) THEN 
            IF (im2.GE.m1.AND.im2.LE.m2) THEN
              WRITE (12,'(i10,1x,i9,1x,2(i5,1x),i3,1x,i2,1x,
     .             i1,1x,2(i3,1x),2(i2,1x),2(i3,1x),2(i5,1x),
     .             2(i6,1x),2(i3,1x),i10,1x,3(i5,1x),3i2.2,1x,3(i3,1x),
     .             3(i5,1x),4(i2,1x),10i1,1x, 2i1,1x,2(i3,1x),i9)') 
     .          ran,spdn,im1,im2,sigmag,objt,dsf,sigra,sigdc,na1,nu1
     .         ,us1,cn1,cepra,cepdc,pmrac,pmdc,sigpmr,sigpmd,id,jmag
     .         ,hmag,kmag,icqflg,e2mpho,smB,smR2,smI,clbl,qfB,qfR2
     .         ,qfI,catflg, g1, c1, leda, x2m, rn
              no = no + 1
            ENDIF ! mag range
          ENDIF   ! RA  range
        ENDIF     ! Dec range
      ENDDO    ! loop range of star numbers

 99   CLOSE(11)
      WRITE (*,'(a,i10)') 'number of stars read   = ',ni
      WRITE (*,'(a,i10)') 'number of stars output = ',no

      END  ! main <u3read>