	character*3 nam(88),mon(12)
	character*7 greek(24),c7
	character*12 ac,dc,c3*3,cc*25,fdate*24
	character*1 c1
	integer*2 i1,i2,i3
	integer*2 num(89)
	data nam/'And', 'Ant', 'Aps', 'Aql', 'Aqr', 'Ara', 'Ari',
     * 'Aur', 'Boo', 'CMa', 'CMi', 'CVn', 'Cae', 'Cam', 'Cap', 'Car',
     * 'Cas', 'Cen', 'Cep', 'Cet', 'Cha', 'Cir', 'Cnc', 'Col', 'Com',
     * 'CrA', 'CrB', 'Crt', 'Cru', 'Crv', 'Cyg', 'Del', 'Dor', 'Dra',
     * 'Equ', 'Eri', 'For', 'Gem', 'Gru', 'Her', 'Hor', 'Hya', 'Hyi',
     * 'Ind', 'LMi', 'Lac', 'Leo', 'Lep', 'Lib', 'Lup', 'Lyn', 'Lyr',
     * 'Men', 'Mic', 'Mon', 'Mus', 'Nor', 'Oct', 'Oph', 'Ori', 'Pav',
     * 'Peg', 'Per', 'Phe', 'Pic', 'PsA', 'Psc', 'Pup', 'Pyx', 'Ret',
     * 'Scl', 'Sco', 'Sct', 'Ser', 'Sex', 'Sge', 'Sgr', 'Tau', 'Tel',
     * 'TrA', 'Tri', 'Tuc', 'UMa', 'UMi', 'Vel', 'Vir', 'Vol', 'Vul'/
  	data num/1, 65, 74, 86, 148, 239, 254, 315, 379, 437, 468,
     * 481, 502, 508, 541, 588, 598, 649, 680, 715, 793, 808, 816,
     * 886, 903, 943, 957, 979, 991, 1006, 1015, 1096, 1115, 1129,
     * 1201, 1210, 1283, 1310, 1377, 1403, 1498, 1508, 1572, 1590,
     * 1606, 1636, 1652, 1735, 1754, 1796, 1829, 1865, 1887, 1902,
     * 1913, 1940, 1953, 1965, 1992, 2049, 2122, 2146, 2232, 2291,
     * 2315, 2329, 2350, 2444, 2471, 2481, 2492, 2509, 2550, 2557,
     * 2610, 2631, 2647, 2712, 2834, 2847, 2857, 2871, 2888, 2970,
     * 2986, 2994, 3082, 3094, 3127/
        data mon/'Jan','Feb','Mar','Apr','May','Jun','Jul',
     *           'Aug','Sep','Oct','Nov','Dec'/
	data greek/'alpha  ','beta   ','gamma  ','delta  ','epsilon',
     *   'zeta   ','eta    ','theta  ','iota   ','kappa  ','lambda ',
     *   'mu     ','nu     ','xi     ','omicron','pi     ','rho    ',
     *   'sigma  ','tau    ','upsilon','phi    ','chi    ','psi    ',
     *   'omega  '/
	write(*,3)
3	format(/19x,' Bright star cataloge'//
     *  39x,'written by JiangZhoji 94,7'//
     *  9x,' Note: not include star annual proper motion,',
     *  'but GSC program does'//)
	open(1,file='/EOD/CROSS/bsc.bin',
     *      status='old',access='direct',recl=12)
	k1=1
	do 10 i=1,8
	write(*,'(11(4x,a))')(nam(k),k=k1,k1+10)
10	k1=k1+11
	cc=fdate()
	read(cc(1:),'(4x,a,i3,9x,i5)')c3,i,j
        do 1009 k=1,12
1009    if(c3.eq.mon(k))k1=k-1
        j=(j+(k1*30.4+i)/365.)*10.+0.5
        epoch=j*0.1

20	write(*,2)epoch
2	format(/'Enter out_put epoch [',f6.1,']  ',$)
	read(*,'(a)')cc
	if(cc(1:2).ne.'  ')read(cc(1:),*,err=20)epoch
	if(epoch.lt.1900..or.epoch.gt.2100.)goto 20

100	write(*,*)
	write(*,*)' 1. constellation'
	write(*,*)' 2. magnitude'
	write(*,*)' 3. position'
	write(*,*)' -1 exit'
	write(*,*)

110	read(*,*,err=100)k
	if(k.eq.-1)stop
	if(k.eq.1)then
	  write(*,*)' constellation name'
	  read(*,'(a)')c3
	  if(c3(1:1).eq.' ')goto 100
	  do 120 i=1,88
120	  if(c3.eq.nam(i))goto 130
	  write(*,*)' illeagle name'
	  goto 110
130	  k1=0
	  do 140 j=num(i),num(i+1)-1
	  if(k1.eq.21)then
	    write(*,'(a,$)')'<cr> please!  '
	    read(*,'(a)')k1
	    k1=0
	  endif
	  read(1,rec=j)i1,i2,x1,y1
	  call swap2(i1,2)
	  call swap2(i2,2)
	  call swap4(x1,4)
	  call swap4(y1,4)
	  call astprs(x1,y1,2000.,x,y,epoch)
	  call toms(x,ac,1)
	  call toms(y,dc,0)
	  c1=' '
	  if(i1.gt.1000)then
	    c1=char(i1/1000+48)
	    i1=mod(i1,1000)
	  endif
	  if(i1.gt.24)then
	    write(c7(1:),*)i1-24
	  else
	    c7=greek(i1)
	  endif
	  k1=k1+1
140 	  write(*,1)c3,c7,c1,ac,dc,epoch,i2*0.01
1	  format(1x,a,2x,2a,1x,a,1x,a,'(',f6.1,')',f6.2)
	endif
	if(k.eq.2)then
150	  write(*,'(a,$)')'Magnitude  limited:  '
	  read(*,*)x
	  if(x.gt.8.)write(*,*)' sorry, too many star'
	  if(x.gt.8.)goto 150
	  i3=x*100.
	  k1=0
	  do 160 i=1,88
	  c3=nam(i)
	  do 160 j=num(i),num(i+1)-1
	  if(k1.eq.21)then
	    write(*,'(a,$)')'<cr> please!  '
	    read(*,'(a)')k1
	    k1=0
	  endif
	  read(1,rec=j)i1,i2,x1,y1
	  call swap2(i1,2)
	  call swap2(i2,2)
	  call swap4(x1,4)
	  call swap4(y1,4)
	  if(i2.gt.i3)goto 160
	  call astprs(x1,y1,2000.,x,y,epoch)
	  call toms(x,ac,1)
	  call toms(y,dc,0)
	  c1=' '
	  if(i1.gt.1000)then
	    c1=char(i1/1000+48)
	    i1=mod(i1,1000)
	  endif
	  if(i1.gt.24)then
	    write(c7(1:),*)i1-24
	  else
	    c7=greek(i1)
	  endif
	  k1=k1+1
 	  write(*,1)c3,c7,c1,ac,dc,epoch,i2*0.01
160	  continue
	endif
	if(k.eq.3)then
161	  write(*,'(a,$)')' R.A.  ex: 12.5,15.5    '
	  read(*,*,err=161)r1,r2
	  if(r1.lt.0..or.r2.lt.0.)goto 161
	  if(r1.gt.24..or.r2.gt.24.)goto 161
162	  write(*,'(a,$)')' Decl. ex: -5.5,10.0    '
	  read(*,*,err=162)d1,d2
	  if(d1.lt.-90.or.d2.lt.-90)goto 162
	  if(d1.gt.90.or.d2.gt.90)goto 162
	  if(d1.gt.d2)then
	    x=d1
	    d1=d2
	    d2=x
	  endif
	  if(r1.gt.r2)then
	    x=r1
	    r1=r2
	    r2=x
	  endif
	  ir=0
	  if(r2-r1.gt.13)ir=1
	  k1=0
	  do 170 i=1,88
	  c3=nam(i)
	  do 170 j=num(i),num(i+1)-1
	  if(k1.eq.21)then
	    write(*,'(a,$)')'<cr> please!  '
	    read(*,'(a)')k1
	    k1=0
	  endif
	  read(1,rec=j)i1,i2,x1,y1
	  call swap2(i1,2)
	  call swap2(i2,2)
	  call swap4(x1,4)
	  call swap4(y1,4)
	  if(y1.lt.d1.or.y1.gt.d2)goto 170
	  if(ir.eq.0)then
	    if(x1.lt.r1.or.x1.gt.r2)goto 170
	  else
	    if(x1.gt.r1.and.x1.lt.r2)goto 170
	  endif
	  call astprs(x1,y1,2000.,x,y,epoch)
	  call toms(x,ac,1)
	  call toms(y,dc,0)
	  c1=' '
	  if(i1.gt.1000)then
	    c1=char(i1/1000+48)
	    i1=mod(i1,1000)
	  endif
	  if(i1.gt.24)then
	    write(c7(1:),*)i1-24
	  else
	    c7=greek(i1)
	  endif
	  k1=k1+1
 	  write(*,1)c3,c7,c1,ac,dc,epoch,i2*0.01
170	  continue
	endif
	    
	goto 100
	end 
