*DECK OPNIND
      SUBROUTINE OPNIND(IUNIT,INDEX,LINDEX)
C----
C  ROUTINE DESCRIPTION:
C      OPEN, READ OR CLOSE INDEXED RANDOM FILE
C      USING FORTRAN DIRECT ACCESS FILES
C  ENTRY:
C      ENTRY OPNIND = OPEN FILE AND READ MASTER INDEX
C      ENTRY REDIND = READ DATA ON INDEXED FILE
C      ENTRY CLSIND = CLOSE FILE
C  REVISION HISTORY:
C      85      : CREATED BY J. DONNELLY
C      86-03-31: MODIFIED BY R. KOSSMANN FOR VAX
C      86-04-18: MODIFIED BY J. DONNELLY
C                INFORMATION ABOUT MAIN INDEX SAVED IN MAINTY...MAINNA
C                SO THAT FILE MAY BE RE-OPENED
C      86-08-18: MODIFIED TO CHECK MASTER INDEX LENGTH AGAINST PREVIOUSL
C                STORED MASTER INDEX LENGTH; R. KOSSMANN
C      93-08-25: MODIFIED FOR IMPLEMENTATION IN DRAGON
C                WRITE FORBIDDEN (G. MARLEAU)
C                ONLY ONE FILE AVAILABLE
C      12-12-17: CONVERT TO FORTRAN-2003 (A. HEBERT)
C  INPUT/OUTPUT PARAMETER DESCRIPTION:
C    IUNIT   = READ UNIT
C    INDEX   = INDEX TABLE (MASTER INDEX FOR OPNIND)
C    LINDEX  = LENGTH OF INDEX TABLE
C             LINDEX >=(# OF ENTRIES) + 1
C    DATA    = DATA ARRAY TO RETREIVE FROM FILE
C    NWORDS  = LENGHT OF DATA ARRAY TO RETREIVE FROM FILE
C    KEY     = LOCATION OF DATA ARRAY IN INDEX
C  INTERNAL PARAMETER DESCRIPTION:
C    IOUT    = OUTPUT UNIT = 6
C    NBLOCKS = NUMBER OF BLOCKS PER RECORD = 256
C    IOFSET  = OFFSET FOR INDEX LENGTH = 65536
C----
      PARAMETER (IOUT=6,NBLOCK=256,IOFSET=65536)
      INTEGER    IUNIT,INDEX(LINDEX),LINDEX
      LOGICAL    EXST, OPND
      CHARACTER  DIRST*7
      COMMON /OPENDA/ IUNITR
      DATA   IUNITR/0/
C----
C  UNIT NUMBER MUST BE > ZERO
C----
      IF(IUNIT.LE.0) THEN
        WRITE(IOUT,6000) IUNIT
        CALL XABORT('OPNIND: (READONLY) ILLEGAL UNIT NUMBER')
      ENDIF
C----
C  FIND OUT FILE STATUS, AND IF UNIT ALREADY ASSOCIATED WITH
C  AN OPEN FILE
C----
      INQUIRE(UNIT=IUNIT,EXIST=EXST,OPENED=OPND,DIRECT=DIRST)
      IF(.NOT.OPND) THEN
C----
C  FILE CLOSED
C----
        WRITE(IOUT,6010) IUNIT
        CALL XABORT('OPNIND: (READONLY) FILE NOT OPENED')
      ENDIF
      IF( EXST .AND. DIRST .EQ. 'NO' ) THEN
C----
C  FILE ALREADY EXISTS, BUT IS NOT DIRECT ACCESS
C----
        WRITE(IOUT,6020) IUNIT
        CALL XABORT('OPNIND: (READONLY) FILE IS NOR DIRECT ACCESS')
      ENDIF
      IF(.NOT.EXST) THEN
C----
C  FILE DOES NOT EXISTS
C----
        WRITE(IOUT,6030) IUNIT
        CALL XABORT('OPNIND: (READONLY) FILE DOES NOT EXISTS ')
      ENDIF
C----
C  PROCESS THE FILE MASTER INDEX
C----
      IUNITR=IUNIT
      IREC = 1
      MINW = 1
 40   CONTINUE
      MAXW = MIN0( MINW + NBLOCK - 1 , LINDEX )
      IERR=0
      READ(IUNIT,REC=IREC,IOSTAT=IERR) (INDEX(I),I=MINW,MAXW)
      IF(IERR.NE.0) THEN
        WRITE(IOUT,6040) IUNIT,IERR
        CALL XABORT('REDIND: READ MASTER RECORD ERROR')
      ENDIF
      IREC = IREC + 1
      IF( MAXW .NE. LINDEX ) THEN
        MINW = MAXW + 1
        GO TO 40
      ENDIF
C----
C  RETURN FROM OPNIND
C----
      RETURN
C----
C  FORMAT
C----
 6000 FORMAT(' //// OPNIND: FILE, ',I5,' INVALID')
 6010 FORMAT(' //// OPNIND: FILE, ',I5,' HAS NOT BEEN OPENED',
     >        ' WITH KDROPN')
 6020 FORMAT(' //// OPNIND: UNIT ',I5,' IS NOT A DIRECT ACCESS FILE')
 6030 FORMAT(' //// OPNIND: UNIT ',I5,' DOES NOT EXISTS ',
     >        ' (READONLY VERSION)')
 6040 FORMAT(' //// OPNIND: ERROR DURING READING OF MASTER INDEX ',
     >      'OF UNIT ',I5,' STATUS = ',I5)
      END SUBROUTINE OPNIND
C----
C  ENTRY CLSIND
C  CLOSE FILE
C----
      SUBROUTINE CLSIND(IUNIT)
      PARAMETER (IOUT=6)
      INTEGER    IUNIT
      COMMON /OPENDA/ IUNITR
 
      IF(IUNITR.NE.IUNIT) THEN
        WRITE(IOUT,6100) IUNIT
        CALL XABORT('CLSIND: FILE NOT OPENED BY OPNIND')
      ENDIF
      IUNITR=KDRCLS(IUNIT,1)
      IF(IUNITR.NE.0) THEN
        WRITE(IOUT,6110) IUNITR
        CALL XABORT('CLSIND: ERROR IN FILE CLOSING')
      ENDIF
C----
C  RETURN CLSIND
C----
      RETURN
C----
C  FORMAT
C----
 6100 FORMAT(' //// CLSIND: UNIT ',I5,' NOT FOUND')
 6110 FORMAT(' //// CLSIND: ERROR STATUS =',I5,' FROM KDRCLS')
      END SUBROUTINE CLSIND
C----
C  ENTRY REDIND
C  READ DATA FROM FILE
C----
      SUBROUTINE REDIND(IUNIT,INDEX,LINDEX,DATA,NWORDS,KEY)
      PARAMETER (IOUT=6,NBLOCK=256,IOFSET=65536)
      INTEGER    IUNIT,INDEX(LINDEX),LINDEX,DATA(*),NWORDS,KEY
      COMMON /OPENDA/ IUNITR
C
      IF(IUNITR.NE.IUNIT) THEN
        WRITE(IOUT,6200) IUNIT
        CALL XABORT('REDIND: FILE NOT OPENED BY OPNIND')
      ENDIF
C----
C  VALIDATE KEY NUMBER
C----
      IF(KEY.LE.0.OR.KEY.GE.LINDEX) THEN
        WRITE(IOUT,6210) IUNIT, KEY
        CALL XABORT('REDIND: INVALID KEY')
      ENDIF
C----
C  KEY NUMBER VALID, VALIDATE RECORD NUMBER
C----
      INDR=INDEX(KEY+1)
      IF(INDR.EQ.0) THEN
        WRITE(IOUT,6220) IUNIT, KEY
        CALL XABORT('REDIND: INVALID RECORD NUMBER FOR KEY')
      ENDIF
C----
C  VALIDATE RECORD LENGTH
C----
      LRECRD = (NWORDS-1)/NBLOCK + 1
      LOLDRC = INDR/IOFSET
      IF(LOLDRC.LT.LRECRD) THEN
        WRITE(IOUT,6230) IUNIT, KEY
        CALL XABORT('REDIND: INVALID RECORD LENGTH')
      ENDIF
C----
C  RECORD FOUND, READ THE DATA
C----
      NREC = MOD( INDR, IOFSET )
      MINW = 1
 50   CONTINUE
      MAXW = MIN0( MINW + NBLOCK - 1 , NWORDS )
      IERR=0
      READ(IUNIT,REC=NREC,IOSTAT=IERR) (DATA(I),I=MINW,MAXW)
      IF(IERR.NE.0) THEN
        WRITE(IOUT,6240) IUNIT,IERR
        CALL XABORT('REDIND: READ RECORD ERROR')
      ENDIF
      NREC = NREC + 1
      IF( MAXW .NE. NWORDS ) THEN
        MINW = MAXW + 1
        GO TO 50
      ENDIF
C----
C  RETURN REDIND
C----
      RETURN
C----
C  FORMAT
C----
 6200 FORMAT(' //// REDIND: UNIT ',I5,' NOT FOUND')
 6210 FORMAT(' //// REDIND: INVALID RECORD NUMBER, UNIT ',I5,
     >      ' KEY= ',I10)
 6220 FORMAT(' //// REDIND: NON-EXISTANT RECORD, UNIT ',I5,
     >      ' RECORD KEY =',I10)
 6230 FORMAT(' //// REDIND: DATA COUNT EXCEEDS RECORD, UNIT ',I5,
     >      ' RECORD KEY =',I10)
 6240 FORMAT(' //// REDIND: ERROR DURING READING OF RECORD ',
     >      'OF UNIT ',I5,' STATUS = ',I5)
      END SUBROUTINE REDIND
