NCEPLIBS-bufr  11.6.0
 All Data Structures Files Functions Variables Pages
sntbde.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Store a master Table D entry into Fortran arrays
3 
4 C> This subroutine stores the first line of an entry that was
5 C> previously read from an ASCII master Table D file into a set of
6 C> merged Fortran arrays. It then reads and stores all remaining
7 C> lines of that same entry into the same merged Fortran arrays.
8 C>
9 C> @author J. Ator
10 C> @date 2007-01-19
11 C>
12 C> @param[in] LUNT -- integer: Fortran logical unit number for
13 C> ASCII file containing Table D information
14 C> @param[in] IFXYN -- integer: Bit-wise representation of FXY number
15 C> @param[in] LINE -- character*(*): First line of Table D entry
16 C> @param[in] MXMTBD -- integer: Dimensioned size (in integers) of
17 C> merged output arrays; used by the subroutine
18 C> to ensure that it doesn't overflow these
19 C> arrays
20 C> @param[in] MXELEM -- integer: Maximum number of elements to be
21 C> stored per Table D sequence within merged
22 C> output arrays; used by the subroutine to
23 C> ensure that it doesn't overflow these arrays
24 C> @param[out] NMTBD -- integer: Number of entries in merged output
25 C> arrays
26 C> @param[out] IMFXYN -- integer(*): Merged array containing bit-wise
27 C> representations of FXY numbers
28 C> @param[out] CMMNEM -- character*8(*): Merged array containing
29 C> mnemonics
30 C> @param[out] CMDSC -- character*4(*): Merged array containing
31 C> descriptor codes
32 C> @param[out] CMSEQ -- character*120(*): Merged array containing
33 C> sequence names
34 C> @param[out] NMELEM -- integer(*): Merged array containing number of
35 C> elements stored for each sequence
36 C> @param[out] IEFXYN -- integer(*,*): Merged array containing bit-wise
37 C> representations of element FXY numbers
38 C> @param[out] CEELEM -- character*120(*,*): Merged array containing
39 C> element names
40 C>
41 C> <b>Program history log:</b>
42 C> | Date | Programmer | Comments |
43 C> | -----|------------|----------|
44 C> | 2007-01-19 | J. Ator | Original author |
45 C> | 2021-01-08 | J. Ator | Modified mstabs array declarations for GNUv10 portability |
46 C> | 2021-09-30 | J. Ator | Replace jstchr with Fortran intrinsic adjustl |
47 C>
48  SUBROUTINE sntbde ( LUNT, IFXYN, LINE, MXMTBD, MXELEM,
49  . nmtbd, imfxyn, cmmnem, cmdsc, cmseq,
50  . nmelem, iefxyn, ceelem )
51 
52  character*(*) line
53  character*200 tags(10), cline
54  character*128 bort_str1, bort_str2
55  character*120 ceelem(mxmtbd,mxelem)
56  character*6 adn30, adsc, clemon
57  character*4 cmdsc(*)
58  character cmseq(120,*)
59  character cmmnem(8,*)
60 
61  integer imfxyn(*), nmelem(*),
62  . iefxyn(mxmtbd,mxelem)
63 
64  logical done
65 
66 C-----------------------------------------------------------------------
67 C-----------------------------------------------------------------------
68 
69  IF ( nmtbd .GE. mxmtbd ) goto 900
70  nmtbd = nmtbd + 1
71 
72 C Store the FXY number. This is the sequence descriptor.
73 
74  imfxyn( nmtbd ) = ifxyn
75 
76 C Is there any other information within the first line of the
77 C table entry? If so, it follows a "|" separator.
78 
79  DO ii = 1, 8
80  cmmnem( ii, nmtbd ) = ' '
81  ENDDO
82  cmdsc( nmtbd ) = ' '
83  DO ii = 1, 120
84  cmseq( ii, nmtbd ) = ' '
85  ENDDO
86  ipt = index( line, '|' )
87  IF ( ipt .NE. 0 ) THEN
88 
89 C Parse the rest of the line. Any of the fields may be blank.
90 
91  CALL parstr( line(ipt+1:), tags, 10, ntag, ';', .false. )
92  IF ( ntag .GT. 0 ) THEN
93 C The first additional field contains the mnemonic.
94  tags(1) = adjustl( tags(1) )
95 C If there is a mnemonic, then make sure it's legal.
96  IF ( ( tags(1) .NE. ' ' ) .AND.
97  . ( nemock( tags(1) ) .NE. 0 ) ) THEN
98  bort_str2 = ' HAS ILLEGAL MNEMONIC'
99  goto 901
100  ENDIF
101  DO ii = 1, 8
102  cmmnem( ii, nmtbd ) = tags(1)(ii:ii)
103  ENDDO
104  ENDIF
105  IF ( ntag .GT. 1 ) THEN
106 C The second additional field contains descriptor codes.
107  tags(2) = adjustl( tags(2) )
108  cmdsc( nmtbd ) = tags(2)(1:4)
109  ENDIF
110  IF ( ntag .GT. 2 ) THEN
111 C The third additional field contains the sequence name.
112  tags(3) = adjustl( tags(3) )
113  DO ii = 1, 120
114  cmseq( ii, nmtbd ) = tags(3)(ii:ii)
115  ENDDO
116  ENDIF
117  ENDIF
118 
119 C Now, read and parse all remaining lines from this table entry.
120 C Each line should contain an element descriptor for the sequence
121 C represented by the current sequence descriptor.
122 
123  nelem = 0
124  done = .false.
125  DO WHILE ( .NOT. done )
126  IF ( igetntbl( lunt, cline ) .NE. 0 ) THEN
127  bort_str2 = ' IS INCOMPLETE'
128  goto 901
129  ENDIF
130  CALL parstr( cline, tags, 10, ntag, '|', .false. )
131  IF ( ntag .LT. 2 ) THEN
132  bort_str2 = ' HAS BAD ELEMENT CARD'
133  goto 901
134  ENDIF
135 
136 C The second field contains the FXY number for this element.
137 
138  IF ( igetfxy( tags(2), adsc ) .NE. 0 ) THEN
139  bort_str2 = ' HAS BAD OR MISSING' //
140  . ' ELEMENT FXY NUMBER'
141  goto 901
142  ENDIF
143  IF ( nelem .GE. mxelem ) goto 900
144  nelem = nelem + 1
145  iefxyn( nmtbd, nelem ) = ifxy( adsc )
146 
147 C The third field (if it exists) contains the element name.
148 
149  IF ( ntag .GT. 2 ) THEN
150  tags(3) = adjustl( tags(3) )
151  ceelem( nmtbd, nelem ) = tags(3)(1:120)
152  ELSE
153  ceelem( nmtbd, nelem ) = ' '
154  ENDIF
155 
156 C Is this the last line for this table entry?
157 
158  IF ( index( tags(2), ' >' ) .EQ. 0 ) done = .true.
159  ENDDO
160  nmelem( nmtbd ) = nelem
161 
162  RETURN
163 
164  900 CALL bort('BUFRLIB: SNTBDE - OVERFLOW OF MERGED ARRAYS')
165  901 clemon = adn30( ifxyn, 6 )
166  WRITE(bort_str1,'("BUFRLIB: SNTBDE - TABLE D ENTRY FOR' //
167  . ' SEQUENCE DESCRIPTOR: ",5A)')
168  . clemon(1:1), '-', clemon(2:3), '-', clemon(4:6)
169  CALL bort2(bort_str1,bort_str2)
170  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
function igetfxy(STR, CFXY)
THIS FUNCTION LOOKS FOR AND RETURNS A VALID FXY NUMBER FROM WITHIN THE GIVEN INPUT STRING...
Definition: igetfxy.f:30
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
function ifxy(ADSC)
This function converts an FXY value from its 6 character representation to its bit-wise (integer) rep...
Definition: ifxy.f:42
function igetntbl(LUNT, LINE)
This subroutine reads the next line from an ASCII master table B, table D or Code/Flag table file...
Definition: igetntbl.f:28
subroutine sntbde(LUNT, IFXYN, LINE, MXMTBD, MXELEM, NMTBD, IMFXYN, CMMNEM, CMDSC, CMSEQ, NMELEM, IEFXYN, CEELEM)
This subroutine stores the first line of an entry that was previously read from an ASCII master Table...
Definition: sntbde.f:48
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:22