NCEPLIBS-bufr  11.6.0
 All Data Structures Files Functions Variables Pages
rdmtbf.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Read master Code/Flag table information from local file system
3 
4 C> This subroutine reads master Code/Flag table information from two
5 C> separate ASCII files (one standard and one local) and then merges the
6 C> output into a single set of arrays.
7 C>
8 C> <p>Each of the two ASCII files must already be individually sorted
9 C> in ascending order with respect to the FXY numbers.
10 C>
11 C> @author J. Ator
12 C> @date 2017-10-17
13 C>
14 C> @param[in] LUNSTF -- integer: Fortran logical unit number for
15 C> ASCII file containing standard Code/Flag table
16 C> information
17 C> @param[in] LUNLTF -- integer: Fortran logical unit number for
18 C> ASCII file containing local Code/Flag table
19 C> information
20 C>
21 C> <b>Program history log:</b>
22 C> | Date | Programmer | Comments |
23 C> | -----|------------|----------|
24 C> | 2017-10-17 | J. Ator | Original author |
25 C>
26  SUBROUTINE rdmtbf ( LUNSTF, LUNLTF )
27 
28  character*160 stline, ltline
29  character*128 bort_str
30  character*6 cmatch, adn30
31 
32 C-----------------------------------------------------------------------
33 C-----------------------------------------------------------------------
34 
35 C Call WRDLEN to initialize some important information about the
36 C local machine, just in case it hasn't already been called.
37 
38  CALL wrdlen
39 
40 C Initialize the internal memory structure, including allocating
41 C space for it in case this hasn't already been done.
42 
43  CALL inittbf
44 
45 C Read and parse the header lines of both files.
46 
47  CALL gettbh( lunstf, lunltf, 'F', imt, imtv, iogce, iltv )
48 
49 C Read through the remainder of both files, merging the
50 C contents into a unified internal memory structure.
51 
52  CALL getntbe( lunstf, isfxyn, stline, iers )
53  CALL getntbe( lunltf, ilfxyn, ltline, ierl )
54  DO WHILE ( ( iers .EQ. 0 ) .OR. ( ierl .EQ. 0 ) )
55  IF ( ( iers .EQ. 0 ) .AND. ( ierl .EQ. 0 ) ) THEN
56  IF ( isfxyn .EQ. ilfxyn ) THEN
57  cmatch = adn30( isfxyn, 6 )
58  goto 900
59  ELSE IF ( isfxyn .LT. ilfxyn ) THEN
60  CALL sntbfe( lunstf, isfxyn, stline )
61  CALL getntbe( lunstf, isfxyn, stline, iers )
62  ELSE
63  CALL sntbfe( lunltf, ilfxyn, ltline )
64  CALL getntbe( lunltf, ilfxyn, ltline, ierl )
65  ENDIF
66  ELSE IF ( iers .EQ. 0 ) THEN
67  CALL sntbfe( lunstf, isfxyn, stline )
68  CALL getntbe( lunstf, isfxyn, stline, iers )
69  ELSE IF ( ierl .EQ. 0 ) THEN
70  CALL sntbfe( lunltf, ilfxyn, ltline )
71  CALL getntbe( lunltf, ilfxyn, ltline, ierl )
72  ENDIF
73  ENDDO
74 
75 C Sort the contents of the internal memory structure.
76 
77  CALL sorttbf
78 
79  RETURN
80  900 WRITE(bort_str,'("BUFRLIB: RDMTBF - STANDARD AND LOCAL'//
81  . ' CODE/FLAG TABLE FILES BOTH CONTAIN SAME FXY NUMBER: ",5A)')
82  . cmatch(1:1), '-', cmatch(2:3), '-', cmatch(4:6)
83  CALL bort(bort_str)
84  END
void sorttbf(void)
This subroutine sorts the entries within the internal memory structure for storage of master Code/Fla...
Definition: sorttbf.c:20
void inittbf(void)
This subroutine initializes the internal memory structure for storage of master Code/Flag table entri...
Definition: inittbf.c:22
subroutine rdmtbf(LUNSTF, LUNLTF)
This subroutine reads master Code/Flag table information from two separate ASCII files (one standard ...
Definition: rdmtbf.f:26
subroutine gettbh(LUNS, LUNL, TAB, IMT, IMTV, IOGCE, ILTV)
This subroutine reads the header lines from two separate ASCII files (one standard and one local) con...
Definition: gettbh.f:40
character *(*) function adn30(IDN, L30)
This function converts an FXY value from its bit-wise (integer) representation to its 5 or 6 characte...
Definition: adn30.f:28
subroutine wrdlen
This subroutine figures out some important information about the local machine on which the BUFRLIB s...
Definition: wrdlen.F:35
subroutine sntbfe(LUNT, IFXYN, LINE)
This subroutine stores the first line of an entry that was previously read from an ASCII master Code/...
Definition: sntbfe.f:25
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:22
subroutine getntbe(LUNT, IFXYN, LINE, IRET)
This subroutine reads the first line of the next entry from the specified ASCII master table B...
Definition: getntbe.f:30