cmsgini.f

Go to the documentation of this file.

C> @file
C> @brief Initialize a new compressed BUFR message for output.
C>
C> @author Woollen @date 2002-05-14
 
C> This subroutine initializes a new BUFR message for output in compressed format.
C>
C> @param[in] LUN - integer: I/O stream index into internal memory arrays.
C> @param[out] MESG - integer(*): BUFR message.
C> @param[in] SUBSET - character*8: Table A mnemonic for type of BUFR message being written.
C> @param[in] IDATE - integer: date-time stored within Section 1 of BUFR message being written,
C>                    in format of either YYMMDDHH or YYYYMMDDHH, depending on datelen() value.
C> @param[in] NSUB - integer: number of subsets in MESG
C> @param[inout] NBYT - integer:
C>                      - On input, contains the length (in bytes) of Section 4, except for
C>                        the first 4 bytes
C>                      - On output, contains the length (in bytes) of the entire BUFR message, up
C>                        to the point in Section 4 where compressed data are to be written
C>
C> @author Woollen @date 2002-05-14
 
      SUBROUTINE cmsgini(LUN,MESG,SUBSET,IDATE,NSUB,NBYT)
 
      CHARACTER*128 BORT_STR
      CHARACTER*8   SUBSET
      CHARACTER*4   BUFR
      CHARACTER*1   TAB
      dimension     mesg(*)
 
      DATA bufr/'BUFR'/
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C  GET THE MESSAGE TAG AND TYPE, AND BREAK UP THE DATE
C  ---------------------------------------------------
 
c  .... Given SUBSET, NEMTBA returns MTYP,MSBT,INOD
      CALL nemtba(lun,subset,mtyp,msbt,inod)
      CALL nemtab(lun,subset,isub,tab,iret)
      IF(iret.EQ.0) GOTO 900
 
C  DATE CAN BE YYMMDDHH OR YYYYMMDDHH
C  ----------------------------------
 
      jdate = i4dy(idate)
      mcen = mod(jdate/10**8,100)+1
      mear = mod(jdate/10**6,100)
      mmon = mod(jdate/10**4,100)
      mday = mod(jdate/10**2,100)
      mour = mod(jdate      ,100)
      mmin = 0
 
c  .... DK: Don't think this can happen, because IDATE=0 is returned
c           as 2000000000 by I4DY meaning MCEN would be 21
      IF(mcen.EQ.1) GOTO 901
 
      IF(mear.EQ.0) mcen = mcen-1
      IF(mear.EQ.0) mear = 100
 
C  INITIALIZE THE MESSAGE
C  ----------------------
 
      mbit = 0
 
C  SECTION 0
C  ---------
 
      CALL pkc(bufr ,  4 , mesg,mbit)
 
C     NOTE THAT THE ACTUAL SECTION 0 LENGTH WILL BE COMPUTED AND
C     STORED BELOW; FOR NOW, WE ARE REALLY ONLY INTERESTED IN
C     ADVANCING MBIT BY THE CORRECT AMOUNT, SO WE'LL JUST STORE
C     A DEFAULT VALUE OF 0.
 
      CALL pkb(   0 , 24 , mesg,mbit)
      CALL pkb(   3 ,  8 , mesg,mbit)
 
C  SECTION 1
C  ---------
 
      len1 = 18
 
      CALL pkb(len1 , 24 , mesg,mbit)
      CALL pkb(   0 ,  8 , mesg,mbit)
      CALL pkb(   3 ,  8 , mesg,mbit)
      CALL pkb(   7 ,  8 , mesg,mbit)
      CALL pkb(   0 ,  8 , mesg,mbit)
      CALL pkb(   0 ,  8 , mesg,mbit)
      CALL pkb(mtyp ,  8 , mesg,mbit)
      CALL pkb(msbt ,  8 , mesg,mbit)
      CALL pkb(  36 ,  8 , mesg,mbit)
      CALL pkb(   0 ,  8 , mesg,mbit)
      CALL pkb(mear ,  8 , mesg,mbit)
      CALL pkb(mmon ,  8 , mesg,mbit)
      CALL pkb(mday ,  8 , mesg,mbit)
      CALL pkb(mour ,  8 , mesg,mbit)
      CALL pkb(mmin ,  8 , mesg,mbit)
      CALL pkb(mcen ,  8 , mesg,mbit)
 
C  SECTION 3
C  ---------
 
      len3 = 10
 
      CALL pkb(len3 , 24 , mesg,mbit)
      CALL pkb(   0 ,  8 , mesg,mbit)
      CALL pkb(nsub , 16 , mesg,mbit)
      CALL pkb( 192 ,  8 , mesg,mbit)
      CALL pkb(isub , 16 , mesg,mbit)
      CALL pkb(   0 ,  8 , mesg,mbit)
 
C  SECTION 4
C  ---------
 
C     STORE THE TOTAL LENGTH OF SECTION 4.
 
C     REMEMBER THAT THE INPUT VALUE OF NBYT ONLY CONTAINS THE
C     LENGTH OF THE "COMPRESSED DATA PORTION" OF SECTION 4, SO
C     WE NEED TO ADD FOUR BYTES TO THIS NUMBER IN ORDER TO
C     ACCOUNT FOR THE TOTAL LENGTH OF SECTION 4.
 
      CALL pkb((nbyt+4) , 24 , mesg,mbit)
      CALL pkb(       0 ,  8 , mesg,mbit)
 
C     THE ACTUAL "COMPRESSED DATA PORTION" OF SECTION 4 WILL
C     BE FILLED IN LATER BY SUBROUTINE WRCMPS.
 
C  SECTION 5
C  ---------
 
C     THIS SECTION WILL BE FILLED IN LATER BY SUBROUTINE WRCMPS.
 
C  RETURN WITH THE CORRECT NEW MESSAGE BYTE COUNT
C  ----------------------------------------------
 
C     NOW, NOTING THAT MBIT CURRENTLY POINTS TO THE LAST BIT OF
C     THE FOURTH BYTE OF SECTION 4, THEN WE HAVE:
C     (TOTAL LENGTH OF BUFR MESSAGE (IN SECTION 0)) =
C            (LENGTH OF MESSAGE UP THROUGH FOURTH BYTE OF SECTION 4)
C         +  (LENGTH OF "COMPRESSED DATA PORTION" OF SECTION 4)
C         +  (LENGTH OF SECTION 5)
      mbyt =
     .       mbit/8
     .    +  nbyt
     .    +  4
 
C     NOW, MAKE NBYT POINT TO THE CURRENT LOCATION OF MBIT
C     (I.E. THE BYTE AFTER WHICH TO ACTUALLY BEGIN WRITING THE
C     COMPRESSED DATA INTO SECTION 4).
 
      nbyt = mbit/8
 
C     NOW, STORE THE TOTAL LENGTH OF THE BUFR MESSAGE (IN SECTION 0).
 
      mbit = 32
      CALL pkb(mbyt,24,mesg,mbit)
 
C  EXITS
C  -----
 
      RETURN
900   WRITE(bort_str,'("BUFRLIB: CMSGINI - TABLE A MESSAGE TYPE '//
     . 'MNEMONIC ",A," NOT FOUND IN INTERNAL TABLE D ARRAYS")') subset
      CALL bort(bort_str)
901   CALL bort
     . ('BUFRLIB: CMSGINI - BUFR MESSAGE DATE (IDATE) is 0000000000')
      END