NCEPLIBS-bufr  11.6.0
 All Data Structures Files Functions Variables Pages
sntbbe.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Store a master Table B entry into Fortran arrays
3 
4 C> This subroutine stores an entry that was previously read from an
5 C> ASCII master Table B file into a set of merged Fortran arrays.
6 C>
7 C> @author J. Ator
8 C> @date 2007-01-19
9 C>
10 C> @param[in] IFXYN -- integer: Bit-wise representation of FXY number
11 C> @param[in] LINE -- character*(*): Table B entry
12 C> @param[in] MXMTBB -- integer: Dimensioned size (in integers) of
13 C> merged output arrays; used by the subroutine
14 C> to ensure that it doesn't overflow these
15 C> arrays
16 C> @param[out] NMTBB -- integer: Number of entries in merged output
17 C> arrays
18 C> @param[out] IMFXYN-- integer(*): Merged array containing bit-wise
19 C> representations of FXY numbers
20 C> @param[out] CMSCL -- character*4(*): Merged array containing
21 C> scale factors
22 C> @param[out] CMSREF -- character*12(*): Merged array containing
23 C> reference values
24 C> @param[out] CMBW -- character*4(*): Merged array containing
25 C> bit widths
26 C> @param[out] CMUNIT -- character*24(*): Merged array containing units
27 C> @param[out] CMMNEM -- character*8(*): Merged array containing
28 C> mnemonics
29 C> @param[out] CMDSC -- character*4(*): Merged array containing
30 C> descriptor codes
31 C> @param[out] CMELEM -- character*120(*): Merged array containing
32 C> element names
33 C>
34 C> <b>Program history log:</b>
35 C> | Date | Programmer | Comments |
36 C> | -----|------------|----------|
37 C> | 2007-01-19 | J. Ator | Original author |
38 C> | 2021-01-08 | J. Ator | Modified mstabs array declarations for GNUv10 portability |
39 C> | 2021-05-17 | J. Ator | Allow up to 24 characters in cmunit |
40 C> | 2021-09-30 | J. Ator | Replace jstchr with Fortran intrinsic adjustl; replace rjust with Fortran intrinsic adjustr |
41 C>
42  SUBROUTINE sntbbe ( IFXYN, LINE, MXMTBB,
43  . nmtbb, imfxyn, cmscl, cmsref, cmbw,
44  . cmunit, cmmnem, cmdsc, cmelem )
45 
46  character*(*) line
47  character*200 tags(10), wktag
48  character*128 bort_str1, bort_str2
49  character*4 cmdsc(*)
50  character cmelem(120,*)
51  character cmunit(24,*)
52  character cmsref(12,*)
53  character cmmnem(8,*)
54  character cmscl(4,*), cmbw(4,*)
55 
56  integer imfxyn(*)
57 
58 C-----------------------------------------------------------------------
59 C-----------------------------------------------------------------------
60 
61  IF ( nmtbb .GE. mxmtbb ) goto 900
62  nmtbb = nmtbb + 1
63 
64 C Store the FXY number. This is the element descriptor.
65 
66  imfxyn( nmtbb ) = ifxyn
67 
68 C Parse the table entry.
69 
70  CALL parstr( line, tags, 10, ntag, '|', .false. )
71  IF ( ntag .LT. 4 ) THEN
72  bort_str2 = ' HAS TOO FEW FIELDS'
73  goto 901
74  ENDIF
75 
76 C Scale factor.
77 
78  tags(2) = adjustl( tags(2) )
79  IF ( tags(2) .EQ. ' ' ) THEN
80  bort_str2 = ' HAS MISSING SCALE FACTOR'
81  goto 901
82  ENDIF
83  tags(2)(1:4) = adjustr( tags(2)(1:4) )
84  DO ii = 1, 4
85  cmscl( ii, nmtbb ) = tags(2)(ii:ii)
86  ENDDO
87 
88 C Reference value.
89 
90  tags(3) = adjustl( tags(3) )
91  IF ( tags(3) .EQ. ' ' ) THEN
92  bort_str2 = ' HAS MISSING REFERENCE VALUE'
93  goto 901
94  ENDIF
95  tags(3)(1:12) = adjustr( tags(3)(1:12) )
96  DO ii = 1, 12
97  cmsref( ii, nmtbb ) = tags(3)(ii:ii)
98  ENDDO
99 
100 C Bit width.
101 
102  tags(4) = adjustl( tags(4) )
103  IF ( tags(4) .EQ. ' ' ) THEN
104  bort_str2 = ' HAS MISSING BIT WIDTH'
105  goto 901
106  ENDIF
107  tags(4)(1:4) = adjustr( tags(4)(1:4) )
108  DO ii = 1, 4
109  cmbw( ii, nmtbb ) = tags(4)(ii:ii)
110  END DO
111 
112 C Units. Note that this field is allowed to be blank.
113 
114  IF ( ntag .GT. 4 ) THEN
115  tags(5) = adjustl( tags(5) )
116  DO ii = 1, 24
117  cmunit( ii, nmtbb ) = tags(5)(ii:ii)
118  ENDDO
119  ELSE
120  DO ii = 1, 24
121  cmunit( ii, nmtbb ) = ' '
122  ENDDO
123  ENDIF
124 
125 C Comment (additional) fields. Any of these fields may be blank.
126 
127  cmdsc( nmtbb ) = ' '
128  DO ii = 1, 8
129  cmmnem( ii, nmtbb ) = ' '
130  ENDDO
131  DO ii = 1, 120
132  cmelem( ii, nmtbb ) = ' '
133  ENDDO
134  IF ( ntag .GT. 5 ) THEN
135  wktag = tags(6)
136  CALL parstr( wktag, tags, 10, ntag, ';', .false. )
137  IF ( ntag .GT. 0 ) THEN
138 C The first additional field contains the mnemonic.
139  tags(1) = adjustl( tags(1) )
140 C If there is a mnemonic, then make sure it's legal.
141  IF ( ( tags(1) .NE. ' ' ) .AND.
142  . ( nemock( tags(1) ) .NE. 0 ) ) THEN
143  bort_str2 = ' HAS ILLEGAL MNEMONIC'
144  goto 901
145  ENDIF
146  DO ii = 1, 8
147  cmmnem( ii, nmtbb ) = tags(1)(ii:ii)
148  ENDDO
149  ENDIF
150  IF ( ntag .GT. 1 ) THEN
151 C The second additional field contains descriptor codes.
152  tags(2) = adjustl( tags(2) )
153  cmdsc( nmtbb ) = tags(2)(1:4)
154  ENDIF
155  IF ( ntag .GT. 2 ) THEN
156 C The third additional field contains the element name.
157  tags(3) = adjustl( tags(3) )
158  DO ii = 1, 120
159  cmelem( ii, nmtbb ) = tags(3)(ii:ii)
160  ENDDO
161  ENDIF
162  ENDIF
163 
164  RETURN
165  900 CALL bort('BUFRLIB: SNTBBE - OVERFLOW OF MERGED ARRAYS')
166  901 bort_str1 = 'BUFRLIB: SNTBBE - CARD BEGINNING WITH: ' //
167  . line(1:20)
168  CALL bort2(bort_str1,bort_str2)
169  END
subroutine parstr(STR, TAGS, MTAG, NTAG, SEP, LIMIT80)
THIS SUBROUTINE PARSES A STRING CONTAINING ONE OR MORE SUBSTRINGS INTO AN ARRAY OF SUBSTRINGS...
Definition: parstr.f:37
subroutine bort2(STR1, STR2)
This subroutine calls subroutine errwrt() to log two error messages, then calls subroutine bort_exit(...
Definition: bort2.f:22
function nemock(NEMO)
THIS FUNCTION CHECKS A MNEMONIC TO VERIFY THAT IT HAS A LENGTH OF BETWEEN ONE AND EIGHT CHARACTERS AN...
Definition: nemock.f:36
subroutine sntbbe(IFXYN, LINE, MXMTBB, NMTBB, IMFXYN, CMSCL, CMSREF, CMBW, CMUNIT, CMMNEM, CMDSC, CMELEM)
This subroutine stores an entry that was previously read from an ASCII master Table B file into a set...
Definition: sntbbe.f:42
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:22