openbf.f

Go to the documentation of this file.

C> @file
C> @brief Connect a new file to the library, or initialize the
C> library, or change verbosity associated with already-connected file.
C>
C> @authors J. Woollen, J. Ator,  D. Keyser @date 1994-01-06
 
C> Connects a new file to the NCEPLIBS-bufr software for
C> input or output operations, or initializes the library without
C> connecting to a file, or changes the verbosity of the library for an
C> already-connected BUFR file.
C>
C> 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 NCEPLIBS-bufr software
C> at any one time.
C>
C> 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>
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> 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 NCEPLIBS-bufr
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 NCEPLIBS-bufr 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 NCEPLIBS-bufr 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>
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 NCEPLIBS-bufr
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> @authors J. Woollen, J. Ator,  D. Keyser @date 1994-01-06
 
      RECURSIVE SUBROUTINE openbf(LUNIT,IO,LUNDX)
 
      use bufrlib
 
      USE modv_ifopbf
      USE modv_nfiles
      USE modv_im8b
 
      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)
 
      DATA          cprint/
     . ' (only ABORTs)              ',
     . ' (limited - default)        ',
     . ' (all warnings)             ',
     . ' (all warning+informational)'/
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C  CHECK FOR I8 INTEGERS
C  ---------------------
 
      IF(im8b) THEN
         im8b=.false.
 
         CALL x84(lunit,my_lunit,1)
         CALL x84(lundx,my_lundx,1)
         CALL openbf(my_lunit,io,my_lundx)
 
         im8b=.true.
         RETURN
      ENDIF
 
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)
         iprtprv = iprt
         iprt = lundx
         IF(iprt.LT.-1) iprt = -1
         IF(iprt.GT. 2) iprt =  2
         IF(iprt.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',iprtprv,cprint(iprtprv+1),' TO',iprt,cprint(iprt+1)
      CALL errwrt(errstr)
      CALL errwrt('++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
      CALL errwrt(' ')
         ENDIF
      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_C, 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
 
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_c(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_c(lun,filename)
         CALL wtstat(lunit,lun,-1,0)
         null(lun) = 1
      ELSE IF(io.EQ.'OUX') THEN
         CALL openwb_c(lun,filename)
         CALL wtstat(lunit,lun, 1,0)
      ELSE IF(io.EQ.'SEC3') THEN
         CALL openrb_c(lun,filename)
         CALL wtstat(lunit,lun,-1,0)
         isc3(lun) = 1
      ELSE IF(io.EQ.'OUT') THEN
         CALL openwb_c(lun,filename)
         CALL wtstat(lunit,lun, 1,0)
         CALL writdx(lunit,lun,lundx)
      ELSE IF(io.EQ.'NODX') THEN
         CALL openwb_c(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_c(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
 
      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