SUBROUTINE NEMTBAX(LUN,NEMO,MTYP,MSBT,INOD) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C C SUBPROGRAM: NEMTBAX C PRGMMR: WOOLLEN ORG: NP20 DATE: 1999-11-18 C C ABSTRACT: THIS SUBROUTINE SEARCHES FOR MNEMONIC NEMO WITHIN THE C INTERNAL TABLE A ARRAYS HOLDING THE DICTIONARY TABLE (ARRAYS IN C COMMON BLOCK /TABABD/) AND, IF FOUND, RETURNS INFORMATION ABOUT C THAT MNEMONIC FROM WITHIN THESE ARRAYS. IT IS IDENTICAL TO BUFR C ARCHIVE LIBRARY SUBROUTINE NEMTBA EXCEPT THAT, IF NEMO IS NOT C FOUND, THIS SUBROUTINE RETURNS WITH INOD EQUAL TO ZERO, WHEREAS C NEMTBA CALLS BUFR ARCHIVE LIBRARY SUBROUTINE BORT IN SUCH CASES. C C PROGRAM HISTORY LOG: C 1999-11-18 J. WOOLLEN -- ORIGINAL AUTHOR C 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE C INTERDEPENDENCIES C 2003-11-04 D. KEYSER -- UNIFIED/PORTABLE FOR WRF; ADDED C DOCUMENTATION (INCLUDING HISTORY); OUTPUTS C MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE C TERMINATES ABNORMALLY C C USAGE: CALL NEMTBAX (LUN, NEMO, MTYP, MSBT, INOD) C INPUT ARGUMENT LIST: C LUN - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS C NEMO - CHARACTER*(*): TABLE A MNEMONIC TO SEARCH FOR C C OUTPUT ARGUMENT LIST: C MTYP - INTEGER: MESSAGE TYPE CORRESPONDING TO NEMO C MSBT - INTEGER: MESSAGE SUBTYPE CORRESPONDING TO NEMO C INOD - INTEGER: POSITIONAL INDEX OF NEMO WITHIN INTERNAL C JUMP/LINK TABLE IF NEMO FOUND C 0 = NEMO not found C C REMARKS: C THIS ROUTINE CALLS: BORT C THIS ROUTINE IS CALLED BY: CKTABA IOK2CPY NEMTBA STNDRD C Normally not called by any application C programs. C C ATTRIBUTES: C LANGUAGE: FORTRAN 77 C MACHINE: PORTABLE TO ALL PLATFORMS C C$$$ INCLUDE 'bufrlib.prm' COMMON /TABABD/ NTBA(0:NFILES),NTBB(0:NFILES),NTBD(0:NFILES), . MTAB(MAXTBA,NFILES),IDNA(MAXTBA,NFILES,2), . IDNB(MAXTBB,NFILES),IDND(MAXTBD,NFILES), . TABA(MAXTBA,NFILES),TABB(MAXTBB,NFILES), . TABD(MAXTBD,NFILES) CHARACTER*(*) NEMO CHARACTER*600 TABD CHARACTER*128 BORT_STR CHARACTER*128 TABB CHARACTER*128 TABA C----------------------------------------------------------------------- C----------------------------------------------------------------------- INOD = 0 C LOOK FOR NEMO IN TABLE A C ------------------------ DO I=1,NTBA(LUN) IF(TABA(I,LUN)(4:11).EQ.NEMO) THEN MTYP = IDNA(I,LUN,1) MSBT = IDNA(I,LUN,2) INOD = MTAB(I,LUN) IF(MTYP.LT.0 .OR. MTYP.GT.255) GOTO 900 IF(MSBT.LT.0 .OR. MSBT.GT.255) GOTO 901 GOTO 100 ENDIF ENDDO C EXITS C ----- 100 RETURN 900 WRITE(BORT_STR,'("BUFRLIB: NEMTBAX - INVALID MESSAGE TYPE (",I4'// . ',") RETURNED FOR MENMONIC ",A)') MTYP,NEMO CALL BORT(BORT_STR) 901 WRITE(BORT_STR,'("BUFRLIB: NEMTBAX - INVALID MESSAGE SUBTYPE ("'// . ',I4,") RETURNED FOR MENMONIC ",A)') MSBT,NEMO CALL BORT(BORT_STR) END