C-----------------------------------------------------------------------
C
C  Subroutine IBMFIL to OPEN and CLOSE all files for the NRCVAX system 
C
C  The need for this routine was caused by the inability of Unix and
C  MS/DOS to interpret global symbols transparently during OPEN and
C  CLOSE statements.  NRCVAX only uses one such symbol GROUPS, which 
C  must be expanded before attempting to open the actual files involved.
C 
C  The routine essentially performs a straight OPEN or CLOSE function,
C  once the actual file-name is known.
C  The specification of the RECL parameter for SEQUENTIAL files is
C  NOT standard F77 and is included only for writing plot files.
C
C  The calling sequence is as follows :--
C
C    CALL IBMFIL (ACTUAL,IUNIT,IBMREC,ST,IERR)
C
C  The parameters are :--
C   ACTUAL - the actual file name as in all sensible computers
C   IUNIT  - the unit number; negative to CLOSE file
C   IBMREC - the record length for all files.   Non-standard F77
C            Only required for direct-access files.
C   ST     - a 2-character STATUS/ACCESS code made up as follows,
C        For OPEN statements :
C            N, O, U or T for NEW, OLD, UNKNOWN or SCRATCH
C            S or D for SEQUENTIAL or DIRECT.
C            F can be specified for UNformatted files, which are then
C              assumed to be Sequential.
C            L is used only in the VAX to specify 
C              CARRIAGECONTROL = 'LIST'
C            If blanks are used the defaults are U and S.
C            Files are assumed to be Formatted for S & Unformatted for D
C        For CLOSE statements :
C            As above except,
C            DE means delete the file after closing
C   IERR   - Error flag returned. 0 for OK.
C
C-----------------------------------------------------------------------
      SUBROUTINE IBMFIL (ACTUAL,IUNIT,IBMREC,STT,IERR)
      INCLUDE 'IATSIZ'
      CHARACTER ACTUAL*(*),STT*(*),ST*2,SA*2,STATUS*8,
     $          FORM*12,ACCESS*12,CARRIJ*8,WORK*128
      DIMENSION STUFF(100)
      ST(1:2) = STT(1:2)
      IERR = 0
      LENGTH = IBMREC
C-----------------------------------------------------------------------
C  Is the call for an OPEN or CLOSE function ?
C-----------------------------------------------------------------------
      IF (IUNIT .LT. 0) THEN
C-----------------------------------------------------------------------
C                    ****  It is a CLOSE  ****
C
C  For Sun machines find the end of direct-access files and rewrite the 
C  last record to prevent the file being truncated.
C-----------------------------------------------------------------------
        STATUS = 'KEEP'
        IUNIT = -IUNIT
        IF (ST .EQ. 'DE') THEN
          STATUS = 'DELETE'
        ELSE
C          IF (MNCODE .EQ. 'UNXSUN' .OR. MNCODE .EQ. 'UNXSGI') THEN
          IF (MNCODE .EQ. 'UNXSUN') THEN
            INQUIRE (UNIT = IUNIT, ACCESS = ACCESS, RECL = LENSUN)
            IF (ACCESS(1:3) .EQ. 'DIR') THEN
              IVLEN = 4
              IF (MNCODE .EQ. 'UNXSGI') IVLEN = 1
              CALL LENFIL (IUNIT,LASTBL)
              LENVAR = LENSUN/IVLEN
              READ  (IUNIT,REC = LASTBL) (STUFF(J),J = 1,LENVAR)
              WRITE (IUNIT,REC = LASTBL) (STUFF(J),J = 1,LENVAR)
            ENDIF
          ENDIF
        ENDIF
        CLOSE (UNIT = IUNIT, STATUS = STATUS)
        RETURN
      ELSE
C-----------------------------------------------------------------------
C                      ****  It is an OPEN  ****
C
C  For Unix and MS/DOS machines get the full name from the ACTUAL name.
C  This allows names to be expanded across sub-directories if the ACTUAL
C  name is GROUPS.  In UNIX this should have a SETENV statement in 
C  .cshrc to expand the name to the full local name.
C
C  *** The call to GETENV should be uncommented for Unix machines ***
C
C-----------------------------------------------------------------------
        LENAME = LEN(ACTUAL)
        DO 120 I = 1,LENAME
          J = LENAME + 1 - I
          IF (ACTUAL(J:J) .NE. ' ') GO TO 130
  120   CONTINUE
  130   LENAME = J
        WORK = ACTUAL
        IF (MNCODE .NE. 'VAXVMS') then
          IF (MNCODE .EQ. 'PCMSDS') THEN
c
c                 Avoid a compiler problem with '\'. char(92) is '\'!
c
CCC         IF (ACTUAL .EQ. 'GROUPS') WORK = '\NRCVAX\GROUPS.DAT'
            IF (ACTUAL .EQ. 'GROUPS') 
     +        WORK = char(92) // 'NRCVAX' // char(92) // 'GROUPS.DAT'
C          ELSE
C            IF (ACTUAL .EQ. 'GROUPS')
C     $          CALL GETENV (ACTUAL(1:LENAME),WORK)
          ENDIF
        ENDIF
C-----------------------------------------------------------------------
C  The ST code can be in any form of 
C     N, O, U, T or blank  with  D, S, F, L or blank  in any order.
C-----------------------------------------------------------------------
        SA = ST
        FORM = 'FORMATTED'
        IF (ST(1:1) .EQ. 'F' .OR. ST(2:2) .EQ. 'F') THEN
          FORM = 'UNFORMATTED'
          IF (ST(1:1) .EQ. 'F') ST(1:1) = ' '
          IF (ST(2:2) .EQ. 'F') ST(2:2) = ' '
        ENDIF
        CARRIJ = 'FORTRAN'
        IF (ST(1:1) .EQ. 'L' .OR. ST(2:2) .EQ. 'L') THEN
          CARRIJ = 'LIST'
          IF (ST(1:1) .EQ. 'L') ST(1:1) = ' '
          IF (ST(2:2) .EQ. 'L') ST(2:2) = ' '
        ENDIF
        IF (ST .EQ. 'DN') SA = 'ND'
        IF (ST .EQ. 'DO') SA = 'OD'
        IF (ST .EQ. 'ST') SA = 'TS'
        IF (ST .EQ. 'DT') SA = 'TD'
        IF (ST .EQ. ' N' .OR. ST .EQ. 'N ' .OR. ST .EQ. 'SN') SA = 'NS'
        IF (ST .EQ. ' O' .OR. ST .EQ. 'O ' .OR. ST .EQ. 'SO') SA = 'OS'
        IF (ST .EQ. ' D' .OR. ST .EQ. 'D ' .OR. ST .EQ. 'DU') SA = 'UD'
        IF (ST .EQ. '  ' .OR. ST .EQ. ' S' .OR. ST .EQ. 'S ' .OR.
     $      ST .EQ. ' U' .OR. ST .EQ. 'U ' .OR. ST .EQ. 'SU') SA = 'US'
        STATUS = 'UNKNOWN'
        IF (SA(1:1) .EQ. 'N') STATUS = 'NEW'
        IF (SA(1:1) .EQ. 'O') STATUS = 'OLD'
        IF (SA(1:1) .EQ. 'T') STATUS = 'SCRATCH'
        ACCESS = 'SEQUENTIAL'
        IF (SA(2:2) .EQ. 'D') THEN
          ACCESS = 'DIRECT'
          FORM   = 'UNFORMATTED'
        ENDIF
C-----------------------------------------------------------------------
C  Open the file at last.  Safeguard the record length for VAX
C  The first OPEN statement (for the VAX) must be commented out in
C  versions for other computers
C-----------------------------------------------------------------------
        IF (LENGTH .EQ. 0) LENGTH = 80
        IF (MNCODE .EQ. 'VAXVMS') THEN
C          OPEN (UNIT   = IUNIT,  FILE = WORK, STATUS = STATUS,
C     $          ACCESS = ACCESS, FORM = FORM, RECL   = LENGTH,
C     $          CARRIAGECONTROL = CARRIJ,     ERR    = 200)
          CONTINUE
        ELSE
          IF (STATUS .NE. 'SCRATCH') THEN
            IF (ACCESS .EQ. 'DIRECT') THEN
              OPEN (UNIT   = IUNIT,  FILE = WORK, STATUS = STATUS,
     $              ACCESS = ACCESS, FORM = FORM, RECL   = LENGTH,
     $              ERR    = 200)
            ELSE
              OPEN (UNIT   = IUNIT,  FILE = WORK, STATUS = STATUS,
     $              ACCESS = ACCESS, FORM = FORM, ERR    = 200)
            ENDIF
          ELSE
            IF (ACCESS .EQ. 'DIRECT') THEN
              OPEN (UNIT   = IUNIT,  STATUS = STATUS,
     $              ACCESS = ACCESS, FORM = FORM, RECL   = LENGTH,
     $              ERR    = 200)
            ELSE
              OPEN (UNIT   = IUNIT,  STATUS = STATUS,
     $              ACCESS = ACCESS, FORM = FORM, ERR    = 200)
            ENDIF
          ENDIF
        ENDIF
        RETURN
      ENDIF
C-----------------------------------------------------------------------
C  Some sort of error was made.  Go back and try again probably.
C-----------------------------------------------------------------------
  200 IERR = 1
      RETURN
      END