var/external/bufr/nemock.f

   1       FUNCTION NEMOCK(NEMO)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    NEMOCK
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS FUNCTION CHECKS A MNEMONIC TO VERIFY THAT IT HAS A
   9 C   LENGTH OF BETWEEN ONE AND EIGHT CHARACTERS AND THAT IT ONLY
  10 C   CONTAINS CHARACTERS FROM THE ALLOWABLE CHARACTER SET.
  11 C
  12 C PROGRAM HISTORY LOG:
  13 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  14 C 2003-11-04  J. ATOR    -- ADDED DOCUMENTATION
  15 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  16 C                           INTERDEPENDENCIES
  17 C 2003-11-04  D. KEYSER  -- SPLIT NON-ZERO RETURN INTO -1 FOR LENGTH
  18 C                           NOT 1-8 CHARACTERS AND -2 FOR INVALID
  19 C                           CHARACTERS (RETURN ONLY -1 BEFORE FOR ALL
  20 C                           PROBLEMATIC CASES); UNIFIED/PORTABLE FOR
  21 C                           WRF; ADDED HISTORY DOCUMENTATION
  22 C
  23 C USAGE:    NEMOCK (NEMO)
  24 C   INPUT ARGUMENT LIST:
  25 C     NEMO     - CHARACTER*(*): MNEMONIC TO BE CHECKED
  26 C
  27 C   OUTPUT ARGUMENT LIST:
  28 C     NEMOCK   - INTEGER: INDICATOR AS TO WHETHER NEMO IS VALID:
  29 C                       0 = yes
  30 C                      -1 = no, length not between 1 and 8 characters
  31 C                      -2 = no, it does not contain characters from the
  32 C                           allowable character set
  33 C
  34 C REMARKS:
  35 C    THIS ROUTINE CALLS:        None
  36 C    THIS ROUTINE IS CALLED BY: RDUSDX   SEQSDX   SNTBBE   SNTBDE
  37 C                               Normally not called by any application
  38 C                               programs.
  39 C
  40 C ATTRIBUTES:
  41 C   LANGUAGE: FORTRAN 77
  42 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  43 C
  44 C$$$
  45
  46       CHARACTER*(*) NEMO
  47       CHARACTER*38  CHRSET
  48
  49       DATA CHRSET /'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_.'/
  50       DATA NCHR   /38/
  51
  52 C-----------------------------------------------------------------------
  53 C-----------------------------------------------------------------------
  54
  55 C  GET THE LENGTH OF NEMO
  56 C  ----------------------
  57
  58       LNEMO = 0
  59
  60       DO I=LEN(NEMO),1,-1
  61       IF(NEMO(I:I).NE.' ') THEN
  62          LNEMO = I
  63          GOTO 1
  64       ENDIF
  65       ENDDO
  66
  67 1     IF(LNEMO.LT.1 .OR. LNEMO.GT.8) THEN
  68          NEMOCK = -1
  69          GOTO 100
  70       ENDIF
  71
  72 C  SCAN NEMO FOR ALLOWABLE CHARACTERS
  73 C  ----------------------------------
  74
  75       DO 10 I=1,LNEMO
  76       DO J=1,NCHR
  77       IF(NEMO(I:I).EQ.CHRSET(J:J)) GOTO 10
  78       ENDDO
  79       NEMOCK = -2
  80       GOTO 100
  81 10    ENDDO
  82
  83       NEMOCK = 0
  84
  85 C  EXIT
  86 C  ----
  87
  88 100   RETURN
  89       END