openbf.f

Go to the documentation of this file.

C> @file
C> @brief Connect a new system file to the BUFRLIB software for
C> reading or writing BUFR messages.

C> This subroutine connects a new file to the BUFRLIB software for
C> input or output operations.
C>
C> @authors J. Woollen
C> @authors J. Ator
C> @authors D. Keyser
C> @date 1994-01-06
C>
C> @param[in] LUNIT   -- integer: Fortran logical unit number for BUFR
C>                       file (unless IO is set to 'FIRST' or 'QUIET', in
C>                       which case this is a dummy argument)
C> @param[in] IO      -- character*(*): flag indicating how LUNIT is to be
C>                       used by the software:
C>                 -   'IN' = input operations with table processing
C>                 -   'INX' = input operations w/o table processing
C>                 -   'OUX' = output operations w/o table processing
C>                 -   'OUT' = output operations with table processing
C>                 -  'SEC3' = same as 'IN', except use Section 3 of input 
C>                              messages for decoding rather than DX BUFR
C>                              table information from LUNDX; in this case
C>                              LUNDX is ignored, and user must provide 
C>                              appropriate [master BUFR tables](@ref dfbfmstab)
C>                              within the directory specified by a subsequent
C>                              call to subroutine mtinfo()
C>                 -  'NODX' = same as 'OUT', except don't write DX BUFR
C>                             table messages to LUNIT
C>                 -   'APN' = same as 'NODX', except begin writing at end
C>                             of file ("append")
C>                 -   'APX' = same as 'APN', except backspace before
C>                             appending
C>                 -   'NUL' = same as 'OUT', except don't write any
C>                             messages whatsoever to LUNIT (e.g. when
C>                             subroutine writsa() is to be used)
C>                 -  'INUL' = same as 'IN', except don't read any
C>                             messages whatsoever from LUNIT (e.g. when
C>                             subroutine readerme() is to be used)
C>                 - 'QUIET' = LUNIT is ignored; this is an indicator
C>                             that the value for IPRT in COMMON block
C>                             /QUIET/ is being reset to the value in
C>                             LUNDX
C>                 - 'FIRST' = LUNIT and LUNDX are ignored; this is an
C>                             indicator to initialize the BUFRLIB
C>                             software, in case this subroutine was
C>                             never previously called
C> @param[in] LUNDX   -- integer:
C>                 - If IO is not set to 'FIRST' or 'QUIET' =
C>                   Fortran logical unit number
C>                   containing DX BUFR table information to be used in
C>                   reading/writing from/to LUNIT (depending on the case).
C>                   This value may be set equal to LUNIT if DX BUFR table
C>                   information is already embedded in LUNIT.
C>                 - If IO is set to 'QUIET' = indicator for degree of
C>                   printout:
C>                      - -1 = no printout except for ABORT messages
C>                      -  0 = limited printout (default)
C>                      -  1 = all warning messages are printed out
C>                      -  2 = all warning and informational messages are
C>                             printed out
C>
C> <p>The logical unit numbers LUNIT and LUNDX must already be associated
C> with actual filenames on the local system, typically via a Fortran "OPEN"
C> statement. Multiple logical units can be connected to the BUFRLIB software
C> at any one time.
C>
C> <p>The argument IO is a character string describing how the file connected to
C> LUNIT will be used, e.g. 'IN' is used to access an existing file of BUFR
C> messages for input (i.e. reading/decoding BUFR), and 'OUT' is used to access
C> a new file for output (i.e. writing/encoding BUFR). An option 'APX' is also
C> available which behaves like 'OUT', except that output is then appended to
C> an existing BUFR file rather than creating a new one from scratch, and there
C> are also some additional options 'NUL' and 'NODX' which can likewise be used
C> instead of 'OUT' for some very special cases as needed. There's also an
C> option 'SEC3' which can be used in place of 'IN' for certain cases when the
C> user is attempting to read BUFR messages whose content and descriptor layout
C> are unknown in advance. However, all of these additional options are
C> basically just variations of 'IN' or 'OUT', again depending on whether the
C> intent is to read or write BUFR messages from the file connected to LUNIT.
C> The only exceptions are when IO = 'FIRST' or 'QUIET'.  When IO = 'FIRST',
C> the subroutine simply checks whether it has already been called from within
C> the application program and, if not, goes ahead and initializes the library
C> without actually connecting any files in LUNIT or LUNDX.
C> Alternatively, when IO = 'QUIET', the subroutine simply sets or resets the
C> internal print verbosity switch to the value of input argument LUNDX,
C> overriding its previous value and/or its internal default value of 0.
C>
C> <p>The third and final call argument LUNDX identifies the logical unit which
C> contains the definition of the DX BUFR tables to be associated with unit
C> LUNIT.  Except when IO = 'SEC3', every BUFR file that is linked to the BUFRLIB
C> software must have a DX BUFR tables file associated with it, and these tables
C> may be defined within a separate ASCII text file
C> (see [Description and Format of DX BUFR Tables](@ref dfbftab) for more info.)
C> or, in the case of an existing BUFR file, may be embedded within the first few
C> BUFR messages of the file itself, and in which case the user can denote this
C> to the subroutine by setting LUNDX to the same value as LUBFR.
C>
C> @remarks
C> - When an existing BUFR file is accessed for input (i.e. reading/decoding BUFR),
C> the associated DX BUFR tables defined by LUNDX are stored internally within
C> the BUFRLIB software and are referenced during all subsequent processing of
C> the file. Likewise, when a file is accessed for output (i.e. writing/encoding
C> BUFR), the associated DX BUFR tables are still stored internally for subsequent
C> reference; however, the output file itself is also initialized by writing the
C> BUFR table information (as one or more BUFR messages) to the beginning of the
C> file, except when IO = 'NODX', and in which case the writing of these
C> additional messages is suppressed.
C> - As noted above, 'SEC3' is the only value of IO (other than 'QUIET') where it's
C> not necessary to provide pre-defined DX BUFR tables via LUNDX.  Instead, this
C> option instructs the BUFRLIB software to unpack the data description section
C> (Section 3) from each BUFR message it reads and then decode the contents
C> accordingly. In this case, it's necessary to provide a set of BUFR master
C> tables containing listings of all possible BUFR descriptors
C> (see [Description and Format of master BUFR Tables](@ref dfbfmstab) for more
C> info.), but otherwise no prior knowledge is required of the contents of the
C> messages to be decoded.
C>
C> <b>Program history log:</b>
C> | Date | Programmer | Comments |
C> | -----|------------|----------|
C> | 1994-01-06 | J. Woollen | Original author |
C> | 1998-07-08 | J. Woollen | Replaced call to Cray library routine ABORT with call to new internal routine bort() |
C> | 1999-11-18 | J. Woollen | The number of BUFR files which can be opened at one time increased from 10 to 32 |
C> | 2003-11-04 | J. Ator    | Added IO='NUL' option to prevent later writing to BUFR file in LUNIT; added documentation |
C> | 2003-11-04 | S. Bender  | Added remarks and routine interdependencies |
C> | 2003-11-04 | D. Keyser  | Unified/portable for WRF; added documentation; outputs more complete diagnostic info when routine terminates abnormally |
C> | 2004-08-18 | J. Ator    | Added SAVE for IFIRST flag and IO="NODX" option |
C> | 2005-11-29 | J. Ator    | Added COMMON /MSGFMT/ and ichkstr() call |
C> | 2009-03-23 | J. Ator    | Added IO='SEC3' option; removed call to posapn; clarified comments; use errwrt() |
C> | 2010-05-11 | J. Ator    | Added COMMON /STCODE/ |
C> | 2012-06-18 | J. Ator    | Added IO='INUL' option |
C> | 2012-09-15 | J. Woollen | Modified for C/I/O/BUFR interface; use INQUIRE to obtain filename; use openrb(), openwb() and openab(); add IO types 'INX' and 'FIRST' |
C> | 2014-11-07 | J. Ator    | Allow dynamic allocation of certain arrays |
C> | 2015-03-03 | J. Ator    | Use MODA_IFOPBF instead of IFIRST |
C>
      SUBROUTINE openbf(LUNIT,IO,LUNDX)

      USE modv_ifopbf
      USE moda_msgcwd
      USE moda_stbfr
      USE moda_sc3bfr
      USE moda_lushr
      USE moda_nulbfr
      USE moda_stcode

      COMMON /quiet / iprt

      CHARACTER*(*) io
      CHARACTER*255 filename,fileacc   
      CHARACTER*128 bort_str,errstr
      CHARACTER*28  cprint(0:3)
      CHARACTER*1   bstr(4)

      DATA          cprint/
     . ' (only ABORTs)              ',
     . ' (limited - default)        ',
     . ' (all warnings)             ',
     . ' (all warning+informational)'/

C-----------------------------------------------------------------------
C-----------------------------------------------------------------------

C     If this is the first call to this subroutine, initialize
C     IPRT in /QUIET/ as 0 (limited printout - except for abort
C     messages)

      IF(ifopbf.EQ.0) iprt = 0

      IF(io.EQ.'QUIET') THEN
c  .... override previous IPRT value (printout indicator)
         IF(lundx.LT.-1)  lundx = -1
         IF(lundx.GT. 2)  lundx =  2
         IF(lundx.GE.0) THEN
      CALL errwrt('++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
      WRITE ( unit=errstr, fmt='(A,I3,A,A,I3,A)' )
     . 'BUFRLIB: OPENBF - DEGREE OF MESSAGE PRINT INDICATOR '//
     . 'CHNGED FROM',iprt,cprint(iprt+1),' TO',lundx,cprint(lundx+1)
      CALL errwrt(errstr)
      CALL errwrt('++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
      CALL errwrt(' ')
         ENDIF
         iprt = lundx
      ENDIF

      IF(ifopbf.EQ.0) THEN

C        This is the first call to this subroutine, so take care of some
C        initial housekeeping tasks.  Note that ARALLOCF, ARALLOCC, and
C        WRDLEN must all be called prior to calling BFRINI.

C        Allocate any arrays which are being dynamically sized.
         CALL arallocf
         CALL arallocc

C        Figure out some important information about the local machine.
         CALL wrdlen
       
C        Initialize some global variables.
         CALL bfrini

         ifopbf = 1
      ENDIF

      IF(io.EQ.'FIRST') goto 100
      IF(io.EQ.'QUIET') goto 100

C  SEE IF A FILE CAN BE OPENED
C  ---------------------------

      CALL status(lunit,lun,il,im)
      IF(lun.EQ.0) goto 900
      IF(il .NE.0) goto 901
      null(lun) = 0
      isc3(lun) = 0
      iscodes(lun) = 0
      lus(lun) = 0

C  USE INQUIRE TO OBTAIN THE FILENAME ASSOCIATED WITH UNIT LUNIT
C  -------------------------------------------------------------

      IF (io.NE.'NUL' .AND. io.NE.'INUL') THEN
         INQUIRE(lunit,access=fileacc)
         IF(fileacc=='UNDEFINED') OPEN(lunit)
         INQUIRE(lunit,name=filename)
         filename=trim(filename)//char(0)
      ENDIF

C  SET INITIAL OPEN DEFAULTS (CLEAR OUT A MSG CONTROL WORD PARTITION)
C  ------------------------------------------------------------------

      nmsg(lun) = 0
      nsub(lun) = 0
      msub(lun) = 0
      inode(lun) = 0
      idate(lun) = 0

C  DECIDE HOW TO OPEN THE FILE AND SETUP THE DICTIONARY
C  ----------------------------------------------------

      IF(io.EQ.'IN') THEN
         CALL openrb(lun,filename)
         CALL wtstat(lunit,lun,-1,0)
         CALL readdx(lunit,lun,lundx)
      ELSE IF(io.EQ.'INUL') THEN
         CALL wtstat(lunit,lun,-1,0)
         IF(lunit.NE.lundx) CALL readdx(lunit,lun,lundx)
         null(lun) = 1
      ELSE IF(io.EQ.'NUL') THEN
         CALL wtstat(lunit,lun, 1,0)
         IF(lunit.NE.lundx) CALL readdx(lunit,lun,lundx)
         null(lun) = 1
      ELSE IF(io.EQ.'INX') THEN
         CALL openrb(lun,filename)
         CALL wtstat(lunit,lun,-1,0)
         null(lun) = 1
      ELSE IF(io.EQ.'OUX') THEN
         CALL openwb(lun,filename)
         CALL wtstat(lunit,lun, 1,0)
      ELSE IF(io.EQ.'SEC3') THEN
         CALL openrb(lun,filename)
         CALL wtstat(lunit,lun,-1,0)
         isc3(lun) = 1
      ELSE IF(io.EQ.'OUT') THEN
         CALL openwb(lun,filename)
         CALL wtstat(lunit,lun, 1,0)
         CALL writdx(lunit,lun,lundx)
      ELSE IF(io.EQ.'NODX') THEN
         CALL openwb(lun,filename)
         CALL wtstat(lunit,lun, 1,0)
         CALL readdx(lunit,lun,lundx)
      ELSE IF(io.EQ.'APN' .OR. io.EQ.'APX') THEN
         CALL openab(lun,filename)
         CALL wtstat(lunit,lun, 1,0)
         IF(lunit.NE.lundx) CALL readdx(lunit,lun,lundx)
         CALL posapx(lunit)
      ELSE
         goto 904
      ENDIF

      goto 100

C     FILE OPENED FOR INPUT IS EMPTY - LET READMG OR READERME GIVE
C     THE BAD NEWS LATER

200   rewind lunit
      IF(iprt.GE.0) THEN
      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      WRITE ( unit=errstr, fmt='(A,I3,A)' )
     .  'BUFRLIB: OPENBF - INPUT BUFR FILE IN UNIT ', lunit,
     .  ' IS EMPTY'
      CALL errwrt(errstr)
      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      CALL errwrt(' ')
      ENDIF
      CALL wtstat(lunit,lun,-1,0)

C  INITIALIZE THE DICTIONARY TABLE PARTITION
C  -----------------------------------------

      CALL dxinit(lun,0)

C  EXITS
C  -----

100   RETURN
900   WRITE(bort_str,'("BUFRLIB: OPENBF - THERE ARE ALREADY",I3,'//
     . '" BUFR FILES OPENED, CANNOT OPEN FILE CONNECTED TO UNIT",I4)')
     . nfiles,lunit
      CALL bort(bort_str)
901   WRITE(bort_str,'("BUFRLIB: OPENBF - THE FILE CONNECTED TO UNIT"'//
     . ',I5," IS ALREADY OPEN")') lunit
      CALL bort(bort_str)
904   CALL bort('BUFRLIB: OPENBF - SECOND (INPUT) ARGUMENT MUST BE'//
     . ' "IN", "OUT", "NODX", "NUL", "APN", "APX", "SEC3"'//
     . ' OR "QUIET"')
      END