SUBROUTINE TABENT(LUN,NEMO,TAB,ITAB,IREP,IKNT,JUM0) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C C SUBPROGRAM: TABENT C PRGMMR: WOOLLEN ORG: NP20 DATE: 1994-01-06 C C ABSTRACT: THIS SUBROUTINE BUILDS AND STORES AN ENTRY FOR A TABLE B OR C TABLE D MNEMONIC (NEMO) WITHIN THE INTERNAL JUMP/LINK TABLE. C C PROGRAM HISTORY LOG: C 1994-01-06 J. WOOLLEN -- ORIGINAL AUTHOR C 1998-07-08 J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE C "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB C ROUTINE "BORT"; CORRECTED SOME MINOR ERRORS 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 -- MAXJL (MAXIMUM NUMBER OF JUMP/LINK ENTRIES) C INCREASED FROM 15000 TO 16000 (WAS IN C VERIFICATION VERSION); UNIFIED/PORTABLE FOR C WRF; ADDED HISTORY DOCUMENTATION; OUTPUTS C MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE C TERMINATES ABNORMALLY C 2005-11-29 J. ATOR -- ADDED SUPPORT FOR 207 AND 208 OPERATORS C 2010-03-19 J. ATOR -- ADDED SUPPORT FOR 204 OPERATOR C 2012-03-02 J. ATOR -- ADDED SUPPORT FOR 203 OPERATOR C C USAGE: CALL TABENT (LUN, NEMO, TAB, ITAB, IREP, IKNT, JUM0) C INPUT ARGUMENT LIST: C LUN - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS C NEMO - CHARACTER*8: TABLE B OR D MNEMONIC TO STORE IN JUMP/ C LINK TABLE C TAB - CHARACTER*1: INTERNAL BUFR TABLE ARRAY ('B' OR 'D') IN C WHICH NEMO IS DEFINED C ITAB - INTEGER: POSITIONAL INDEX OF NEMO WITHIN TAB C IREP - INTEGER: POSITIONAL INDEX WITHIN COMMON /REPTAB/ C ARRAYS, FOR USE WHEN NEMO IS REPLICATED: C 0 = NEMO is not replicated C IKNT - INTEGER: NUMBER OF REPLICATIONS, FOR USE WHEN NEMO IS C REPLICATED USING F=1 REGULAR (I.E., NON-DELAYED) C REPLICATION: C 0 = NEMO is not replicated using F=1 regular C (i.e., non-delayed) replication C JUM0 - INTEGER: INDEX VALUE TO BE STORED FOR NEMO WITHIN C INTERNAL JUMP/LINK TABLE ARRAY JMPB(*) C C REMARKS: C THIS ROUTINE CALLS: BORT INCTAB NEMTBB C THIS ROUTINE IS CALLED BY: 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' C Note that the values within the COMMON /REPTAB/ arrays were C initialized within subroutine BFRINI. COMMON /REPTAB/ IDNR(5,2),TYPS(5,2),REPS(5,2),LENS(5) COMMON /BTABLES/ MAXTAB,NTAB,TAG(MAXJL),TYP(MAXJL),KNT(MAXJL), . JUMP(MAXJL),LINK(MAXJL),JMPB(MAXJL), . IBT(MAXJL),IRF(MAXJL),ISC(MAXJL), . ITP(MAXJL),VALI(MAXJL),KNTI(MAXJL), . ISEQ(MAXJL,2),JSEQ(MAXJL) COMMON /TABCCC/ ICDW,ICSC,ICRV,INCW COMMON /NRV203/ NNRV,INODNRV(MXNRV),NRV(MXNRV),TAGNRV(MXNRV), . ISNRV(MXNRV),IENRV(MXNRV),IBTNRV,IPFNRV CHARACTER*128 BORT_STR CHARACTER*24 UNIT CHARACTER*10 TAG,RTAG CHARACTER*8 NEMO,TAGNRV CHARACTER*3 TYP,TYPS,TYPT CHARACTER*1 REPS,TAB C----------------------------------------------------------------------- C----------------------------------------------------------------------- C MAKE A JUMP/LINK TABLE ENTRY FOR A REPLICATOR C --------------------------------------------- IF(IREP.NE.0) THEN RTAG = REPS(IREP,1)//NEMO DO I=1,10 IF(RTAG(I:I).EQ.' ') THEN RTAG(I:I) = REPS(IREP,2) CALL INCTAB(RTAG,TYPS(IREP,1),NODE) JUMP(NODE) = NODE+1 JMPB(NODE) = JUM0 LINK(NODE) = 0 IBT (NODE) = LENS(IREP) IRF (NODE) = 0 ISC (NODE) = 0 IF(IREP.EQ.1) IRF(NODE) = IKNT JUM0 = NODE GOTO 1 ENDIF ENDDO GOTO 900 ENDIF C MAKE AN JUMP/LINK ENTRY FOR AN ELEMENT OR A SEQUENCE C ---------------------------------------------------- 1 IF(TAB.EQ.'B') THEN CALL NEMTBB(LUN,ITAB,UNIT,ISCL,IREF,IBIT) IF(UNIT(1:5).EQ.'CCITT') THEN TYPT = 'CHR' ELSE TYPT = 'NUM' ENDIF CALL INCTAB(NEMO,TYPT,NODE) JUMP(NODE) = 0 JMPB(NODE) = JUM0 LINK(NODE) = 0 IBT (NODE) = IBIT IRF (NODE) = IREF ISC (NODE) = ISCL IF(UNIT(1:4).EQ.'CODE') THEN TYPT = 'COD' ELSEIF(UNIT(1:4).EQ.'FLAG') THEN TYPT = 'FLG' ENDIF IF( (TYPT.EQ.'NUM') .AND. (IBTNRV.NE.0) ) THEN C This node contains a new (redefined) reference value. IF(NNRV+1.GT.MXNRV) GOTO 902 NNRV = NNRV+1 TAGNRV(NNRV) = NEMO INODNRV(NNRV) = NODE ISNRV(NNRV) = NODE+1 IBT(NODE) = IBTNRV IF(IPFNRV.EQ.0) IPFNRV = NNRV ELSEIF( (TYPT.EQ.'NUM') .AND. (NEMO(1:3).NE.'204') ) THEN IBT(NODE) = IBT(NODE) + ICDW ISC(NODE) = ISC(NODE) + ICSC IRF(NODE) = IRF(NODE) * ICRV ELSEIF( (TYPT.EQ.'CHR') .AND. (INCW.GT.0) ) THEN IBT(NODE) = INCW * 8 ENDIF ELSEIF(TAB.EQ.'D') THEN IF(IREP.EQ.0) THEN TYPT = 'SEQ' ELSE TYPT = TYPS(IREP,2) ENDIF CALL INCTAB(NEMO,TYPT,NODE) JUMP(NODE) = NODE+1 JMPB(NODE) = JUM0 LINK(NODE) = 0 IBT (NODE) = 0 IRF (NODE) = 0 ISC (NODE) = 0 ELSE GOTO 901 ENDIF C EXITS C ----- RETURN 900 WRITE(BORT_STR,'("BUFRLIB: TABENT - REPLICATOR ERROR FOR INPUT '// . 'MNEMONIC ",A,", RTAG IS ",A)') NEMO,RTAG CALL BORT(BORT_STR) 901 WRITE(BORT_STR,'("BUFRLIB: TABENT - UNDEFINED TAG (",A,") FOR '// . 'INPUT MNEMONIC ",A)') TAB,NEMO CALL BORT(BORT_STR) 902 CALL BORT('BUFRLIB: TABENT - MXNRV OVERFLOW') END