var/external/bufr/nemtbax.f

   1       SUBROUTINE NEMTBAX(LUN,NEMO,MTYP,MSBT,INOD)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    NEMTBAX
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1999-11-18
   7 C
   8 C ABSTRACT: THIS SUBROUTINE SEARCHES FOR MNEMONIC NEMO WITHIN THE
   9 C   INTERNAL TABLE A ARRAYS HOLDING THE DICTIONARY TABLE (ARRAYS IN
  10 C   COMMON BLOCK /TABABD/) AND, IF FOUND, RETURNS INFORMATION ABOUT
  11 C   THAT MNEMONIC FROM WITHIN THESE ARRAYS.  IT IS IDENTICAL TO BUFR
  12 C   ARCHIVE LIBRARY SUBROUTINE NEMTBA EXCEPT THAT, IF NEMO IS NOT
  13 C   FOUND, THIS SUBROUTINE RETURNS WITH INOD EQUAL TO ZERO, WHEREAS
  14 C   NEMTBA CALLS BUFR ARCHIVE LIBRARY SUBROUTINE BORT IN SUCH CASES.
  15 C
  16 C PROGRAM HISTORY LOG:
  17 C 1999-11-18  J. WOOLLEN -- ORIGINAL AUTHOR
  18 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  19 C                           INTERDEPENDENCIES
  20 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED
  21 C                           DOCUMENTATION (INCLUDING HISTORY); OUTPUTS
  22 C                           MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
  23 C                           TERMINATES ABNORMALLY
  24 C
  25 C USAGE:    CALL NEMTBAX (LUN, NEMO, MTYP, MSBT, INOD)
  26 C   INPUT ARGUMENT LIST:
  27 C     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
  28 C     NEMO     - CHARACTER*(*): TABLE A MNEMONIC TO SEARCH FOR
  29 C
  30 C   OUTPUT ARGUMENT LIST:
  31 C     MTYP     - INTEGER: MESSAGE TYPE CORRESPONDING TO NEMO
  32 C     MSBT     - INTEGER: MESSAGE SUBTYPE CORRESPONDING TO NEMO
  33 C     INOD     - INTEGER: POSITIONAL INDEX OF NEMO WITHIN INTERNAL
  34 C                         JUMP/LINK TABLE IF NEMO FOUND
  35 C                       0 = NEMO not found
  36 C
  37 C REMARKS:
  38 C    THIS ROUTINE CALLS:        BORT
  39 C    THIS ROUTINE IS CALLED BY: CKTABA   IOK2CPY  NEMTBA   STNDRD
  40 C                               Normally not called by any application
  41 C                               programs.
  42 C
  43 C ATTRIBUTES:
  44 C   LANGUAGE: FORTRAN 77
  45 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  46 C
  47 C$$$
  48
  49       INCLUDE 'bufrlib.prm'
  50
  51       COMMON /TABABD/ NTBA(0:NFILES),NTBB(0:NFILES),NTBD(0:NFILES),
  52      .                MTAB(MAXTBA,NFILES),IDNA(MAXTBA,NFILES,2),
  53      .                IDNB(MAXTBB,NFILES),IDND(MAXTBD,NFILES),
  54      .                TABA(MAXTBA,NFILES),TABB(MAXTBB,NFILES),
  55      .                TABD(MAXTBD,NFILES)
  56
  57       CHARACTER*(*) NEMO
  58       CHARACTER*600 TABD
  59       CHARACTER*128 BORT_STR
  60       CHARACTER*128 TABB
  61       CHARACTER*128 TABA
  62
  63 C-----------------------------------------------------------------------
  64 C-----------------------------------------------------------------------
  65
  66       INOD = 0
  67
  68 C  LOOK FOR NEMO IN TABLE A
  69 C  ------------------------
  70
  71       DO I=1,NTBA(LUN)
  72       IF(TABA(I,LUN)(4:11).EQ.NEMO) THEN
  73          MTYP = IDNA(I,LUN,1)
  74          MSBT = IDNA(I,LUN,2)
  75          INOD = MTAB(I,LUN)
  76          IF(MTYP.LT.0 .OR. MTYP.GT.255) GOTO 900
  77          IF(MSBT.LT.0 .OR. MSBT.GT.255) GOTO 901
  78          GOTO 100
  79       ENDIF
  80       ENDDO
  81
  82 C  EXITS
  83 C  -----
  84
  85 100   RETURN
  86 900   WRITE(BORT_STR,'("BUFRLIB: NEMTBAX - INVALID MESSAGE TYPE (",I4'//
  87      . ',") RETURNED FOR MENMONIC ",A)') MTYP,NEMO
  88       CALL BORT(BORT_STR)
  89 901   WRITE(BORT_STR,'("BUFRLIB: NEMTBAX - INVALID MESSAGE SUBTYPE ("'//
  90      . ',I4,") RETURNED FOR MENMONIC ",A)') MSBT,NEMO
  91       CALL BORT(BORT_STR)
  92       END