Send To Printer
Example Program: General purpose utility for decoding BUFR files
In this example, we show how various BUFRLIB subroutines and functions can be integrated within an application program to read and dump the contents of a file containing any types of valid BUFR messages, without the need to pre-define any DX BUFR tables. As discussed earlier within the documentation, this can be done via the use of appropriate Master BUFR tables, and by specifying IO='SEC3' when making the appropriate call to subroutine OPENBF for the file in question. Unlike in some of our other examples, the below program can be directly compiled and run "as is", without any additional code supplied by the user. The program consists of a main C-language program "debufr.c" which in turn calls a FORTRAN subroutine "fdebufr.f" as shown below.
--------------------------- main program "debufr.c" -------------------------- /* ** MAIN PROGRAM DOCUMENTATION BLOCK ** ** MAIN PROGRAM: debufr ** PRGMMR: J. Ator ORG: NCEP DATE: 2019-02-01 ** ** ABSTRACT: This program decodes a BUFR file and generates a verbose ** listing of the contents. If an NCEP DX dictionary tables file is ** specified (using the -f option) or if the specified BUFR file ** contains an embedded NCEP DX dictionary message as the first ** message in the file, then this DX information is used to decode ** the data messages in the file. Otherwise, or whenever the -m option ** is specified, BUFR master tables are read and used to decode the ** data messages in the file. ** ** PROGRAM HISTORY LOG: ** 2009-07-01 J. Ator Original author ** 2012-06-18 J. Ator Modified to allow decoding of BUFR files ** based on NCEP DX dictionary table ** information. The program can now process ** any files that previously required the use ** of ckbufr. ** 2012-12-07 J. Ator Modified to add -m and -v options and inline ** version of OPENBT subroutine for mixed BUFR files ** 2013-10-07 J. Ator Print Section 1 tank receipt time information ** for NCEP/NCO BUFR messages if available ** 2013-11-15 J. Ator Add -h option and check for non-existent tablefil ** 2014-09-15 J. Ator Change default path for tabledir, change default ** name for outfile, and confirm outfile is writeable ** 2018-01-19 J. Ator Add print of code and flag table meanings. ** 2018-04-09 J. Ator Add -c option to turn off print of code and flag ** table meanings (default is "on"). ** 2018-09-05 J. Ator Add -p option to pass in one or more BUFRLIB ** dynamic allocation parameters to override default ** settings ** 2019-02-01 J. Ator Remove limit on length of prmstg, and allow up to ** 20 PARAMETER=VALUE pairs ** ** USAGE: ** debufr [-v] [-h] [-b] [-c] [-m] [-o outfile] [-t tabledir] ** [-f tablefil] [-p prmstg] bufrfile ** ** WHERE: ** -v prints version information and exits ** -h prints program help and usage information and exits ** -b specifies the "basic" option, meaning that only the ** information in Sections 0-3 will be decoded from each ** BUFR message in the bufrfile, and no attempt will be ** made to decode the data in Section 4 ** -c specifies that code and flag table meanings should not ** be read from master tables and included in the output; ** otherwise this feature is enabled by default ** -m specifies that BUFR master tables will be used to ** decode the data messages in the file, regardless of ** whether they contain any embedded NCEP DX dictionary ** messages. This option can be used to view the actual ** contents of dictionary messages, which otherwise would ** not be printed in the output listing. ** outfile [path/]name of file to contain verbose output listing. ** The default is "bufrfilename.debufr.out" in the current ** working directory, where bufrfilename is the basename of ** the bufrfile (i.e. bufrfile with any preceding [path/] ** removed). ** tabledir [path/]name of directory containing tables to be used ** for decoding. This directory contains the NCEP DX ** dictionary tables file to be used (if one was specified ** via the -f option), or it may contain all of the BUFR ** master tables when these are being used to decode a ** file. If unspecified, the default directory location is ** "/gpfs/dell1/nco/ops/nwprod/decoders/decod_shared/fix" ** tablefil file within tabledir containing DX dictionary tables ** file to be used for decoding. ** prmstg string of comma-separated PARAMETER=VALUE pairs, up to a ** maximum of 20. For each pair, the dynamic allocation ** PARAMETER will be set to VALUE within the underlying ** BUFRLIB software, overriding the default value that ** would otherwise be used. A complete list of parameters ** that can be dynamically sized is included within the ** BUFRLIB documentation for function ISETPRM. ** bufrfile [path/]name of BUFR file to be decoded ** ** REMARKS: ** SUBPROGRAMS CALLED: ** LOCAL - fdebufr openbt prtusage ** BUFRLIB - ccbfl cobfl codflg crbmg datelen ** dxdump getcfmng idxmsg ireadsb iupbs01 ** iupbs3 mtinfo openbf parstr readerme ** ufdump upds3 bvers rtrcptb strsuc ** strnum isetprm ** ** FORTRAN logical unit numbers 51, 90, 91, 92 and 93 are reserved ** for use within the fdebufr subroutine. ** ** ATTRIBUTES: ** LANGUAGE: C ** MACHINE: Portable to all platforms */ #include#include #include #ifdef UNDERSCORE #define cobfl cobfl_ #define ccbfl ccbfl_ #define fdebufr fdebufr_ #define bvers bvers_ #define prtusage prtusage_ #endif #define MXFLEN 300 #ifdef F77_INTSIZE_8 typedef long f77int; #else typedef int f77int; #endif int main( int argc, char *argv[ ] ) { int ch; int errflg; char basic = 'N'; char forcemt = 'N'; char cfms = 'Y'; char io = 'r'; char tbldir[MXFLEN] = "/gpfs/dell1/nco/ops/nwprod/decoders/decod_shared/fix"; char tblfil[MXFLEN]; char outfile[MXFLEN]; char prmstg[MXFLEN] = "NULLPSTG"; char wkstr[MXFLEN]; char wkstr2[MXFLEN]; char bvstr[9] = " "; unsigned short ii; f77int lentd; /* ** Get and process the valid options from the command line: */ errflg = 0; wkstr[0] = '\0'; /* initialize to empty string */ outfile[0] = '\0'; /* initialize to empty string */ while ( ( ch = getopt ( argc, argv, "vhbcmo:t:f:p:" ) ) != EOF ) { switch ( ch ) { case 'v': bvers ( bvstr, sizeof(bvstr) ); /* append a trailing NULL to bvstr for printf */ for ( ii = 0; ii < sizeof(bvstr); ii++ ) { if ( ( bvstr[ii] != '.' ) && ( !isdigit(bvstr[ii]) ) ) { bvstr[ii] = '\0'; break; } } printf( "This is debufr v3.0.0, built with BUFRLIB v%s\n", bvstr ); return 0; case 'h': printf( "\nPROGRAM %s\n", argv[0] ); printf( "\nABSTRACT: This program decodes a BUFR file and generates a verbose\n" ); printf( " listing of the contents. If an NCEP DX dictionary tables file is\n" ); printf( " specified (using the -f option) or if the specified BUFR file\n" ); printf( " contains an embedded NCEP DX dictionary message as the first\n" ); printf( " message in the file, then this DX information is used to decode\n" ); printf( " the data messages in the file. Otherwise, or whenever the -m option\n" ); printf( " is specified, BUFR master tables are read and used to decode the\n" ); printf( " data messages in the file.\n" ); prtusage( argv[0] ); return 0; break; case 'b': basic = 'Y'; break; case 'm': forcemt = 'Y'; break; case 'c': cfms = 'N'; break; case 'o': strcpy ( outfile, optarg ); break; case 't': strcpy ( tbldir, optarg ); break; case 'f': strcpy ( wkstr, optarg ); break; case 'p': strcpy ( prmstg, optarg ); break; } } /* ** There should be one remaining command line argument specifying the ** input BUFR file. */ if ( (optind+1) != argc ) { printf( "\nERROR: You must specify an input BUFR file to be decoded!\n" ); prtusage( argv[0] ); return -1; } /* ** Open the input BUFR file. */ cobfl( argv[optind], &io ); /* ** Check whether a DX tables file was specified. */ if ( strlen( wkstr ) > 0 ) { sprintf( tblfil, "%s%c%s", tbldir, '/', wkstr ); } else { strcpy( tblfil, "NULLFILE" ); } /* ** Check whether an output file was specified. If not, make a default ** filename in the current working directory using the basename of the ** input BUFR file. */ if ( strlen( outfile ) == 0 ) { strcpy( wkstr2, argv[optind] ); strcpy( outfile, basename( wkstr2 ) ); strcat( outfile, ".debufr.out" ); } /* ** Confirm that the output directory is writeable. */ strcpy( wkstr2, outfile ); strcpy( wkstr, dirname( wkstr2 ) ); if ( access( wkstr, W_OK ) != 0 ) { printf( "\nERROR: Cannot write output file to directory %s\n", ( strcmp( wkstr, "." ) == 0 ? getcwd( wkstr2, MXFLEN ) : wkstr ) ); prtusage( argv[0] ); return -1; } /* ** Read and decode each message from the input BUFR file. */ lentd = (f77int) strlen(tbldir); fdebufr( outfile, tbldir, &lentd, tblfil, prmstg, &basic, &forcemt, &cfms, strlen(outfile), strlen(tbldir), strlen(tblfil), strlen(prmstg) ); /* ** Close the input BUFR file. */ ccbfl( ); return 0; } ------------------------------------------------------------------------------ --------------------------- C function "prtusage.c" -------------------------- #ifdef UNDERSCORE #define prtusage prtusage_ #endif void prtusage( char *prgnam ) { /* ** Prints program usage information to stdout. */ printf( "\nUSAGE:\n" ); printf( " %s [-v] [-h] [-b] [-c] [-m] [-o outfile] [-t tabledir] [-f tablefil] [-p prmstg] bufrfile\n\n", prgnam ); printf( "WHERE:\n" ); printf( " -v prints program version information and exits\n" ); printf( " -h prints program help and usage information and exits\n" ); printf( " -b specifies the \"basic\" option, meaning that only the\n" ); printf( " information in Sections 0-3 will be decoded from each\n" ); printf( " BUFR message in the bufrfile, and no attempt will be\n" ); printf( " made to decode the data in Section 4\n" ); printf( " -c specifies that code and flag table meanings should not\n" ); printf( " be read from master tables and included in the output;\n" ); printf( " otherwise this feature is enabled by default\n" ); printf( " -m specifies that BUFR master tables will be used to\n" ); printf( " decode the data messages in the file, regardless of\n" ); printf( " whether they contain any embedded NCEP DX dictionary\n" ); printf( " messages. This option can be used to view the actual\n" ); printf( " contents of dictionary messages, which otherwise would\n" ); printf( " not be printed in the output listing.\n" ); printf( " outfile [path/]name of file to contain verbose output listing.\n" ); printf( " The default is \"bufrfilename.debufr.out\" in the current\n" ); printf( " working directory, where bufrfilename is the basename of\n" ); printf( " the bufrfile (i.e. bufrfile with any preceding [path/]\n" ); printf( " removed).\n" ); printf( " tabledir [path/]name of directory containing tables to be used\n" ); printf( " for decoding. This directory contains the NCEP DX\n" ); printf( " dictionary tables file to be used (if one was specified\n" ); printf( " via the -f option), or it may contain all of the BUFR\n" ); printf( " master tables when these are being used to decode a\n" ); printf( " file. If unspecified, the default directory location is\n" ); printf( " \"/gpfs/dell1/nco/ops/nwprod/decoders/decod_shared/fix\"\n" ); printf( " tablefil file within tabledir containing DX dictionary tables\n" ); printf( " file to be used for decoding.\n" ); printf( " prmstg string of comma-separated PARAMETER=VALUE pairs, up to a\n" ); printf( " maximum of 20. For each pair, the dynamic allocation\n" ); printf( " PARAMETER will be set to VALUE within the underlying\n" ); printf( " BUFRLIB software, overriding the default value that would\n" ); printf( " otherwise be used. A complete list of parameters that can\n" ); printf( " be dynamically sized is included within the BUFRLIB\n" ); printf( " documentation for function ISETPRM.\n" ); printf( " bufrfile [path/]name of BUFR file to be decoded\n" ); } ------------------------------------------------------------------------------ ---------------------- FORTRAN subroutine "fdebufr.f" ------------------------ SUBROUTINE FDEBUFR ( ofile, tbldir, lentd, tblfil, prmstg, + basic, forcemt, cfms ) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C C SUBPROGRAM: fdebufr C PRGMMR: J. Ator ORG: NP12 DATE: 2019-02-01 C C ABSTRACT: This subroutine reads every BUFR message from within the C input file that was specified on the command line. Each such C message is decoded and the results are written as output to ofile. C C PROGRAM HISTORY LOG: C 2009-07-01 J. Ator Original author C 2012-06-18 J. Ator Added tblfil argument and options to decode C files according to DX dictionary information C 2012-12-07 J. Ator Added forcemt and lentd arguments C 2013-10-07 J. Ator Print Section 1 tank receipt time information C for NCEP/NCO BUFR messages if available C 2013-11-15 J. Ator Added check for missing or unreadable tblfil C 2014-09-15 J. Ator Confirm BUFR file was opened (i.e. at least C one good return from CRBMG) before calling C DXDUMP. C 2018-01-19 J. Ator Added print of code and flag table meanings. C 2018-03-01 J. Ator Added print of data types and subtypes from C code and flag tables. C 2018-09-05 J. Ator Added prmstg argument C 2019-02-01 J. Ator Remove limit on length of prmstg C C USAGE: call fdebufr ( ofile, tbldir, lentd, tblfil, prmstg, C basic, forcemt, cfms ) C INPUT ARGUMENT LIST: C ofile - character*(*): file to contain verbose output C listing for each decoded BUFR message C tbldir - character*(*): directory containing BUFR tables C to be used for decoding C lentd - integer: length of tbldir string C tblfil - character*(*): file containing BUFR DX dictionary C information to be used for decoding. If set to C 'NULLFILE', then no such file will be used. C basic - character: indicator as to whether the "basic" C option was specified on the command line: C 'Y' = yes C 'N' = no C forcemt - character: indicator as to whether the forced use C of master tables was specified on the command line: C 'Y' = yes C 'N' = no C cfms - character: indicator as to whether code and flag C table meanings should be read from master tables C and included in the print output: C 'Y' = yes C 'N' = no C prmstg - character*(*):string of comma-separated PARAMETER=VALUE C pairs to be used to dynamically allocate memory within C the BUFRLIB, overriding default values that would C otherwise be used. If set to 'NULLPSTG', then no such C string was specified on the command line. Otherwise, C the string can contain up to 20 PARAMETER=VALUE pairs. C C REMARKS: C FORTRAN logical unit numbers 51, 90, 91, 92 and 93 are reserved C for use within this subroutine. C C ATTRIBUTES: C LANGUAGE: FORTRAN 77 C MACHINE: Portable to all platforms C C$$$ USE Share_Table_Info PARAMETER ( MXBF = 2500000 ) PARAMETER ( MXBFD4 = MXBF/4 ) PARAMETER ( MXDS3 = 500 ) PARAMETER ( MXPRMS = 20 ) CHARACTER*(*) ofile, tbldir, tblfil, prmstg LOGICAL exists CHARACTER*120 cmorgc, cmgses, cmmtyp, cmmsbt, cmmsbti CHARACTER*20 ptag ( MXPRMS ), pvtag(2), cprmnm CHARACTER*8 cmgtag CHARACTER*6 cds3 ( MXDS3 ) CHARACTER*1 basic, forcemt, opened, usemt, cfms, + bfmg ( MXBF ) INTEGER ibfmg ( MXBFD4 ) EQUIVALENCE ( bfmg (1), ibfmg (1) ) C----------------------------------------------------------------------- C----------------------------------------------------------------------- C Open the output file. OPEN ( UNIT = 51, FILE = ofile ) C Note that in the below OPEN statement we just need to specify C a dummy placeholder file. lunit = 92 OPEN ( UNIT = lunit, FILE = '/dev/null' ) CALL DATELEN ( 10 ) C Initialize the values in the Share_Table_Info module. ludx = 93 ltbd = lentd ctbldir = tbldir(1:lentd) C Initialize some other values. nmsg = 0 nsubt = 0 opened = 'N' usemt = 'N' DO WHILE ( .true. ) C Get the next message from the input BUFR file. CALL CRBMG ( bfmg, MXBF, nbyt, ierr ) IF ( ierr .ne. 0 ) THEN IF ( ierr .eq. -1 ) THEN WRITE ( UNIT = 51, FMT = '( /, 2A, I7, A, I9, A )') + 'Reached end of BUFR file; it contained a total ', + 'of', nmsg, ' messages and', nsubt, ' subsets' ELSE WRITE ( UNIT = 51, FMT = '( /, 2A, I4 )' ) + 'Error while reading BUFR file; the return code ', + 'from CRBMG = ', IERR ENDIF IF ( ( basic .eq. 'N' ) .and. ( opened .eq. 'Y' ) ) THEN WRITE (51, FMT = '( /, A, / )' ) + 'Here is the DX table that was generated:' CALL DXDUMP ( lunit, 51 ) ENDIF C Close the output file and return. CLOSE ( 51 ) RETURN ENDIF IF ( opened .eq. 'N' ) THEN CALL ISETPRM ( 'MAXCD', MXDS3 ) CALL ISETPRM ( 'MXMSGL', MXBF ) CALL ISETPRM ( 'MAXSS', 300000 ) CALL ISETPRM ( 'NFILES', 2 ) C Process any dynamic allocation parameters that were C passed in on the command line. IF ( prmstg(1:8) .ne. 'NULLPSTG' ) THEN CALL PARSTR ( prmstg, ptag, MXPRMS, nptag, ',', + .false. ) IF ( nptag .gt. 0 ) THEN DO ii = 1, nptag CALL PARSTR ( ptag(ii), pvtag, 2, npvtag, '=', + .false. ) IF ( npvtag .eq. 2 ) THEN CALL STRSUC ( pvtag(1), cprmnm, lcprmnm ) CALL STRNUM ( pvtag(2), ipval ) IF ( ( lcprmnm .gt. 0 ) .and. + ( ipval .ne. -1 ) ) + CALL ISETPRM ( cprmnm(1:lcprmnm), ipval ) ENDIF ENDDO ENDIF ENDIF C Decide how to process the file. IF ( ( IDXMSG ( ibfmg ) .eq. 1 ) .and. + ( forcemt .eq. 'N' ) ) THEN C The first message in the file is a DX dictionary C message, so assume there's an embedded table at the C front of the file and use this table to decode it. CALL OPENBF ( lunit, 'INUL', lunit ) ELSE IF ( ( tblfil(1:8) .ne. 'NULLFILE' ) .and. + ( forcemt .eq. 'N' ) ) THEN C A DX dictionary tables file was specified on the C command line, so use it to decode the BUFR file. INQUIRE ( FILE = tblfil, EXIST = exists ) IF ( .not. exists ) THEN PRINT *, 'ERROR: COULD NOT FIND FILE ', tblfil RETURN ENDIF OPEN ( UNIT = 91, FILE = tblfil, IOSTAT = ier ) IF ( ier .ne. 0 ) THEN PRINT *, 'ERROR: COULD NOT OPEN FILE ', tblfil RETURN ENDIF CALL OPENBF ( lunit, 'IN', 91 ) ELSE C Decode the file using the master tables in tbldir. usemt = 'Y' CALL OPENBF ( lunit, 'SEC3', lunit ) ENDIF opened = 'Y' CALL MTINFO ( tbldir, 90, 91 ) IF ( cfms .eq. 'Y' ) CALL CODFLG ( 'Y' ) ENDIF IF ( basic .eq. 'N' ) THEN C Pass the message to the decoder. CALL READERME ( ibfmg, lunit, cmgtag, imgdt, ierme ) ENDIF C If this is a DX dictionary message, then don't generate any C output unless master tables are being used for decoding. IF ( ( IDXMSG ( ibfmg ) .ne. 1 ) .or. + ( usemt .eq. 'Y' ) ) THEN nmsg = nmsg + 1 WRITE ( UNIT = 51, FMT = '( /, A, I7 )' ) + 'Found BUFR message #', nmsg WRITE (51,*) ' ' WRITE (51,*) ' Message length:', + IUPBS01 ( ibfmg, 'LENM' ) WRITE (51,*) ' Section 0 length:', + IUPBS01 ( ibfmg, 'LEN0' ) WRITE (51,*) ' BUFR edition:', + IUPBS01 ( ibfmg, 'BEN' ) WRITE (51,*) ' ' WRITE (51,*) ' Section 1 length:', + IUPBS01 ( ibfmg, 'LEN1' ) WRITE (51,*) ' Master table:', + IUPBS01 ( ibfmg, 'BMT' ) iogce = IUPBS01 ( ibfmg, 'OGCE' ) igses = IUPBS01 ( ibfmg, 'GSES' ) IF ( ( basic .eq. 'Y' ) .or. + ( cfms .eq. 'N' ) ) THEN WRITE (51,*) ' Originating center:', iogce WRITE (51,*) 'Originating subcenter:', igses ELSE CALL GETCFMNG ( lunit, 'ORIGC', iogce, ' ', -1, + cmorgc, lcmorgc, ierorgc ) IF ( ierorgc .eq. 0 ) THEN WRITE ( 51, FMT= '( A, I4, 3A )' ) + ' Originating center: ', iogce, + ' (= ', cmorgc(1:lcmorgc), ')' ELSE WRITE (51,*) ' Originating center:', iogce ENDIF CALL GETCFMNG ( lunit, 'GSES', igses, + 'ORIGC', iogce, + cmgses, lcmgses, iergses ) IF ( iergses .eq. 0 ) THEN WRITE ( 51, FMT= '( A, I4, 3A )' ) + ' Originating subcenter: ', igses, + ' (= ', cmgses(1:lcmgses), ')' ELSE WRITE (51,*) 'Originating subcenter:', igses ENDIF ENDIF WRITE (51,*) 'Update sequence numbr:', + IUPBS01 ( ibfmg, 'USN' ) IF ( IUPBS01 ( ibfmg, 'ISC2' ) .eq. 1 ) THEN WRITE (51,*) ' Section 2 present?: Yes' ELSE WRITE (51,*) ' Section 2 present?: No' ENDIF mtyp = IUPBS01 ( ibfmg, 'MTYP' ) msbt = IUPBS01 ( ibfmg, 'MSBT' ) msbti = IUPBS01 ( ibfmg, 'MSBTI' ) IF ( ( basic .eq. 'Y' ) .or. + ( cfms .eq. 'N' ) ) THEN WRITE (51,*) ' Data category:', mtyp WRITE (51,*) ' Local subcategory:', msbt WRITE (51,*) 'Internatl subcategory:', msbti ELSE CALL GETCFMNG ( lunit, 'TABLAT', mtyp, ' ', -1, + cmmtyp, lcmmtyp, iermtyp ) IF ( iermtyp .eq. 0 ) THEN WRITE ( 51, FMT= '( A, I4, 3A )' ) + ' Data category: ', mtyp, + ' (= ', cmmtyp(1:lcmmtyp), ')' ELSE WRITE (51,*) ' Data category:', mtyp ENDIF CALL GETCFMNG ( lunit, 'TABLASL', msbt, + 'TABLAT', mtyp, + cmmsbt, lcmmsbt, iermsbt ) IF ( ( iermsbt .eq. 0 ) .and. + ( iogce .eq. 7 ) ) THEN WRITE ( 51, FMT= '( A, I4, 3A )' ) + ' Local subcategory: ', msbt, + ' (= ', cmmsbt(1:lcmmsbt), ')' ELSE WRITE (51,*) ' Local subcategory:', msbt ENDIF CALL GETCFMNG ( lunit, 'TABLASS', msbti, + 'TABLAT', mtyp, + cmmsbti, lcmmsbti, iermsbti ) IF ( iermsbti .eq. 0 ) THEN WRITE ( 51, FMT= '( A, I4, 3A )' ) + ' Internatl subcategory: ', msbti, + ' (= ', cmmsbti(1:lcmmsbti), ')' ELSE WRITE (51,*) 'Internatl subcategory:', msbti ENDIF ENDIF WRITE (51,*) ' Master table version:', + IUPBS01 ( ibfmg, 'MTV' ) WRITE (51,*) ' Local table version:', + IUPBS01 ( ibfmg, 'MTVL' ) WRITE (51,*) ' Year:', + IUPBS01 ( ibfmg, 'YEAR' ) WRITE (51,*) ' Month:', + IUPBS01 ( ibfmg, 'MNTH' ) WRITE (51,*) ' Day:', + IUPBS01 ( ibfmg, 'DAYS' ) WRITE (51,*) ' Hour:', + IUPBS01 ( ibfmg, 'HOUR' ) WRITE (51,*) ' Minute:', + IUPBS01 ( ibfmg, 'MINU' ) WRITE (51,*) ' Second:', + IUPBS01 ( ibfmg, 'SECO' ) IF ( ( iogce .eq. 7 ) .and. ( igses .eq. 3 ) ) THEN CALL RTRCPTB ( ibfmg, iryr, irmo, irdy, irhr, + irmi, irtret ) IF ( irtret .eq. 0 ) THEN WRITE (51,*) ' NCEP tank rcpt year:', iryr WRITE (51,*) ' NCEP tank rcpt month:', irmo WRITE (51,*) ' NCEP tank rcpt day:', irdy WRITE (51,*) ' NCEP tank rcpt hour:', irhr WRITE (51,*) 'NCEP tank rcpt minute:', irmi END IF END IF WRITE (51,*) ' ' nsub = IUPBS3 ( ibfmg, 'NSUB' ) WRITE (51,*) 'Number of data subsets:', nsub nsubt = nsubt + nsub IF ( IUPBS3 ( ibfmg, 'IOBS' ) .eq. 1 ) THEN WRITE (51,*) ' Data are observed?: Yes' ELSE WRITE (51,*) ' Data are observed?: No' ENDIF IF ( IUPBS3 ( ibfmg, 'ICMP' ) .eq. 1 ) THEN WRITE (51,*) ' Data are compressed?: Yes' ELSE WRITE (51,*) ' Data are compressed?: No' ENDIF CALL UPDS3 ( ibfmg, MXDS3, cds3, nds3 ) WRITE (51,*) ' Number of descriptors:', nds3 DO jj = 1, nds3 WRITE ( 51, FMT = '( 5X, I4, A, A6)' ) + jj, ": ", cds3 ( jj ) END DO IF ( ( basic .eq. 'N' ) .and. + ( ierme .ge. 0 ) ) THEN C Decode and output the data from Section 4. WRITE ( UNIT = 51, + FMT = '( /, A, I7, 3A, I10, A, I6, A )' ) + 'BUFR message #', nmsg, ' of type ', cmgtag, + ' and date ', imgdt, ' contains ', nsub, + ' subsets:' DO WHILE ( IREADSB ( lunit ) .eq. 0 ) CALL UFDUMP ( lunit, 51 ) ENDDO ENDIF WRITE ( UNIT = 51, FMT = '( /, A, I7 )' ) + 'End of BUFR message #', nmsg WRITE ( UNIT = 51, FMT = '( /, 120("-"))' ) ENDIF ENDDO RETURN END ------------------------------------------------------------------------------ ---------------------- FORTRAN subroutine "openbt.f" ------------------------ SUBROUTINE OPENBT ( lundx, mtyp ) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C C SUBPROGRAM: OPENBT C PRGMMR: J. ATOR ORG: NP12 DATE: 2012-12-07 C C ABSTRACT: Given a BUFR message type, this subroutine opens the C appropriate DX dictionary table in the specified table directory C as Fortran logical unit "lundx". This subroutine overrides the C default subroutine of the same name in the NCEP BUFRLIB. C C PROGRAM HISTORY LOG: C 2012-12-07 J. ATOR -- ORIGINAL AUTHOR C C USAGE: CALL OPENBT ( lundx, mtyp ) C INPUT ARGUMENT LIST: C mtyp - integer: message type of input BUFR file C C OUTPUT ARGUMENT LIST: C lundx - integer: unit number of BUFR mnemonic table C 0 = unable to open table C C ATTRIBUTES: C LANGUAGE: FORTRAN 90 C MACHINE: Portable to all platforms C C$$$ USE Share_Table_Info CHARACTER*11 bftab CHARACTER*240 bftabfil LOGICAL exists C----------------------------------------------------------------------- C----------------------------------------------------------------------- WRITE ( bftab, '("bufrtab.",i3.3)' ) mtyp bftabfil = ctbldir(1:ltbd) // '/' // bftab INQUIRE ( FILE = bftabfil, EXIST = exists ) IF ( exists ) THEN lundx = ludx CLOSE ( lundx ) OPEN ( UNIT = lundx, FILE = bftabfil ) ELSE lundx = 0 END IF RETURN END ------------------------------------------------------------------------------ ---------------------- FORTRAN module "Share_Table_Info" --------------------- C The following module is used to share information between C subroutine FDEBUFR and subroutine OPENBT, since the latter C is not called by the former but rather is called directly C from within the NCEP BUFRLIB. MODULE Share_Table_Info CHARACTER*120 ctbldir INTEGER ltbd, ludx END MODULE ------------------------------------------------------------------------------
As shown above, this particular application program is designed to be run as a UNIX shell command, with the BUFR file to be decoded as the lone argument. The output file where decoded information is to be printed can be specified via the option -o; otherwise the file "bfbn.debufr.out" is created in the same directory, where "bfbn" is the basename of the BUFR file to be decoded. Similarly, and since the program will need access to master BUFR tables, an option -t is also provided where the directory containing these master tables is located. Note that this same directory name is eventually passed in as an argument to subroutine MTINFO within the FORTRAN code, in order to indicate the location of these master tables to the BUFRLIB software. Finally, note that an additional -b option is also provided in case the user just wants a basic listing of the contents of Sections 0 through 3 of each BUFR message without a full-blown listing of all of the data values in Section 4. For further details see the "USAGE:" section within the documentation block of the above C code. Otherwise, before moving into the FORTRAN code, note that this C code also does a call to COBFL, since we will be demonstrating the use of BUFRLIB's C language interface to read each BUFR message from the specified input file.
Now, within the FORTRAN code, note that we make an initial call to OPENBF, despite the fact that we will be using CRBMG to actually read the BUFR messages from the specified input file. This call to OPENBF is nonetheless needed in order to associate a FORTRAN logical unit number that can later be passed into subroutine READERME, and also to let the BUFRLIB software know (via the use of IO='SEC3') that we want messages decoded according to their Section 3 data description section once we pass them in via READERME later on in the code. Note also that there are several calls to ISETPRM prior to the first call to OPENBF, in order to modify several internal BUFRLIB array size limits from their default values.
After the aforementioned required call to subroutine MTINFO is made, the main loop is entered to read each BUFR message in turn from the specified file using CRBMG, print the basic information from Sections 0 through 3 using multiple successive calls to IUPBS01, IUPBS3, UPDS3 and GETCFMNG, and then (unless the -b option was specified on the command line), pass the message into subroutine READERME, where each data subset can then be read using IREADSB and subsequently printed to the specified output file using subroutine UFDUMP. Finally, after all such BUFR messages have been read and decoded from the file, the program makes a call to subroutine DXDUMP to print a copy of the internal DX table that was automatically generated by the BUFRLIB during processing of the file. Control is then passed back to the above C code, where the final call to CCBFL is made and then the program exits.