var/external/bufr/writsb.f

   1       SUBROUTINE WRITSB(LUNIT)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    WRITSB
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS SUBROUTINE SHOULD ONLY BE CALLED WHEN LOGICAL UNIT
   9 C   LUNIT HAS BEEN OPENED FOR OUTPUT OPERATIONS.  IT PACKS UP THE
  10 C   CURRENT SUBSET WITHIN MEMORY AND THEN TRIES TO ADD IT TO THE
  11 C   BUFR MESSAGE THAT IS CURRENTLY OPEN WITHIN MEMORY FOR THIS LUNIT.
  12 C   THE DETERMINATION AS TO WHETHER OR NOT THE SUBSET CAN BE ADDED TO
  13 C   THE MESSAGE IS MADE VIA AN INTERNAL CALL TO ONE OF THE BUFR ARCHIVE
  14 C   LIBRARY SUBROUTINES WRCMPS OR MSGUPD, DEPENDING UPON WHETHER OR NOT
  15 C   THE MESSAGE IS COMPRESSED.  IF IT TURNS OUT THAT THE SUBSET CANNOT
  16 C   BE ADDED TO THE CURRENTLY OPEN MESSAGE, THEN THAT MESSAGE IS
  17 C   FLUSHED TO LUNIT AND A NEW ONE IS CREATED IN ORDER TO HOLD THE
  18 C   SUBSET.
  19 C
  20 C PROGRAM HISTORY LOG:
  21 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  22 C 1998-07-08  J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
  23 C                           "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
  24 C                           ROUTINE "BORT"
  25 C 2003-11-04  J. ATOR    -- ADDED DOCUMENTATION
  26 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  27 C                           INTERDEPENDENCIES
  28 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
  29 C                           DOCUMENTATION; OUTPUTS MORE COMPLETE
  30 C                           DIAGNOSTIC INFO WHEN ROUTINE TERMINATES
  31 C                           ABNORMALLY
  32 C 2005-03-09  J. ATOR    -- ADDED CAPABILITY FOR COMPRESSED MESSAGES
  33 C
  34 C USAGE:    CALL WRITSB (LUNIT)
  35 C   INPUT ARGUMENT LIST:
  36 C     LUNIT    - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
  37 C
  38 C REMARKS:
  39 C    THIS ROUTINE CALLS:        BORT     MSGUPD   STATUS   WRCMPS
  40 C                               WRTREE
  41 C    THIS ROUTINE IS CALLED BY: COPYSB   WRITCP
  42 C                               Also called by application programs.
  43 C
  44 C ATTRIBUTES:
  45 C   LANGUAGE: FORTRAN 77
  46 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  47 C
  48 C$$$
  49
  50       COMMON /MSGCMP/ CCMF
  51
  52       CHARACTER*1 CCMF
  53
  54 C-----------------------------------------------------------------------
  55 C-----------------------------------------------------------------------
  56
  57 C  CHECK THE FILE STATUS
  58 C  ---------------------
  59
  60       CALL STATUS(LUNIT,LUN,IL,IM)
  61       IF(IL.EQ.0) GOTO 900
  62       IF(IL.LT.0) GOTO 901
  63       IF(IM.EQ.0) GOTO 902
  64
  65 C  PACK UP THE SUBSET AND PUT IT INTO THE MESSAGE
  66 C  ----------------------------------------------
  67
  68       CALL WRTREE(LUN)
  69       IF( CCMF.EQ.'Y' ) THEN
  70           CALL WRCMPS(LUNIT)
  71       ELSE
  72           CALL MSGUPD(LUNIT,LUN)
  73       ENDIF
  74
  75 C  EXITS
  76 C  -----
  77
  78       RETURN
  79 900   CALL BORT('BUFRLIB: WRITSB - OUTPUT BUFR FILE IS CLOSED, IT '//
  80      . 'MUST BE OPEN FOR OUTPUT')
  81 901   CALL BORT('BUFRLIB: WRITSB - OUTPUT BUFR FILE IS OPEN FOR '//
  82      . 'INPUT, IT MUST BE OPEN FOR OUTPUT')
  83 902   CALL BORT('BUFRLIB: WRITSB - A MESSAGE MUST BE OPEN IN OUTPUT '//
  84      . 'BUFR FILE, NONE ARE')
  85       END