closmg.f

Go to the documentation of this file.

C> @file
C> @brief Close and write the current message to a BUFR file that was
C> previously opened for writing.
C>
C> @author J. Woollen, D. Keyser @date 1994-01-06
 
C> This subroutine closes the BUFR message that is currently open for
C> writing within internal arrays associated with logical unit
C> ABS(LUNIN), and it then writes the message to that logical unit.
C>
C> Logical unit ABS(LUNIN) should have already been opened for output
C> operations via a previous call to subroutine openbf().
C>
C> If LUNIN < 0, then any message containing zero data subsets will
C> not be written to logical unit ABS(LUNIN) for the remainder of the
C> life of the application program.  This includes suppressing the
C> writing of any "dummy" messages containing dump center and initiation
C> times that normally appear in the first 2 messages of NCEP dump files.
C>
C> @param[in] LUNIN - integer: Absolute value is Fortran logical unit
C> number for BUFR file
C>
C> @author J. Woollen, D. Keyser @date 1994-01-06
 
      RECURSIVE SUBROUTINE closmg(LUNIN)
 
      USE moda_msgcwd
      USE moda_msglim
      USE moda_bitbuf
      USE modv_im8b
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C  CHECK FOR I8 INTEGERS
C  ---------------------
 
      IF(im8b) THEN
         im8b=.false.
 
         CALL x84(lunin,my_lunin,1)
         CALL closmg(my_lunin)
 
         im8b=.true.
         RETURN
      ENDIF
 
C  CHECK THE FILE STATUS
C  ---------------------
 
      lunit = abs(lunin)
      CALL status(lunit,lun,il,im)
      IF(lunit.NE.lunin) msglim(lun) = 0
      IF(il.EQ.0) GOTO 900
      IF(il.LT.0) GOTO 901
      IF(im.NE.0) THEN
         IF(nsub(lun).GT.0) THEN
            CALL msgwrt(lunit,mbay(1,lun),mbyt(lun))
         ELSE IF(nsub(lun).EQ.0.AND.nmsg(lun).LT.msglim(lun)) THEN
            CALL msgwrt(lunit,mbay(1,lun),mbyt(lun))
         ELSE IF(nsub(lun).LT.0) THEN
            CALL wrcmps(-lunit)
         ENDIF
      ENDIF
      CALL wtstat(lunit,lun,il,0)
 
C  EXITS
C  -----
 
      RETURN
900   CALL bort('BUFRLIB: CLOSMG - OUTPUT BUFR FILE IS CLOSED, IT '//
     . 'MUST BE OPEN FOR OUTPUT')
901   CALL bort('BUFRLIB: CLOSMG - OUTPUT BUFR FILE IS OPEN FOR '//
     . 'INPUT, IT MUST BE OPEN FOR OUTPUT')
      END