           program ukchart
C+ f77 uk.f -o uk.e -L/star/lib `pgplot_link` fieldn.f 
C  Generate a SKY chart with details of plates taken for particular
C  surveys or projects.
C
C  1990 February 
C-
	IMPLICIT NONE
	INTEGER     I, J, K ,L,n,f, status,ii
         character*15   c
        character*2 survey,qs,qs2
        character*23   a
        character*104  b
        character*4 fc
        character*3 nfc
        character*1 grade,answer
        character*42   infile
        character*6 date,datetemp
	INTEGER*2   ATOT, FEELD, SUR(894),NUM,aaa(894),bbb(894),
     > ccc(894),add(894),imon,iday,iyr
        integer tempf,ios
	REAL        factor,X1,Y1,X2,Y2,Y,XPT(4),YPT(4),ll,bb,ra4,dec4
	REAL*8      RAMIN,RAMAX, DECMIN, DECMAX, RACEN, DECENT,
     > rar,decr,galb,gall
	CHARACTER*1 ANS, FCHAR*3,F1,SCODE*2,TITLE*42,DEVICE*20,
     >    scanfile*75, CDATE*9, CTIME*8,title1*52,surv*1,argv*1
        
        factor=1.
        call getarg(1,argv)
        read(argv,'(a)') surv
c	TYPE 4
c        call idate (imon,iday,iyr)
c	ACCEPT 2, DEVICE
  4	FORMAT(1X,'Output device ?',$)
  2	FORMAT(A)
* Set up PGPLOT
        
	CALL PGBEGIN(0,'gks74.ps/ps',1,1)
	CALL PGVPORT(0.0,1.0,0.0,1.0)
cccc        write(title,111)'Generated ',iday,'/',imon,'/',iyr
 111    format(a10,i2.2,a1,i2.2,a1,i2.2)
* set scales/world coordinates
c       read (5,'(a)') surv
       if (surv.eq.'j') scanfile='scanUKJ.lis'
       if (surv.eq.'r') scanfile='scanUKR.lis'
       if (surv.eq.'i') scanfile='scanUKI.lis'
       if (surv.eq.'e') scanfile='scanESOR.lis'
       if (surv.eq.'j') scanfile='scanUKJ.lis'
       if (surv.eq.'f') then
       scanfile='scanPAR.lis'
       factor=-1.
       end if
       if (surv.eq.'b') then
       scanfile='scanPAJ.lis'       
        factor=-1.
       end if
             if (surv.eq.'n') then
       scanfile='scanPAI.lis'       
        factor=-1.
       end if
       open (64,file=scanfile,status='old')
       do i=1,1000
       read (64,*,end=777,err=109,iostat=ios) tempf
 109   continue
       if (ios.eq.0) then
       add(tempf)=7
       end if
       end do     
 777   continue
        call pgslw(2)
	CALL PGENV(25.0,-2.0,-92.5,7.5,0,-2)

c        do bb=-30.,30.,10.
c        do ll=0.,360.,5.
c        galb=bb/57.29577951
c        gall=ll/57.29577951
c        call sla_ge50(gall,galb,rar,decr)
c        rar=rar*57.29577951/15.
c        decr=decr*57.29577951
c        write (6,*) bb,ll,rar,decr
c        ra4=rar
c        dec4=decr
c        if (ra4.ge.0. .and. ra4.le.24. .and.
c     > dec4.le.0. and. dec4.ge.-90.) then
c        call pgpoint (1,ra4,dec4,16)
c        end if
     
c        end do
c        end do
* label the graph appropriately
        
	CALL PGLAB('Right Ascension','Declination',' ')

* select character size, as fraction of default size

	CALL PGSCH(0.55)

* Draw the RA scales, lower first

	CALL PGMOVE(-1.0,-90.0)
	CALL PGDRAW(25.0,-90.0)
	Y1 = -90.0
	DO I = -6, 150
	   X1 = FLOAT(I) / 6.0
	   Y2 = -90.7
	   IF (MOD(I,6) .EQ. 0) Y2 = -91.5
	   IF (MOD(I,3) .EQ. 0) Y2 = -91.0
	   CALL PGMOVE(X1,Y1)
	   CALL PGDRAW(X1,Y2)
	END DO

	DO I = 0,24
	   X1 = FLOAT(I)
	   K = I
	   IF (K .EQ. 24) K = 0
	   WRITE(FCHAR,'(I2)') K
	   CALL PGTEXT(X1+0.2,-92.5,FCHAR(1:2))
	   IF (K .EQ. 0) CALL PGTEXT(X1-0.1,-92.,'h')
	END DO


* upper scale

	CALL PGMOVE(-1.0,5.0)
	CALL PGDRAW(25.0,5.0)
	Y1 = 5.0
	DO I = -6, 150
	   X1 = FLOAT(I) / 6.0
	   Y2 = 5.7
	   IF (MOD(I,6) .EQ. 0) Y2 = 6.5
	   IF (MOD(I,3) .EQ. 0) Y2 = 6.0
	   CALL PGMOVE(X1,Y1)
	   CALL PGDRAW(X1,Y2)
	END DO

	DO I = 0,24
	   X1 = FLOAT(I)
	   K = I
	   IF (K .EQ. 24) K = 0
	   WRITE(FCHAR,'(I2)') K
	   CALL PGTEXT(X1+0.2,7.0,FCHAR(1:2))
	   IF (K .EQ. 0) CALL PGTEXT(X1-0.1,7.5,'h')
	END DO

* Mark declinations

	X1 = 25
	DO I = 0, 18
	   X2 = -0.5
	   Y1 =  -FLOAT(I) * 5 +2.5
	   WRITE(FCHAR,'(SI3)') -I * 5 * nint(factor)
	   CALL PGTEXT(X1,Y1,FCHAR)
	   IF ((I .EQ. 16).OR.(I .EQ. 17)) X2 = -1.3
	   CALL PGTEXT(X2,Y1,FCHAR)
	END DO


* change character size

	CALL PGSCH(0.550)
        call pgslw(1)
	DO I = 1,894
	   FEELD = I
	   CALL FIELDN(FEELD,RACEN,DECENT,RAMIN,RAMAX,DECMIN,DECMAX)
	   X1 = RAMIN
	   X2 = RAMAX
	   Y1 = DECMIN
	   Y2 = DECMAX

	   XPT(1) = X1
	   XPT(2) = X2
	   XPT(3) = X2
	   XPT(4) = X1

	   YPT(1) = Y1
	   YPT(2) = Y1
	   YPT(3) = Y2
	   YPT(4) = Y2

	   WRITE(FCHAR,'(I3)') FEELD
 
	      CALL PGSFS(2)
              call pgsci(1)
           if (add(feeld).eq.7) then
           call pgsfs(1)
           end if
	      CALL PGPOLY(4, XPT, YPT)
           call pgslw(2)
           if (add(feeld).eq.7) then
           call pgsci(0)
           call pgslw(3)
           end if
	      CALL PGpTXT((x1/2.+ x2/2.)-0.1,Y1+0.7,90.,0.0,FCHAR)
           call pgslw(1)
	END DO


  

	CALL PGEND
	END

      



