* Last processed by NICE on 12-Jun-2000 15:51:00
* Customized for :  IEEE, LINUX, UNIX, MOTIF, F77
      SUBROUTINE READ_BLOCK(IBL,OUTBUF,ERROR)
C-------------------------------------------------------------------------------
C PSC
C	Retrieves one 38 byte record from big 9728 byte buffer
C-------------------------------------------------------------------------------
      INTEGER IBL
      LOGICAL ERROR
      INTEGER*1 OUTBUF(38)
*
      INTEGER*1 BLOCK_BUF(9728)
      INTEGER BLOCK, OLD_BLOCK, JBL
      SAVE BLOCK_BUF, OLD_BLOCK
*
* Determines physical block number from logical block number.
      BLOCK = (IBL-1)/256 + 1            ! Physical block number
      JBL   = MOD(IBL-1,256)*38 +1       ! Address of record in physical block
* Reads physical block if needed
      IF (BLOCK.NE.OLD_BLOCK) THEN
         CALL GET_BLOCK(BLOCK,BLOCK_BUF,ERROR)
         IF (ERROR) THEN
            WRITE(6,*) 'Error reading block ',BLOCK,
     $      ' Ibl = ',IBL
            RETURN
         ENDIF
         OLD_BLOCK = BLOCK
      ENDIF
      CALL BYTOBY(BLOCK_BUF(JBL),OUTBUF,38)
      END
C<FF>
      SUBROUTINE GET_BLOCK(IBL,BUF,ERROR)
C------------------------------------------------------------------------------
C PSC
C	Retrieves one big 9728 byte buffer from disk or tape.
C------------------------------------------------------------------------------
      INTEGER IBL
      INTEGER*1 BUF(9728)
      LOGICAL ERROR
      INCLUDE 'psc.inc'
      INTEGER CURR_BLOCK                 ! Current block number on tape
*
C+VMS
c      INCLUDE '($foriosdef)'
C-VMS
*
      LOGICAL ERR, END_FILE, END_TAPE
      INTEGER NSKIP, NCOUN, IER
*
      DATA CURR_BLOCK /1/
      SAVE CURR_BLOCK
*
      ERROR = .FALSE.
      IF (TAPE) THEN
         NSKIP =  IBL - CURR_BLOCK
         IF (NSKIP.NE.0) THEN
            CALL MTSKBL (CHAN,NSKIP,NCOUN,END_TAPE,ERR)
            IF (ERR.OR.END_TAPE) THEN
               ERROR = .TRUE.
               RETURN
            ELSEIF (NCOUN.NE.NSKIP) THEN
               WRITE(6,*) 'Skipped ',NCOUN,' instead of ',NSKIP
            ENDIF
         ENDIF
         CALL MTREAD(CHAN,BUF,9728,END_FILE,END_TAPE,ERR)
         IF (END_FILE) THEN
            WRITE(6,*) 'Gone to end of tape. ',
     $      'Internal logic error'
            ERROR = .TRUE.
            RETURN
         ENDIF
         IF (ERR.OR.END_TAPE) THEN
            ERROR = .TRUE.
            RETURN
         ENDIF
      ELSE
         READ(UNIT=PSC_LUN,REC=IBL,IOSTAT=IER) BUF
         IF (IER.NE.0) THEN
            ERROR = .TRUE.
            CALL PUTIOS('F-PSC, ',IER)
C+VMS
c            IF (IER.EQ.FOR$IOS_ATTACCNON) THEN
c               WRITE(6,*) 'F-PSC,  Gone to end of file. ',
c     $         'Internal logic error'
c            ENDIF
C-VMS
            RETURN
         ENDIF
      ENDIF
      RETURN
      END
C<FF>
      SUBROUTINE PSC_OPEN(ERROR)
C-----------------------------------------------------------------------------
C PSC
C	Opens the full catalog on disk, or mounts the magnetic tape.
C-----------------------------------------------------------------------------
      LOGICAL ERROR
      INCLUDE 'psc.inc'
      INCLUDE 'inc:errcod.inc'
      INCLUDE 'inc:format.inc'
      INTEGER STATUS, SIC_GETLUN
      CHARACTER*132 FULLCAT
      LOGICAL ERR
*
* Mount Tape (and rewind it)
      IF (TAPE) THEN
         WRITE(6,*) 'Please mount tape GAG242 on drive',TAPE_DRIVE
         CALL MTMOUN (TAPE_DRIVE,CHAN,ERR)
         IF (ERR) THEN
            WRITE(6,*) 'E-PSC,  Try again later'
            CALL SYSEXI(FATALE)
         ENDIF
* Open disk file
      ELSE
         STATUS = SIC_GETLUN(PSC_LUN)
         FULLCAT = 'PSC_COMPACT'
         CALL SIC_GTLGTR(FULLCAT)
         OPEN (UNIT=PSC_LUN,FILE=FULLCAT,RECL=2432*FACUNF,
     $   STATUS='OLD',ACCESS='DIRECT',
C+VMS
c     $   SHARED,READONLY,
C-VMS
     $   FORM='UNFORMATTED',ERR=99)
      ENDIF
* Output listing
      IF (LISTOUT) THEN
         STATUS = SIC_GETLUN(LIST_LUN)
         OPEN (UNIT=LIST_LUN,FILE=OUTLIST
C+VMS
c     $   ,CARRIAGECONTROL='LIST'
C-VMS
     $   ,STATUS='NEW')
      ENDIF
      RETURN
99    CALL SYSEXI(FATALE)
      END
