SUBROUTINE NEMTBD(LUN,ITAB,NSEQ,NEMS,IRPS,KNTS) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C C SUBPROGRAM: NEMTBD C PRGMMR: WOOLLEN ORG: NP20 DATE: 1994-01-06 C C ABSTRACT: THIS SUBROUTINE RETURNS A LIST OF THE MNEMONICS (I.E., C "CHILD" MNEMONICS) CONTAINED WITHIN A TABLE D SEQUENCE MNEMONIC C (I.E., A "PARENT MNEMONIC"). THIS INFORMATION SHOULD HAVE BEEN C PACKED INTO THE INTERNAL BUFR TABLE D ENTRY FOR THE PARENT MNEMONIC C (IN COMMON BLOCK /TABABD/) VIA PREVIOUS CALLS TO BUFR ARCHIVE C LIBRARY SUBROUTINE PKTDD. NOTE THAT NEMTBD DOES NOT RECURSIVELY C RESOLVE CHILD MNEMONICS WHICH ARE THEMSELVES TABLE D SEQUENCE C MNEMONICS; RATHER, SUCH RESOLUTION MUST BE DONE VIA SEPARATE C SUBSEQUENT CALLS TO THIS SUBROUTINE. C C PROGRAM HISTORY LOG: C 1994-01-06 J. WOOLLEN -- ORIGINAL AUTHOR C 1995-06-28 J. WOOLLEN -- INCREASED THE SIZE OF INTERNAL BUFR TABLE C ARRAYS IN ORDER TO HANDLE BIGGER FILES C 1998-07-08 J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE C "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB C ROUTINE "BORT" C 1999-11-18 J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE C OPENED AT ONE TIME INCREASED FROM 10 TO 32 C (NECESSARY IN ORDER TO PROCESS MULTIPLE C BUFR FILES UNDER THE MPI) C 2000-09-19 J. WOOLLEN -- MUST NOW CHECK FOR TABLE C (OPERATOR C DESCRIPTOR) MNEMONICS SINCE THE CAPABILITY C HAS NOW BEEN ADDED TO ENCODE AND DECODE C THESE 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 -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY C DOCUMENTATION; OUTPUTS MORE COMPLETE C DIAGNOSTIC INFO WHEN ROUTINE TERMINATES C ABNORMALLY C C USAGE: CALL NEMTBD (LUN, ITAB, NSEQ, NEMS, IRPS, KNTS) C INPUT ARGUMENT LIST: C LUN - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS C ITAB - INTEGER: POSITIONAL INDEX OF PARENT MNEMONIC WITHIN C INTERNAL BUFR TABLE D ARRAY TABD(*,*) C C OUTPUT ARGUMENT LIST: C NSEQ - INTEGER: TOTAL NUMBER OF CHILD MNEMONICS FOR THE C PARENT MNEMONIC GIVEN BY TABD(ITAB,LUN) C NEMS - CHARACTER*8: (NSEQ)-WORD ARRAY OF CHILD MNEMONICS C IRPS - INTEGER: (NSEQ)-WORD RETURN VALUE ARRAY (SEE REMARKS) C KNTS - INTEGER: (NSEQ)-WORD RETURN VALUE ARRAY (SEE REMARKS) C C REMARKS: C VALUE FOR OUTPUT ARGUMENT IRPS: C The interpretation of the return value IRPS(I) depends upon the C type of descriptor corresponding to NEMS(I), as follows: C C IF ( NEMS(I) corresponds to an F=1 regular (i.e. non-delayed) C replication descriptor ) THEN C IRPS(I) = 1 C ELSE IF ( NEMS(I) corresponds to a delayed replicator or C replication factor descriptor ) THEN C IRPS(I) = positional index of corresponding descriptor C within internal replication array IDNR(*,*) C ELSE C IRPS(I) = 0 C END IF C C C VALUE FOR OUTPUT ARGUMENT KNTS: C The interpretation of the return value KNTS(I) depends upon the C type of descriptor corresponding to NEMS(I), as follows: C C IF ( NEMS(I) corresponds to an F=1 regular (i.e. non-delayed) C replication descriptor ) THEN C KNTS(I) = number of replications C ELSE C KNTS(I) = 0 C END IF C C C THIS ROUTINE CALLS: ADN30 BORT IFXY NUMTAB C RSVFVM UPTDD C THIS ROUTINE IS CALLED BY: CHEKSTAB DXDUMP GETABDB TABSUB 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*600 TABD CHARACTER*128 TABB CHARACTER*128 TABA CHARACTER*128 BORT_STR CHARACTER*8 NEMO,NEMS,NEMT,NEMF CHARACTER*6 ADN30,CLEMON CHARACTER*1 TAB DIMENSION NEMS(MAXCD),IRPS(MAXCD),KNTS(MAXCD) LOGICAL REP C----------------------------------------------------------------------- C----------------------------------------------------------------------- IF(ITAB.LE.0 .OR. ITAB.GT.NTBD(LUN)) GOTO 900 REP = .FALSE. C CLEAR THE RETURN VALUES C ----------------------- NSEQ = 0 DO I=1,MAXCD NEMS(I) = ' ' IRPS(I) = 0 KNTS(I) = 0 ENDDO C PARSE THE TABLE D ENTRY C ----------------------- NEMO = TABD(ITAB,LUN)(7:14) IDSC = IDND(ITAB,LUN) CALL UPTDD(ITAB,LUN,0,NDSC) IF(IDSC.LT.IFXY('300000')) GOTO 901 IF(IDSC.GT.IFXY('363255')) GOTO 901 cccc IF(NDSC.LE.0 ) GOTO 902 C Loop through each child mnemonic. c .... DK: What happens here if NDSC=0 ? DO J=1,NDSC IF(NSEQ+1.GT.MAXCD) GOTO 903 CALL UPTDD(ITAB,LUN,J,IDSC) c .... get NEMT from IDSC CALL NUMTAB(LUN,IDSC,NEMT,TAB,IRET) IF(TAB.EQ.'R') THEN IF(REP) GOTO 904 REP = .TRUE. IF(IRET.LT.0) THEN C F=1 regular (i.e. non-delayed) replication. IRPS(NSEQ+1) = 1 KNTS(NSEQ+1) = ABS(IRET) ELSEIF(IRET.GT.0) THEN C Delayed replication. IRPS(NSEQ+1) = IRET ENDIF ELSEIF(TAB.EQ.'F') THEN C Replication factor. IF(.NOT.REP) GOTO 904 IRPS(NSEQ+1) = IRET REP = .FALSE. ELSEIF(TAB.EQ.'D'.OR.TAB.EQ.'C') THEN REP = .FALSE. NSEQ = NSEQ+1 NEMS(NSEQ) = NEMT ELSEIF(TAB.EQ.'B') THEN REP = .FALSE. NSEQ = NSEQ+1 IF(NEMT(1:1).EQ.'.') THEN C This is a "following value" mnemonic. CALL UPTDD(ITAB,LUN,J+1,IDSC) c .... get NEMF from IDSC CALL NUMTAB(LUN,IDSC,NEMF,TAB,IRET) CALL RSVFVM(NEMT,NEMF) IF(TAB.NE.'B') GOTO 906 ENDIF NEMS(NSEQ) = NEMT ELSE GOTO 905 ENDIF ENDDO C EXITS C ----- RETURN 900 WRITE(BORT_STR,'("BUFRLIB: NEMTBD - ITAB (",I7,") NOT FOUND IN '// . 'TABLE D")') ITAB CALL BORT(BORT_STR) 901 WRITE(BORT_STR,'("BUFRLIB: NEMTBD - INTEGER REPRESENTATION OF '// . 'DESCRIPTOR FOR TABLE D MNEMONIC ",A," (",I7,") IS OUTSIDE '// . 'RANGE 0-65535 (65535 -> 3-63-255)")') NEMO,IDSC CALL BORT(BORT_STR) 902 WRITE(BORT_STR,'("BUFRLIB: NEMTBD - TABLE D MNEMONIC ",A," IS A'// . ' ZERO LENGTH SEQUENCE")') NEMO CALL BORT(BORT_STR) 903 WRITE(BORT_STR,'("BUFRLIB: NEMTBD - THERE ARE MORE THAN '// . '(",I4,") DESCRIPTORS (THE LIMIT) IN TABLE D SEQUENCE '// . 'MNEMONIC ",A)') MAXCD, NEMO CALL BORT(BORT_STR) 904 WRITE(BORT_STR,'("BUFRLIB: NEMTBD - REPLICATOR IS OUT OF ORDER '// . 'IN TABLE D SEQUENCE MNEMONIC ",A)') NEMO CALL BORT(BORT_STR) 905 CLEMON = ADN30(IDSC,6) WRITE(BORT_STR,'("BUFRLIB: NEMTBD - UNRECOGNIZED DESCRIPTOR '// . '",A," IN TABLE D SEQUENCE MNEMONIC ",A)') CLEMON,NEMO CALL BORT(BORT_STR) 906 WRITE(BORT_STR,'("BUFRLIB: NEMTBD - A ''FOLLOWING VALUE'' '// . 'MNEMONIC (",A,") IS FROM TABLE ",A,", IT MUST BE FROM TABLE B'// . '")') NEMF,TAB CALL BORT(BORT_STR) END