NCEPLIBS-bufr  11.5.0
 All Data Structures Files Functions Variables Pages
sntbde.f
Go to the documentation of this file.
1 C> @file
2 C> @author ATOR @date 2007-01-19
3 
4 C> THIS SUBROUTINE PARSES THE FIRST LINE OF AN ENTRY THAT WAS
5 C> PREVIOUSLY READ FROM AN ASCII MASTER TABLE D FILE AND STORES THE
6 C> OUTPUT INTO THE MERGED ARRAYS. IT THEN READS AND PARSES ALL
7 C> REMAINING LINES FOR THAT SAME ENTRY AND THEN LIKEWISE STORES THAT
8 C> OUTPUT INTO THE MERGED ARRAYS. THE RESULT IS THAT, UPON OUTPUT,
9 C> THE MERGED ARRAYS NOW CONTAIN ALL OF THE INFORMATION FOR THE
10 C> CURRENT TABLE ENTRY.
11 C>
12 C> PROGRAM HISTORY LOG:
13 C> 2007-01-19 J. ATOR -- ORIGINAL AUTHOR
14 C> 2021-01-08 J. ATOR -- MODIFIED MSTABS ARRAY DECLARATIONS
15 C> FOR GNUv10 PORTABILITY
16 C>
17 C> USAGE: CALL SNTBDE ( LUNT, IFXYN, LINE, MXMTBD, MXELEM,
18 C> NMTBD, IMFXYN, CMMNEM, CMDSC, CMSEQ,
19 C> NMELEM, IEFXYN, CEELEM )
20 C> INPUT ARGUMENT LIST:
21 C> LUNT - INTEGER: FORTRAN LOGICAL UNIT NUMBER OF ASCII FILE
22 C> CONTAINING MASTER TABLE D INFORMATION
23 C> IFXYN - INTEGER: BIT-WISE REPRESENTATION OF FXY NUMBER FOR
24 C> TABLE ENTRY; THIS FXY NUMBER IS THE SEQUENCE DESCRIPTOR
25 C> LINE - CHARACTER*(*): FIRST LINE OF TABLE ENTRY
26 C> MXMTBD - INTEGER: MAXIMUM NUMBER OF ENTRIES TO BE STORED IN
27 C> MERGED MASTER TABLE D ARRAYS; THIS SHOULD BE THE SAME
28 C> NUMBER AS WAS USED TO DIMENSION THE OUTPUT ARRAYS IN
29 C> THE CALLING PROGRAM, AND IT IS USED BY THIS SUBROUTINE
30 C> TO ENSURE THAT IT DOESN'T OVERFLOW THESE ARRAYS
31 C> MXELEM - INTEGER: MAXIMUM NUMBER OF ELEMENTS TO BE STORED PER
32 C> ENTRY WITHIN THE MERGED MASTER TABLE D ARRAYS; THIS
33 C> SHOULD BE THE SAME NUMBER AS WAS USED TO DIMENSION THE
34 C> OUTPUT ARRAYS IN THE CALLING PROGRAM, AND IT IS USED
35 C> BY THIS SUBROUTINE TO ENSURE THAT IT DOESN'T OVERFLOW
36 C> THESE ARRAYS
37 C>
38 C> OUTPUT ARGUMENT LIST:
39 C> NMTBD - INTEGER: NUMBER OF ENTRIES IN MERGED MASTER TABLE D
40 C> ARRAYS
41 C> IMFXYN(*)- INTEGER: MERGED ARRAY CONTAINING BIT-WISE
42 C> REPRESENTATIONS OF FXY NUMBERS (I.E. SEQUENCE
43 C> DESCRIPTORS)
44 C> CMMNEM(*)- CHARACTER*8: MERGED ARRAY CONTAINING MNEMONICS
45 C> CMDSC(*) - CHARACTER*4: MERGED ARRAY CONTAINING DESCRIPTOR CODES
46 C> CMSEQ(*) - CHARACTER*120: MERGED ARRAY CONTAINING SEQUENCE NAMES
47 C> NMELEM(*)- INTEGER: MERGED ARRAY CONTAINING NUMBER OF ELEMENTS
48 C> STORED FOR EACH ENTRY
49 C> IEFXYN(*,*)- INTEGER: MERGED ARRAY CONTAINING BIT-WISE
50 C> REPRESENTATIONS OF ELEMENT FXY NUMBERS
51 C> CEELEM(*,*)- CHARACTER*120: MERGED ARRAY CONTAINING ELEMENT NAMES
52 C>
53 C> REMARKS:
54 C> THIS ROUTINE CALLS: ADN30 BORT BORT2 IFXY
55 C> IGETFXY IGETNTBL JSTCHR NEMOCK
56 C> PARSTR
57 C> THIS ROUTINE IS CALLED BY: RDMTBD
58 C> Normally not called by any application
59 C> programs.
60 C>
61  SUBROUTINE sntbde ( LUNT, IFXYN, LINE, MXMTBD, MXELEM,
62  . nmtbd, imfxyn, cmmnem, cmdsc, cmseq,
63  . nmelem, iefxyn, ceelem )
64 
65 
66 
67  character*(*) line
68  character*200 tags(10), cline
69  character*128 bort_str1, bort_str2
70  character*120 ceelem(mxmtbd,mxelem)
71  character*6 adn30, adsc, clemon
72  character*4 cmdsc(*)
73  character cmseq(120,*)
74  character cmmnem(8,*)
75 
76  integer imfxyn(*), nmelem(*),
77  . iefxyn(mxmtbd,mxelem)
78 
79  logical done
80 
81 C-----------------------------------------------------------------------
82 C-----------------------------------------------------------------------
83 
84  IF ( nmtbd .GE. mxmtbd ) goto 900
85  nmtbd = nmtbd + 1
86 
87 C Store the FXY number. This is the sequence descriptor.
88 
89  imfxyn( nmtbd ) = ifxyn
90 
91 C Is there any other information within the first line of the
92 C table entry? If so, it follows a "|" separator.
93 
94  DO ii = 1, 8
95  cmmnem( ii, nmtbd ) = ' '
96  ENDDO
97  cmdsc( nmtbd ) = ' '
98  DO ii = 1, 120
99  cmseq( ii, nmtbd ) = ' '
100  ENDDO
101  ipt = index( line, '|' )
102  IF ( ipt .NE. 0 ) THEN
103 
104 C Parse the rest of the line. Any of the fields may be blank.
105 
106  CALL parstr( line(ipt+1:), tags, 10, ntag, ';', .false. )
107  IF ( ntag .GT. 0 ) THEN
108 C The first additional field contains the mnemonic.
109  CALL jstchr( tags(1), iret )
110 C If there is a mnemonic, then make sure it's legal.
111  IF ( ( iret .EQ. 0 ) .AND.
112  . ( nemock( tags(1) ) .NE. 0 ) ) THEN
113  bort_str2 = ' HAS ILLEGAL MNEMONIC'
114  goto 901
115  ENDIF
116  DO ii = 1, 8
117  cmmnem( ii, nmtbd ) = tags(1)(ii:ii)
118  ENDDO
119  ENDIF
120  IF ( ntag .GT. 1 ) THEN
121 C The second additional field contains descriptor codes.
122  CALL jstchr( tags(2), iret )
123  cmdsc( nmtbd ) = tags(2)(1:4)
124  ENDIF
125  IF ( ntag .GT. 2 ) THEN
126 C The third additional field contains the sequence name.
127  CALL jstchr( tags(3), iret )
128  DO ii = 1, 120
129  cmseq( ii, nmtbd ) = tags(3)(ii:ii)
130  ENDDO
131  ENDIF
132  ENDIF
133 
134 C Now, read and parse all remaining lines from this table entry.
135 C Each line should contain an element descriptor for the sequence
136 C represented by the current sequence descriptor.
137 
138  nelem = 0
139  done = .false.
140  DO WHILE ( .NOT. done )
141  IF ( igetntbl( lunt, cline ) .NE. 0 ) THEN
142  bort_str2 = ' IS INCOMPLETE'
143  goto 901
144  ENDIF
145  CALL parstr( cline, tags, 10, ntag, '|', .false. )
146  IF ( ntag .LT. 2 ) THEN
147  bort_str2 = ' HAS BAD ELEMENT CARD'
148  goto 901
149  ENDIF
150 
151 C The second field contains the FXY number for this element.
152 
153  IF ( igetfxy( tags(2), adsc ) .NE. 0 ) THEN
154  bort_str2 = ' HAS BAD OR MISSING' //
155  . ' ELEMENT FXY NUMBER'
156  goto 901
157  ENDIF
158  IF ( nelem .GE. mxelem ) goto 900
159  nelem = nelem + 1
160  iefxyn( nmtbd, nelem ) = ifxy( adsc )
161 
162 C The third field (if it exists) contains the element name.
163 
164  IF ( ntag .GT. 2 ) THEN
165  CALL jstchr( tags(3), iret )
166  ceelem( nmtbd, nelem ) = tags(3)(1:120)
167  ELSE
168  ceelem( nmtbd, nelem ) = ' '
169  ENDIF
170 
171 C Is this the last line for this table entry?
172 
173  IF ( index( tags(2), ' >' ) .EQ. 0 ) done = .true.
174  ENDDO
175  nmelem( nmtbd ) = nelem
176 
177  RETURN
178 
179  900 CALL bort('BUFRLIB: SNTBDE - OVERFLOW OF MERGED ARRAYS')
180  901 clemon = adn30( ifxyn, 6 )
181  WRITE(bort_str1,'("BUFRLIB: SNTBDE - TABLE D ENTRY FOR' //
182  . ' SEQUENCE DESCRIPTOR: ",5A)')
183  . clemon(1:1), '-', clemon(2:3), '-', clemon(4:6)
184  CALL bort2(bort_str1,bort_str2)
185  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:20
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:28
character *(*) function adn30(IDN, L30)
This function converts a descriptor from its bit-wise (integer) representation to its 5 or 6 characte...
Definition: adn30.f:27
function ifxy(ADSC)
THIS FUNCTION RETURNS THE INTEGER CORRESPONDING TO THE BIT-WISE REPRESENTATION OF AN INPUT CHARACTER ...
Definition: ifxy.f:49
function igetntbl(LUNT, LINE)
THIS FUNCTION GETS THE NEXT LINE FROM THE ASCII MASTER TABLE FILE SPECIFIED BY LUNT, IGNORING ANY BLANK LINES OR COMMENT LINES IN THE PROCESS.
Definition: igetntbl.f:31
subroutine jstchr(STR, IRET)
THIS SUBROUTINE LEFT-JUSTIFIES (I.E.
Definition: jstchr.f:43
subroutine sntbde(LUNT, IFXYN, LINE, MXMTBD, MXELEM, NMTBD, IMFXYN, CMMNEM, CMDSC, CMSEQ, NMELEM, IEFXYN, CEELEM)
THIS SUBROUTINE PARSES THE FIRST LINE OF AN ENTRY THAT WAS PREVIOUSLY READ FROM AN ASCII MASTER TABLE...
Definition: sntbde.f:61
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:23