SUBROUTINE FILEXT (OLDFIL,NEWFIL,
     2          EXT,ERRCD)
c
c       FUNCTION:
cf
cf      FILEXT takes a file specification (OLDFIL) which
cf      may not have an extension, checks to see if the extension
cf      exists, and if not, adds the extension supplied as the default
cf      value (EXT).  The result is placed in NEWFIL.  If the resulting
cf      length would be greater than the length of the receiving area
cf      (NEWFIL), the ERRCD is set to 4.  The length
cf      of the original OLDFIL is also checked; if it is zero,
cf      then ERRCD is set to 2.  ERRCD is set to zero for
cf      normal return.
cf
c       USAGE:
cu
cu      The subroutine FILEXT is used to provide a default value
cu      for a file specification.  The user supplies the original file
cu      specification (OLDFIL), a default extension (EXT), and
cu      a character string storage area for the result (NEWFIL).
cu      The subroutine returns an error code (ERRCD), which is non-zero
cu      if the original string has length zero (value 2), or if the
cu      resulting file specification will not fit in the area provided
cu      (value 4).
cu
cu      The subroutine is called as:
cu
cu      CALL FILEXT (OLDFIL,NEWFIL,EXT,ERRCD)
cu
c       INPUTS:
ci
ci        OLDFIL    = character variable containing the original
ci                    file specification.
ci
ci         EXT      = character variable containing the default
ci                    extension to be used, with the period ('.').
ci                    No blanks may exist in this string.  For
ci                    example, EXT = '.SYS'.
ci
c       OUTPUTS:
co
co        NEWFIL   = character variable to contain the final file
co                   specification.
co
co        ERRCD    = integer variable indicating any errors which
co                   occured during processing.  A value of
co                   zero indicates successful completion.
co
co                   ERRCD : 2 : the original file specification
co                   contained no non-blank characters.
co
co                   ERRCD : 4 : the resulting file specification
co                   would not fit in the variable NEWFIL.
co
c       ALGORITHM:
ca
ca        NONE
ca
c       MACHINE DEPENDENCIES:
cm        
cm         Other than the basic assumption of file extensions,
cm         there are no machine dependencies.
cm
c       HISTORY:
ch
ch      written by:             J. Douglas Birdwell
ch      date:                   November 12, 1984
ch      current version:        1.0
ch      modifications:          8-aug=96:bb:modified 
ch                              routine to eliminate
ch                              machine dependencies.
ch
c       ROUTINES CALLED:
cc
cc       NONE
cc
c       COMMON MEMORY USED:
cm
cm       NONE
cm
c----------------------------------------------------------------------
c       written for:    The CASCADE Project
c                       Oak Ridge National Laboratory
c                       U.S. Department of Energy
c                       contract number DE-AC05-840R21400
c                       subcontract number 37B-7685 S13
c                       organization:   The University of Tennessee
c----------------------------------------------------------------------
c       THIS SOFTWARE IS IN THE PUBLIC DOMAIN
c       NO RESTRICTIONS ON ITS USE ARE IMPLIED
c----------------------------------------------------------------------
c
c       GLOBAL VARIABLES:
C
        CHARACTER*(*)   OLDFIL
        CHARACTER*(*)   NEWFIL
        CHARACTER*(*)   EXT
        INTEGER         ERRCD
C
C       LOCAL VARIABLES:
C
        CHARACTER*20    VERSN
        CHARACTER*1     CHAR
        INTEGER         LNOFIL
        INTEGER         LNNFIL
        INTEGER         LENEXT
        INTEGER         FNBLNK
        INTEGER         LENGTH
        INTEGER         SLLES1
C
C       CODE:
C
C--FIND LENGTHS OF THE VARIOUS STRINGS
C
        LNOFIL = LEN(OLDFIL)
        LNNFIL = LEN(NEWFIL)
        LENEXT = LEN(EXT)
C
C--FIND THE LAST NON-BLANK CHARACTER
C
        FNBLNK = LNOFIL
 10     IF ((OLDFIL(FNBLNK:FNBLNK) .EQ. ' ') 
     2          .AND. (FNBLNK .GT. 0)) THEN

          FNBLNK = FNBLNK - 1
          GO TO 10

        END IF

C
C--IF THERE ARE NO NON-BLANK CHARACTERS, SIGNAL ERROR CODE 2
C

        IF (FNBLNK .EQ. 0) THEN

          ERRCD = 2
          RETURN

        END IF

C
C--GO BACKWARD THROUGH STRING
C

        DO 20, I = FNBLNK, 1, -1

          CHAR = OLDFIL(I:I)

          IF ((CHAR .EQ. ':')
     2      .OR. (CHAR .EQ. ']')
     3      .OR. (I .EQ. 1)) THEN

            NEWFIL = OLDFIL(1:FNBLNK)//EXT

C
C--CHECK LENGTH
C

            LENGTH = FNBLNK + LENEXT
            IF (LENGTH .GT. LNNFIL) THEN
              ERRCD = 4
              RETURN
            ELSE
              ERRCD = 0
              RETURN
            END IF

          ELSE IF (CHAR .EQ. '.') THEN

            NEWFIL = OLDFIL(1:FNBLNK)

C
C--CHECK LENGTH
C

            LENGTH = FNBLNK
            IF (LENGTH .GT. LNNFIL) THEN
              ERRCD = 4
              RETURN
            ELSE
              ERRCD = 0
              RETURN
            END IF

          ELSE IF (CHAR .EQ. ';') THEN

            VERSN = OLDFIL(I:FNBLNK)
            SLLES1 = I - 1

            DO 30, J = SLLES1, 1, -1

              CHAR = OLDFIL(J:J)

              IF (CHAR .EQ. '.') THEN

                NEWFIL = OLDFIL(1:FNBLNK)

C
C--CHECK LENGTH
C

                LENGTH = FNBLNK 
                IF (LENGTH .GT. LNNFIL) THEN
                  ERRCD = 4
                  RETURN
                ELSE
                  ERRCD = 0
                  RETURN
                END IF

              ELSE IF ((CHAR .EQ. ':')
     2          .OR. (CHAR .EQ. ']')
     3          .OR. (J .EQ. 1)) THEN

                NEWFIL = OLDFIL(1:SLLES1)//EXT//
     2                  OLDFIL(I:FNBLNK)

C
C--CHECK LENGTH
C

                LENGTH = FNBLNK + LENEXT
                IF (LENGTH .GT. LNNFIL) THEN
                  ERRCD = 4
                  RETURN
                ELSE
                  ERRCD = 0
                  RETURN
                END IF

              END IF
 30         CONTINUE
          END IF
 20     CONTINUE

C
C--IT'S NOT SUPPOSED TO GET HERE
C

        ERRCD = 8
        RETURN

        END