nemock.f

Go to the documentation of this file.

C> @file
C> @author WOOLLEN @date 1994-01-06
      
C> THIS FUNCTION CHECKS A MNEMONIC TO VERIFY THAT IT HAS A
C>   LENGTH OF BETWEEN ONE AND EIGHT CHARACTERS AND THAT IT ONLY
C>   CONTAINS CHARACTERS FROM THE ALLOWABLE CHARACTER SET.
C>
C> PROGRAM HISTORY LOG:
C> 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
C> 2003-11-04  J. ATOR    -- ADDED DOCUMENTATION
C> 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
C>                           INTERDEPENDENCIES
C> 2003-11-04  D. KEYSER  -- SPLIT NON-ZERO RETURN INTO -1 FOR LENGTH
C>                           NOT 1-8 CHARACTERS AND -2 FOR INVALID
C>                           CHARACTERS (RETURN ONLY -1 BEFORE FOR ALL
C>                           PROBLEMATIC CASES); UNIFIED/PORTABLE FOR
C>                           WRF; ADDED HISTORY DOCUMENTATION
C>
C> USAGE:    NEMOCK (NEMO)
C>   INPUT ARGUMENT LIST:
C>     NEMO     - CHARACTER*(*): MNEMONIC TO BE CHECKED
C>
C>   OUTPUT ARGUMENT LIST:
C>     NEMOCK   - INTEGER: INDICATOR AS TO WHETHER NEMO IS VALID:
C>                       0 = yes
C>                      -1 = no, length not between 1 and 8 characters
C>                      -2 = no, it does not contain characters from the
C>                           allowable character set
C>
C> REMARKS:
C>    THIS ROUTINE CALLS:        None
C>    THIS ROUTINE IS CALLED BY: RDUSDX   SEQSDX   SNTBBE   SNTBDE
C>                               Normally not called by any application
C>                               programs.
C>
      FUNCTION nemock(NEMO)
 
 
 
      CHARACTER*(*) nemo
      CHARACTER*38  chrset
 
      DATA chrset /'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_.'/
      DATA nchr   /38/
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C  GET THE LENGTH OF NEMO
C  ----------------------
 
      lnemo = 0
 
      DO i=len(nemo),1,-1
      IF(nemo(i:i).NE.' ') THEN
         lnemo = i
         GOTO 1
      ENDIF
      ENDDO
 
1     IF(lnemo.LT.1 .OR. lnemo.GT.8) THEN
         nemock = -1
         GOTO 100
      ENDIF
 
C  SCAN NEMO FOR ALLOWABLE CHARACTERS
C  ----------------------------------
 
      DO 10 i=1,lnemo
      DO j=1,nchr
      IF(nemo(i:i).EQ.chrset(j:j)) GOTO 10
      ENDDO
      nemock = -2
      GOTO 100
10    ENDDO
 
      nemock = 0
 
C  EXIT
C  ----
 
100   RETURN
      END