openmg.f

Go to the documentation of this file.

C> @file
C> @brief Open a new message for output in a BUFR file that was
C> previously opened for writing.
 
C> This subroutine opens and initializes a new BUFR message within
C> internal arrays, for eventual output to logical unit LUNIT.
C>
C> @author J. Woollen
C> @date 1994-01-06
C>
C> @param[in] LUNIT -- integer: Fortran logical unit number for BUFR
C>                     file
C> @param[in] SUBSET -- character*(*): Table A mnemonic for type of
C>                      BUFR message to be opened
C>                      (see [DX BUFR Tables](@ref dfbftab) for
C>                      further information about Table A mnemonics)
C> @param[in] JDATE -- integer: Date-time to be stored within Section 1
C>                     of BUFR message being opened, in format of either
C>                     YYMMDDHH or YYYYMMDDHH
C>
C> <p>Logical unit LUNIT should have already been opened for output
C> operations via a previous call to subroutine openbf().
C>
C> <p>This subroutine is similar to subroutine openmb(), except that it
C> will always open a new message for output, regardless of the values
C> of SUBSET and JDATE.  Any existing message within the internal
C> arrays will be automatically flushed and written to logical unit LUNIT
C> via an internal call to subroutine closmg().
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(); modified to make Y2K compliant |
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 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> | 2014-12-10 | J. Ator    | Use modules instead of COMMON blocks |
C>
      SUBROUTINE openmg(LUNIT,SUBSET,JDATE)
 
      USE moda_msgcwd
 
      CHARACTER*(*) SUBSET
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C  CHECK THE FILE STATUS
C  ---------------------
 
      CALL status(lunit,lun,il,im)
      IF(il.EQ.0) GOTO 900
      IF(il.LT.0) GOTO 901
      IF(im.NE.0) CALL closmg(lunit)
      CALL wtstat(lunit,lun,il, 1)
 
C  GET SOME SUBSET PARTICULARS
C  ---------------------------
 
c  .... Given SUBSET, returns MTYP,MSTB,INOD
      CALL nemtba(lun,subset,mtyp,mstb,inod)
c  .... Set pos. index for new Tbl A mnem.
      inode(lun) = inod
c  .... Set date for new message
      idate(lun) = i4dy(jdate)
 
C  INITIALIZE THE OPEN MESSAGE
C  ---------------------------
 
      CALL msgini(lun)
      CALL usrtpl(lun,1,1)
 
C  EXITS
C  -----
 
      RETURN
900   CALL bort('BUFRLIB: OPENMG - OUTPUT BUFR FILE IS CLOSED, IT '//
     . 'MUST BE OPEN FOR OUTPUT')
901   CALL bort('BUFRLIB: OPENMG - OUTPUT BUFR FILE IS OPEN FOR '//
     . 'INPUT, IT MUST BE OPEN FOR OUTPUT')
      END