25 SUBROUTINE sntbfe ( LUNT, IFXYN, LINE )
28 character*160 cline, tags(4), cdstr(2), adsc(10), cval(25)
29 character*128 bort_str1, bort_str2
30 character*6
adn30, clemon, cdsc
31 dimension idfxy(10), idval(25)
48 DO WHILE ( .NOT. done )
50 IF (
igetntbl( lunt, cline ) .NE. 0 )
THEN
51 bort_str2 =
' IS INCOMPLETE'
55 CALL
parstr( cline, tags, 4, ntag,
'|', .false. )
56 IF ( ( ntag .LT. 2 ) .OR. ( ntag .GT. 3 ) )
THEN
57 bort_str2 =
' HAS BAD CARD'
61 IF ( ntag .EQ. 2 )
THEN
65 CALL
parstr( tags(2), cdstr, 2, ntag,
'=', .false. )
66 IF ( ntag .NE. 2 )
THEN
67 bort_str2 =
' HAS BAD DEPENDENCY CARD'
73 CALL
parstr( cdstr(1), adsc, 10, nidfxy,
',', .false. )
74 IF ( nidfxy .EQ. 0 )
THEN
75 bort_str2 =
' HAS BAD DEPENDENCY LIST (FXY)'
79 IF (
igetfxy( adsc(ii), cdsc ) .NE. 0 )
THEN
80 bort_str2 =
' HAS BAD DEPENDENCY (FXY)'
83 idfxy(ii) =
ifxy( cdsc )
88 CALL
parstr( cdstr(2), cval, 25, nidval,
',', .false. )
89 IF ( nidval .EQ. 0 )
THEN
90 bort_str2 =
' HAS BAD DEPENDENCY LIST (VAL)'
94 cval(ii) = adjustl( cval(ii) )
95 CALL
strnum( cval(ii), ival )
104 ipt = index( tags(2),
' >' )
105 IF ( ipt .EQ. 0 )
THEN
111 tags(2)(ipt+1:ipt+1) =
' '
114 tags(2) = adjustl( tags(2) )
115 CALL
strnum( tags(2), ival )
119 tags(3) = adjustl( tags(3) )
122 DO WHILE ( ( lt3 .GT. 0 ) .AND. ( .NOT. lstnblk ) )
123 IF ( tags(3)(lt3:lt3) .NE.
' ' )
THEN
133 IF ( ( nidfxy .EQ. 0 ) .AND. ( nidval .EQ. 0 ) )
THEN
134 CALL
strtbfe( ifxyn, ival, tags(3), lt3, -1, -1 )
138 CALL
strtbfe( ifxyn, ival, tags(3), lt3,
139 + idfxy(ii), idval(jj) )
150 900 clemon =
adn30( ifxyn, 6 )
151 WRITE(bort_str1,
'("BUFRLIB: SNTBFE - TABLE F ENTRY FOR' //
152 .
' ELEMENT DESCRIPTOR: ",5A)')
153 . clemon(1:1),
'-', clemon(2:3),
'-', clemon(4:6)
154 CALL
bort2(bort_str1,bort_str2)
subroutine parstr(STR, TAGS, MTAG, NTAG, SEP, LIMIT80)
THIS SUBROUTINE PARSES A STRING CONTAINING ONE OR MORE SUBSTRINGS INTO AN ARRAY OF SUBSTRINGS...
subroutine bort2(STR1, STR2)
This subroutine calls subroutine errwrt() to log two error messages, then calls subroutine bort_exit(...
subroutine strnum(STR, NUM)
This subroutine decodes an integer from a character string.
function igetfxy(STR, CFXY)
THIS FUNCTION LOOKS FOR AND RETURNS A VALID FXY NUMBER FROM WITHIN THE GIVEN INPUT STRING...
void strtbfe(f77int *, f77int *, char *, f77int *, f77int *, f77int *)
This subroutine adds a new entry to the internal memory structure for storage of master Code/Flag tab...
character *(*) function adn30(IDN, L30)
This function converts an FXY value from its bit-wise (integer) representation to its 5 or 6 characte...
function ifxy(ADSC)
This function converts an FXY value from its 6 character representation to its bit-wise (integer) rep...
function igetntbl(LUNT, LINE)
This subroutine reads the next line from an ASCII master table B, table D or Code/Flag table file...
subroutine sntbfe(LUNT, IFXYN, LINE)
This subroutine stores the first line of an entry that was previously read from an ASCII master Code/...