75 SUBROUTINE cktaba(LUN,SUBSET,JDATE,IRET)
82 COMMON /padesc/ ibct,ipd1,ipd2,ipd3,ipd4
85 CHARACTER*128 bort_str,errstr
91 DATA cpfx /
'NC',
'FR',
'FN' /
101 jdate =
igetdate(mbay(1,lun),iyr,imo,idy,ihr)
104 mtyp =
iupbs01(mbay(1,lun),
'MTYP')
106 msbt =
iupbs01(mbay(1,lun),
'MSBT')
113 IF(isc3(lun).EQ.0)
THEN
122 CALL
getlens(mbay(1,lun),3,len0,len1,len2,len3,l4,l5)
124 iad3 = len0+len1+len2
127 ksub =
iupb(mbay(1,lun),iad3+8 ,16)
129 isub =
iupb(mbay(1,lun),iad3+10,16)
142 IF(isc3(lun).NE.0)
THEN
145 CALL
nemtbax(lun,subset,mty1,msb1,inod)
148 mbyt(lun) = 8*(iad4+4)
158 5 CALL
numtab(lun,isub,subset,tab,itab)
160 CALL
nemtbax(lun,subset,mty1,msb1,inod)
172 CALL
numtab(lun,ksub,subset,tab,itab)
174 CALL
nemtbax(lun,subset,mty1,msb1,inod)
177 mbyt(lun) = 8*(iad4+4)
188 DO WHILE(ii.LE.ncpfx)
189 WRITE(subset,
'(A2,2I3.3)') cpfx(ii),mtyp,msbt
191 CALL
nemtbax(lun,subset,mty1,msb1,inod)
194 IF(ksub.EQ.ibct)
THEN
198 mbyt(lun) = 8*(iad4+4)
216 CALL
errwrt(
'++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
217 errstr =
'BUFRLIB: CKTABA - LAST RESORT, CHECK FOR EXTERNAL'//
218 .
' BUFR TABLE VIA CALL TO IN-LINE OPENBT'
220 CALL
errwrt(
'++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
236 CALL
errwrt(
'+++++++++++++++++++++WARNING+++++++++++++++++++++++')
237 errstr =
'BUFRLIB: CKTABA - UNRECOGNIZED TABLE A MESSAGE TYPE ('//
238 . subset //
') - RETURN WITH IRET = -1'
240 CALL
errwrt(
'+++++++++++++++++++++WARNING+++++++++++++++++++++++')
249 10
IF(isc3(lun).EQ.0)
THEN
250 IF(mtyp.NE.mty1) goto 900
251 IF(msbt.NE.msb1.AND.
digit(subset(3:8))) goto 901
253 IF(
iupbs3(mbay(1,lun),
'ICMP').GT.0) msgunp(lun) = 2
259 idate(lun) =
i4dy(jdate)
263 msub(lun) =
iupbs3(mbay(1,lun),
'NSUB')
269 nmsg(lun) = nmsg(lun)+1
276 900
WRITE(bort_str,
'("BUFRLIB: CKTABA - MESSAGE TYPE MISMATCH '//
277 .
'(SUBSET=",A8,", MTYP=",I3,", MTY1=",I3)') subset,mtyp,mty1
279 901
WRITE(bort_str,
'("BUFRLIB: CKTABA - MESSAGE SUBTYPE MISMATCH '//
280 .
'(SUBSET=",A8,", MSBT=",I3,", MSB1=",I3)') subset,msbt,msb1
subroutine numtab(LUN, IDN, NEMO, TAB, IRET)
This subroutine returns information about a descriptor from the internal DX BUFR tables, based on the bit-wise representation of the FXY value associated with that descriptor.
subroutine nemtbax(LUN, NEMO, MTYP, MSBT, INOD)
This subroutine searches for a descriptor within Table A of the internal DX BUFR tables.
function iupbs3(MBAY, S3MNEM)
This function returns a specified value from within Section 3 of a BUFR message.
function igetdate(MBAY, IYR, IMO, IDY, IHR)
This function returns the date-time from within Section 1 of a BUFR message.
function i4dy(IDATE)
This function converts a date-time with a 2-digit year (YYMMDDHH) to a date-time with a 4-digit year ...
function iupb(MBAY, NBYT, NBIT)
THIS FUNCTION UNPACKS AND RETURNS A BINARY INTEGER WORD CONTAINED WITHIN NBIT BITS OF A BUFR MESSAGE ...
subroutine cktaba(LUN, SUBSET, JDATE, IRET)
THIS SUBROUTINE PARSES THE TABLE A MNEMONIC AND THE DATE OUT OF SECTION 1 OF A BUFR MESSAGE PREVIOUSL...
subroutine getlens(MBAY, LL, LEN0, LEN1, LEN2, LEN3, LEN4, LEN5)
This subroutine reads the lengths of all of the individual sections of a given BUFR message...
subroutine errwrt(STR)
This subroutine allows the user to specify a custom location for the logging of error and diagnostic ...
subroutine openbt(LUNDX, MTYP)
This subroutine is called as a last resort from within subroutine cktaba(), in the event the latter s...
subroutine rdusdx(LUNDX, LUN)
THIS SUBROUTINE READS AND PARSES A FILE CONTAINING A USER- SUPPLIED BUFR DICTIONARY TABLE IN CHARACTE...
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
This module contains array and variable declarations used to store BUFR messages internally for multi...
LOGICAL function digit(STR)
This logical function checks whether the characters in a string are all numeric.
function iupbs01(MBAY, S01MNEM)
This function returns a specified value from within Section 0 or Section 1 of a BUFR message...