      SUBROUTINE WRITSA(LUNXX,MSGT,MSGL)

C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    WRITSA
C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
C
C ABSTRACT: THIS SUBROUTINE SHOULD ONLY BE CALLED WHEN LOGICAL UNIT
C   ABS(LUNXX) HAS BEEN OPENED FOR OUTPUT OPERATIONS.
C
C   WHEN LUNXX IS GREATER THAN ZERO, IT PACKS UP THE CURRENT SUBSET
C   WITHIN MEMORY AND THEN TRIES TO ADD IT TO THE BUFR MESSAGE THAT IS
C   CURRENTLY OPEN WITHIN MEMORY FOR ABS(LUNXX).  THE DETERMINATION AS
C   TO WHETHER OR NOT THE SUBSET CAN BE ADDED TO THE MESSAGE IS MADE
C   VIA AN INTERNAL CALL TO ONE OF THE BUFR ARCHIVE LIBRARY SUBROUTINES
C   WRCMPS OR MSGUPD, DEPENDING UPON WHETHER OR NOT THE MESSAGE IS
C   COMPRESSED.  IF IT TURNS OUT THAT THE SUBSET CANNOT BE ADDED TO THE
C   CURRENTLY OPEN MESSAGE, THEN THAT MESSAGE IS FLUSHED TO ABS(LUNXX)
C   AND A NEW ONE IS CREATED IN ORDER TO HOLD THE SUBSET.  AS LONG AS
C   LUNXX IS GREATER THAN ZERO, WRITSA FUNCTIONS EXACTLY LIKE BUFR
C   ARCHIVE LIBRARY SUBROUTINE WRITSB, EXCEPT THAT WRITSA ALSO RETURNS
C   A COPY OF EACH COMPLETED BUFR MESSAGE TO THE APPLICATION PROGRAM
C   IN THE FIRST MSGL WORDS OF ARRAY MSGT.
C
C   ALTERNATIVELY, WHEN LUNXX IS LESS THAN ZERO, THIS IS A SIGNAL TO
C   FORCE ANY CURRENT MESSAGE IN MEMORY TO BE FLUSHED TO ABS(LUNXX) AND
C   RETURNED IN ARRAY MSGT.  IN SUCH CASES, ANY CURRENT SUBSET IN MEMORY
C   IS IGNORED.  THIS OPTION IS NECESSARY BECAUSE ANY MESSAGE RETURNED
C   IN MSGT FROM A CALL TO THIS ROUTINE NEVER CONTAINS THE ACTUAL SUBSET
C   THAT WAS PACKED UP AND STORED DURING THE SAME CALL TO THIS ROUTINE.
C   THEREFORE, THE ONLY WAY TO ENSURE THAT EVERY LAST BUFR SUBSET IS
C   RETURNED WITHIN A BUFR MESSAGE IN MSGT BEFORE, E.G., EXITING THE
C   APPLICATION PROGRAM, IS TO DO ONE FINAL CALL TO THIS ROUTINE WITH
C   LUNXX LESS THAN ZERO IN ORDER TO FORCIBLY FLUSH OUT AND RETURN ONE
C   FINAL BUFR MESSAGE.
C
C PROGRAM HISTORY LOG:
C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
C 1998-07-08  J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
C                           "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
C                           ROUTINE "BORT"
C 2000-09-19  J. WOOLLEN -- MAXIMUM MESSAGE LENGTH INCREASED FROM
C                           10,000 TO 20,000 BYTES
C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
C                           INTERDEPENDENCIES
C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED
C                           DOCUMENTATION (INCLUDING HISTORY); OUTPUTS
C                           MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
C                           TERMINATES ABNORMALLY
C 2004-08-18  J. ATOR    -- ADD POST-MSGUPD CHECK FOR AND RETURN OF
C                           MESSAGE WITHIN MSGT IN ORDER TO PREVENT
C                           LOSS OF MESSAGE IN CERTAIN SITUATIONS;
C                           MAXIMUM MESSAGE LENGTH INCREASED FROM
C                           20,000 TO 50,000 BYTES
C 2005-03-09  J. ATOR    -- ADDED CAPABILITY FOR COMPRESSED MESSAGES
C DART $Id$
C
C USAGE:    CALL WRITSA (LUNXX, MSGT, MSGL)
C   INPUT ARGUMENT LIST:
C     LUNXX    - INTEGER: ABSOLUTE VALUE IS FORTRAN LOGICAL UNIT NUMBER
C                FOR BUFR FILE {IF LUNXX IS LESS THAN ZERO, THEN ANY
C                CURRENT MESSAGE IN MEMORY WILL BE FORCIBLY FLUSHED TO
C                ABS(LUNXX) AND TO ARRAY MSGT}
C
C   OUTPUT ARGUMENT LIST:
C     MSGT     - INTEGER: *-WORD PACKED BINARY ARRAY CONTAINING BUFR
C                MESSAGE (FIRST MSGL WORDS FILLED)
C     MSGL     - INTEGER: NUMBER OF WORDS FILLED IN MSGT
C                       0 = no message was returned
C
C REMARKS:
C    THIS ROUTINE CALLS:        BORT     CLOSMG   MSGUPD   STATUS
C                               WRCMPS   WRTREE
C    THIS ROUTINE IS CALLED BY: WRITCA 
C                               Also called by application programs.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 77
C   MACHINE:  PORTABLE TO ALL PLATFORMS
C
C$$$

      INCLUDE 'bufrlib.prm'

      COMMON /BUFRMG/ MSGLEN,MSGTXT(MXMSGLD4)
      COMMON /MSGCMP/ CCMF

      CHARACTER*1 CCMF

      DIMENSION MSGT(*)

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

      LUNIT = ABS(LUNXX)

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.EQ.0) GOTO 902

C  IF LUNXX < 0, FORCE MEMORY MSG TO BE WRITTEN (W/O ANY CURRENT SUBSET)
C  ---------------------------------------------------------------------

      IF(LUNXX.LT.0) CALL CLOSMG(LUNIT)

C  IS THERE A COMPLETED BUFR MESSAGE TO BE RETURNED?
C  -------------------------------------------------

      IF(MSGLEN.GT.0) THEN
         MSGL = MSGLEN
         DO N=1,MSGL
         MSGT(N) = MSGTXT(N)
         ENDDO
         MSGLEN = 0
      ELSE
         MSGL = 0
      ENDIF

      IF(LUNXX.LT.0) GOTO 100

C  PACK UP THE SUBSET AND PUT IT INTO THE MESSAGE
C  ----------------------------------------------

      CALL WRTREE(LUN)
      IF( CCMF.EQ.'Y' ) THEN
          CALL WRCMPS(LUNIT)
      ELSE
          CALL MSGUPD(LUNIT,LUN)
      ENDIF

C  IF THE JUST-COMPLETED CALL TO WRCMPS OR MSGUPD FOR THIS SUBSET CAUSED
C  A PREVIOUS MESSAGE TO BE FLUSHED TO ABS(LUNXX), THEN RETRIEVE AND
C  RETURN THAT MESSAGE NOW.  OTHERWISE, WE RUN THE RISK THAT THE NEXT
C  CALL TO OPENMB OR OPENMG MIGHT CAUSE A NEWER MESSAGE (WHICH WOULD
C  CONTAIN THE CURRENT SUBSET!) TO BE FLUSHED AND THUS OVERWRITE THE
C  PREVIOUS MESSAGE WITHIN ARRAY MSGTXT BEFORE WE HAD THE CHANCE TO
C  RETRIEVE IT DURING THE NEXT CALL TO WRITSA!

C  NOTE ALSO THAT, IF THE MOST RECENT CALL TO OPENMB OR OPENMG HAD
C  CAUSED A MESSAGE TO BE FLUSHED, IT WOULD HAVE DONE SO IN ORDER TO
C  CREATE A NEW MESSAGE TO HOLD THE CURRENT SUBSET.  THUS, IN SUCH
C  CASES, IT SHOULD NOT BE POSSIBLE THAT THE JUST-COMPLETED CALL TO
C  WRCMPS OR MSGUPD (FOR THIS SAME SUBSET!) WOULD HAVE ALSO CAUSED A
C  MESSAGE TO BE FLUSHED, AND THUS IT SHOULD NOT BE POSSIBLE TO HAVE
C  TWO (2) SEPARATE BUFR MESSAGES RETURNED FROM ONE (1) CALL TO WRITSA!

      IF(MSGLEN.GT.0) THEN
         IF(MSGL.NE.0) GOTO 903
         MSGL = MSGLEN
         DO N=1,MSGL
         MSGT(N) = MSGTXT(N)
         ENDDO
         MSGLEN = 0
      ENDIF

C  EXITS
C  -----

100   RETURN
900   CALL BORT('BUFRLIB: WRITSA - OUTPUT BUFR FILE IS CLOSED, IT '//
     . 'MUST BE OPEN FOR OUTPUT')
901   CALL BORT('BUFRLIB: WRITSA - OUTPUT BUFR FILE IS OPEN FOR '//
     . 'INPUT, IT MUST BE OPEN FOR OUTPUT')
902   CALL BORT('BUFRLIB: WRITSA - A MESSAGE MUST BE OPEN IN OUTPUT '//
     . 'BUFR FILE, NONE ARE')
903   CALL BORT('BUFRLIB: WRITSA - TWO BUFR MESSAGES WERE RETRIEVED '//
     . 'BY ONE CALL TO THIS ROUTINE')
      END
