C Copyright(c) 1997, Space Science and Engineering Center, UW-Madison
C Refer to "McIDAS Software Acquisition and Distribution Policies"
C in the file  mcidas/data/license.txt

C *** $Id: nameok.f,v 1.8 1997/10/10 20:18:28 dglo Exp $ ***

C $ SUBROUTINE NAMEOK(CFLNAM,RESULT)
C $ NAMEOK - validate a mainframe LW file name
C $ Input:
C $   CFLNAM = (C*12) LW file name
C $ Output:
C $   RESULT = (I) validation result, 0: file name OK
C $                                  -1: file name bad
C $$ NAMEOK = LW

      SUBROUTINE NAMEOK(CFLNAM,RESULT)
      IMPLICIT LOGICAL(A-Z)
C
      INTEGER RESULT
      INTEGER LENGTH, I
      CHARACTER*12 CFLNAM
      CHARACTER*12 CTEMP
C
C*********************************************************************
C
C   Description:
C     This subroutine will determine if a character string meets the
C   requirements for a valid mainframe LW file name.
C
C   Constants:
C     -none-
C
C   Parameters:
C     CFLNAM: string to validate as acceptable mainframe LW file name
C     RESULT: output result code, 0: OK, -1: invalid
C
C   Non-intrinsic subroutines called:
C     -none-
C
C   Non-intrinsic functions called:
C     -none-
C
C   Local variables:
C     LENGTH: length of input string to validate (should be 12)
C     I     : loop control variable
C     CTEMP : copy of input string to work with
C
C*********************************************************************
C
C -- initialize result code to OK
C
      RESULT= 0
C
C -- look for all nines, less than 2 chars, or file extension (period)
C
      IF ((CFLNAM .EQ. '999999999999') .OR.
     &    (CFLNAM(2:2) .EQ. ' ') .OR.
     &    (INDEX(CFLNAM,'.') .NE. 0)) THEN
        RESULT= -1
        GOTO 5000
      ENDIF
C
C -- look for lower case letters
C
      CTEMP= CFLNAM
      LENGTH = LEN(CTEMP)
      DO 100 I= 1,LENGTH
        IF ((CTEMP(I:I) .GE. 'a') .AND. (CTEMP(I:I) .LE. 'z')) THEN
          RESULT= -1
          GOTO 5000
        ENDIF
100   CONTINUE
C
C -- look for unprintable characters
C
      DO 200 I= 1,LENGTH
        IF ((CTEMP(I:I) .LT. ' ') .OR. (CTEMP(I:I) .GT. '~')) THEN
          RESULT= -1
          GOTO 5000
        ENDIF
200   CONTINUE
C
C -- make sure name starts with an alphanumeric character
C
      IF ((CFLNAM(1:1) .LT. 'A') .OR. (CFLNAM(1:1) .GT. 'Z')) THEN
        IF ((CFLNAM(1:1) .LT. '0') .OR. (CFLNAM(1:1) .GT. '9')) THEN
          RESULT= -1
          GOTO 5000
        ENDIF
      ENDIF
C
C -- look for embedded blanks
C
      DO 300 I= 3, LEN(CFLNAM)-1
        IF (CFLNAM(I:I) .EQ. ' ') THEN
          IF (CFLNAM(I:) .NE. ' ') THEN
            RESULT= -1
            GOTO 5000
          ENDIF
        ENDIF
300   CONTINUE
C
5000  RETURN
      END
