NCEPLIBS-bufr  11.6.0
 All Data Structures Files Functions Variables Pages
tabent.f
Go to the documentation of this file.
1 C> @file
2 C> @author WOOLLEN @date 1994-01-06
3 
4 C> THIS SUBROUTINE BUILDS AND STORES AN ENTRY FOR A TABLE B OR
5 C> TABLE D MNEMONIC (NEMO) WITHIN THE INTERNAL JUMP/LINK TABLE.
6 C>
7 C> PROGRAM HISTORY LOG:
8 C> 1994-01-06 J. WOOLLEN -- ORIGINAL AUTHOR
9 C> 1998-07-08 J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
10 C> "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
11 C> ROUTINE "BORT"; CORRECTED SOME MINOR ERRORS
12 C> 2003-11-04 J. ATOR -- ADDED DOCUMENTATION
13 C> 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE
14 C> INTERDEPENDENCIES
15 C> 2003-11-04 D. KEYSER -- MAXJL (MAXIMUM NUMBER OF JUMP/LINK ENTRIES)
16 C> INCREASED FROM 15000 TO 16000 (WAS IN
17 C> VERIFICATION VERSION); UNIFIED/PORTABLE FOR
18 C> WRF; ADDED HISTORY DOCUMENTATION; OUTPUTS
19 C> MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
20 C> TERMINATES ABNORMALLY
21 C> 2005-11-29 J. ATOR -- ADDED SUPPORT FOR 207 AND 208 OPERATORS
22 C> 2010-03-19 J. ATOR -- ADDED SUPPORT FOR 204 OPERATOR
23 C> 2012-03-02 J. ATOR -- ADDED SUPPORT FOR 203 OPERATOR
24 C> 2014-12-10 J. ATOR -- USE MODULES INSTEAD OF COMMON BLOCKS
25 C>
26 C> USAGE: CALL TABENT (LUN, NEMO, TAB, ITAB, IREP, IKNT, JUM0)
27 C> INPUT ARGUMENT LIST:
28 C> LUN - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
29 C> NEMO - CHARACTER*8: TABLE B OR D MNEMONIC TO STORE IN JUMP/
30 C> LINK TABLE
31 C> TAB - CHARACTER*1: INTERNAL BUFR TABLE ARRAY ('B' OR 'D') IN
32 C> WHICH NEMO IS DEFINED
33 C> ITAB - INTEGER: POSITIONAL INDEX OF NEMO WITHIN TAB
34 C> IREP - INTEGER: POSITIONAL INDEX WITHIN COMMON /REPTAB/
35 C> ARRAYS, FOR USE WHEN NEMO IS REPLICATED:
36 C> 0 = NEMO is not replicated
37 C> IKNT - INTEGER: NUMBER OF REPLICATIONS, FOR USE WHEN NEMO IS
38 C> REPLICATED USING F=1 REGULAR (I.E., NON-DELAYED)
39 C> REPLICATION:
40 C> 0 = NEMO is not replicated using F=1 regular
41 C> (i.e., non-delayed) replication
42 C> JUM0 - INTEGER: INDEX VALUE TO BE STORED FOR NEMO WITHIN
43 C> INTERNAL JUMP/LINK TABLE ARRAY JMPB(*)
44 C>
45 C> REMARKS:
46 C> THIS ROUTINE CALLS: BORT INCTAB NEMTBB
47 C> THIS ROUTINE IS CALLED BY: TABSUB
48 C> Normally not called by any application
49 C> programs.
50 C>
51  SUBROUTINE tabent(LUN,NEMO,TAB,ITAB,IREP,IKNT,JUM0)
52 
53  USE moda_tables
54  USE moda_nrv203
55 
56 C Note that the values within the COMMON /REPTAB/ arrays were
57 C initialized within subroutine BFRINI.
58 
59  COMMON /reptab/ idnr(5,2),typs(5,2),reps(5,2),lens(5)
60 
61  COMMON /tabccc/ icdw,icsc,icrv,incw
62 
63  CHARACTER*128 bort_str
64  CHARACTER*24 unit
65  CHARACTER*10 rtag
66  CHARACTER*8 nemo
67  CHARACTER*3 typs,typt
68  CHARACTER*1 reps,tab
69 
70 C-----------------------------------------------------------------------
71 C-----------------------------------------------------------------------
72 
73 C MAKE A JUMP/LINK TABLE ENTRY FOR A REPLICATOR
74 C ---------------------------------------------
75 
76  IF(irep.NE.0) THEN
77  rtag = reps(irep,1)//nemo
78  DO i=1,10
79  IF(rtag(i:i).EQ.' ') THEN
80  rtag(i:i) = reps(irep,2)
81  CALL inctab(rtag,typs(irep,1),node)
82  jump(node) = node+1
83  jmpb(node) = jum0
84  link(node) = 0
85  ibt(node) = lens(irep)
86  irf(node) = 0
87  isc(node) = 0
88  IF(irep.EQ.1) irf(node) = iknt
89  jum0 = node
90  goto 1
91  ENDIF
92  ENDDO
93  goto 900
94  ENDIF
95 
96 C MAKE AN JUMP/LINK ENTRY FOR AN ELEMENT OR A SEQUENCE
97 C ----------------------------------------------------
98 
99 1 IF(tab.EQ.'B') THEN
100 
101  CALL nemtbb(lun,itab,unit,iscl,iref,ibit)
102  IF(unit(1:5).EQ.'CCITT') THEN
103  typt = 'CHR'
104  ELSE
105  typt = 'NUM'
106  ENDIF
107  CALL inctab(nemo,typt,node)
108  jump(node) = 0
109  jmpb(node) = jum0
110  link(node) = 0
111  ibt(node) = ibit
112  irf(node) = iref
113  isc(node) = iscl
114  IF(unit(1:4).EQ.'CODE') THEN
115  typt = 'COD'
116  ELSEIF(unit(1:4).EQ.'FLAG') THEN
117  typt = 'FLG'
118  ENDIF
119 
120  IF( (typt.EQ.'NUM') .AND. (ibtnrv.NE.0) ) THEN
121 
122 C This node contains a new (redefined) reference value.
123 
124  IF(nnrv+1.GT.mxnrv) goto 902
125  nnrv = nnrv+1
126  tagnrv(nnrv) = nemo
127  inodnrv(nnrv) = node
128  isnrv(nnrv) = node+1
129  ibt(node) = ibtnrv
130  IF(ipfnrv.EQ.0) ipfnrv = nnrv
131  ELSEIF( (typt.EQ.'NUM') .AND. (nemo(1:3).NE.'204') ) THEN
132  ibt(node) = ibt(node) + icdw
133  isc(node) = isc(node) + icsc
134  irf(node) = irf(node) * icrv
135  ELSEIF( (typt.EQ.'CHR') .AND. (incw.GT.0) ) THEN
136  ibt(node) = incw * 8
137  ENDIF
138 
139  ELSEIF(tab.EQ.'D') THEN
140 
141  IF(irep.EQ.0) THEN
142  typt = 'SEQ'
143  ELSE
144  typt = typs(irep,2)
145  ENDIF
146  CALL inctab(nemo,typt,node)
147  jump(node) = node+1
148  jmpb(node) = jum0
149  link(node) = 0
150  ibt(node) = 0
151  irf(node) = 0
152  isc(node) = 0
153 
154  ELSE
155 
156  goto 901
157 
158  ENDIF
159 
160 C EXITS
161 C -----
162 
163  RETURN
164 900 WRITE(bort_str,'("BUFRLIB: TABENT - REPLICATOR ERROR FOR INPUT '//
165  . 'MNEMONIC ",A,", RTAG IS ",A)') nemo,rtag
166  CALL bort(bort_str)
167 901 WRITE(bort_str,'("BUFRLIB: TABENT - UNDEFINED TAG (",A,") FOR '//
168  . 'INPUT MNEMONIC ",A)') tab,nemo
169  CALL bort(bort_str)
170 902 CALL bort('BUFRLIB: TABENT - MXNRV OVERFLOW')
171  END
This module contains array and variable declarations for use with any 2-03-YYY (change reference valu...
Definition: moda_nrv203.F:15
subroutine tabent(LUN, NEMO, TAB, ITAB, IREP, IKNT, JUM0)
THIS SUBROUTINE BUILDS AND STORES AN ENTRY FOR A TABLE B OR TABLE D MNEMONIC (NEMO) WITHIN THE INTERN...
Definition: tabent.f:51
subroutine inctab(ATAG, ATYP, NODE)
THIS SUBROUTINE RETURNS THE NEXT AVAILABLE POSITIONAL INDEX FOR WRITING INTO THE INTERNAL JUMP/LINK T...
Definition: inctab.f:43
subroutine nemtbb(LUN, ITAB, UNIT, ISCL, IREF, IBIT)
This subroutine returns information about a Table B descriptor from the internal DX BUFR tables...
Definition: nemtbb.f:31
This module contains array and variable declarations used to store the internal jump/link table...
Definition: moda_tables.F:13
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:22