* Last processed by NICE on 12-Jun-2000 15:51:00
* Customized for :  IEEE, LINUX, UNIX, MOTIF, F77
      PROGRAM PSC_MAIN
      INCLUDE 'inc:xpar.inc'
      INCLUDE 'inc:ypar.inc'
      INCLUDE 'inc:format.inc'
      INCLUDE 'inc:errcod.inc'
      INCLUDE 'inc:pi.inc'
      INCLUDE 'psc.inc'
      INCLUDE 'inc:memory.inc'
      LOGICAL ERROR
*
      INTEGER SIC_GETVM
      INTEGER*4 POINTER, IPRA, IPDE, IPF, IPBL, IPNU,
     $IPI, IPO, NUM_ADDR, IPY
      INTEGER I, N_GOOD, N_SOURCES, IMAX(2), IMIN(2), N_RANGE
      INTEGER*4 BLC(4), TRC(4)
      CHARACTER*132 FULLCAT
* Data
      DATA BLC /4*0/, TRC/4*0/
*--------------------------------------------------------------------------
* Determines if the full catalog is present on disk
      FULLCAT = 'PSC_COMPACT'
      CALL SIC_GTLGTR(FULLCAT)
      INQUIRE (FILE=FULLCAT,EXIST=TAPE)
      TAPE = .NOT. TAPE
* User input
      CALL GET_CRITERIA (ERROR)
      IF (ERROR) THEN
         WRITE(6,*) 'F-PSC,  Fatal error on selection criteria'
         CALL SYSEXI(FATALE)
      ENDIF
*
* Open the full catalog if needed
      IF (CHECK_FILE .OR. LISTOUT) THEN
         CALL PSC_OPEN(ERROR)
         IF (ERROR) THEN
            WRITE(6,*) 'F-PSC,  Fatal error on full catalog opening'
            CALL SYSEXI(FATALE)
         ENDIF
      ENDIF
*
* Map the table
      X_FILE = INTABLE
      CALL GDF_GEIS (X_ISLO,ERROR)
      IF (.NOT.ERROR) CALL
     $GDF_REIS (X_ISLO,X_TYPE,X_FILE,X_FORM,X_SIZE,ERROR)
      IF (ERROR) GOTO 99
      X_GENE = 3                         ! Request three parameters
      CALL GDF_RHSEC(X_ISLO,'TABLE',X_NDIM,X_GENE,ERROR)
      IF (ERROR .OR. X_NDIM.GT.2) THEN
         WRITE(6,*) 'E-LIST,  Error reading table'
         GOTO 99
      ENDIF
      CALL GDF_GEMS (X_MSLO,X_ISLO,BLC,TRC,X_ADDR,X_FORM,ERROR)
* Determine source range from max and min RA.
      IF (CHECK_RA) THEN
         CALL GET_RANGE(X_DIM(1),X_ADDR,N_RANGE,IMAX,IMIN)
      ELSE
         N_RANGE = 1
         IMIN(1) = 1
         IMAX(1) = X_DIM(1)
      ENDIF
      IF (N_RANGE.EQ.1) THEN
         RAMIN(1) = RMIN
         RAMAX(1) = RMAX
      ELSE
         RAMIN(1) = RMAX
         RAMAX(1) = 2*PI
         RAMIN(2) = 0
         RAMAX(2) = RMIN
      ENDIF
* Determine total number of potential sources.
      N_SOURCES = 0
      DO I=1,N_RANGE
         N_SOURCES = N_SOURCES + IMAX(I) - IMIN(I) + 1
      ENDDO
* Get virtual memory to store all potentially selected sources.
      IF (SIC_GETVM(N_SOURCES, NUM_ADDR).NE.1) GOTO 99
*
* Set pointers to columns of the table
      N_GOOD = 0
      IPNU = POINTER(NUM_ADDR,MEMORY)
      IPRA = POINTER(X_ADDR,MEMORY)      ! RA column
      IPDE = IPRA + X_DIM(1)             ! Dec column
      IPF  = IPRA + 2*X_DIM(1)           ! Flux
      IPBL = IPRA + 6*X_DIM(1)           ! Block number column
*
* Apply selection criteria.
      DO I = 1, N_RANGE
         RMIN = RAMIN(I)
         RMAX = RAMAX(I)
         CALL SELECT (X_DIM(1),IMIN(I),IMAX(I),
     $   MEMORY(IPRA),MEMORY(IPDE),MEMORY(IPF),
     $   MEMORY(IPBL),N_GOOD,MEMORY(IPNU))
      ENDDO
      WRITE (6,'(1X,A,I6,A)') 'I-PSC, ',N_GOOD,' sources found.'
      IF (N_GOOD.LE.0) THEN
         WRITE(6,*) 'W-PSC,  No source selected.'
* If requested, create a new table for selected sources.
      ELSEIF (WRITEOUT) THEN
         Y_DIM(1) = N_GOOD
         Y_DIM(2) = X_DIM(2)
         Y_NDIM = 2
         Y_GENE = 3
         CALL GDF_GEIS (Y_ISLO,ERROR)
         IF (ERROR) GOTO 99
         CALL GDF_WHSEC(Y_ISLO,'TABLE',Y_NDIM,Y_GENE,ERROR)
         Y_SIZE = Y_DIM(1)*Y_DIM(2)
         Y_FORM = FMT_R4
         CALL SIC_PARSEF(OUTTABLE,Y_FILE,' ','.TAB')
         Y_TYPE = 'GILDAS_IMAGE'
         CALL GDF_CRIS (Y_ISLO,Y_TYPE,Y_FILE,Y_FORM,Y_SIZE,ERROR)
         IF (ERROR) THEN
            WRITE(6,*) 'F-PSC,  Fatal error on table opening ',
     $      Y_FILE
            GOTO 99
         ENDIF
*
         CALL GDF_GEMS (Y_MSLO,Y_ISLO,BLC,TRC,Y_ADDR,Y_FORM,ERROR)
         IF (ERROR) GOTO 99
* Fill output table with appropriate information from input table
         IPY = POINTER(Y_ADDR,MEMORY)
         DO I =1, Y_DIM(2)
            IPI = IPRA + X_DIM(1)*(I-1)
            IPO = IPY  + Y_DIM(1)*(I-1)
            CALL COPY_GOOD (N_GOOD,MEMORY(IPNU),
     $      MEMORY(IPI),MEMORY(IPO))
         ENDDO
         CALL GDF_FRIS(Y_ISLO,ERROR)
      ENDIF
      CALL GDF_FRIS(X_ISLO,ERROR)
      STOP 'S-PSC, Successful completion'
99    CALL SYSEXI(FATALE)
      END