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