<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='CMSGINI'><A href='../../html_code/bufr/cmsgini.f.html#CMSGINI' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE CMSGINI(LUN,MESG,SUBSET,IDATE,NSUB,NBYT) 3,34
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: CMSGINI
C PRGMMR: WOOLLEN ORG: NP20 DATE: 2002-05-14
C
C ABSTRACT: THIS SUBROUTINE INITIALIZES A NEW BUFR MESSAGE FOR OUTPUT
C IN COMPRESSED BUFR. THE ACTUAL LENGTH OF SECTION 4 (CONTAINING
C COMPRESSED DATA) IS ALREADY KNOWN.
C
C PROGRAM HISTORY LOG:
C 2002-05-14 J. WOOLLEN -- ORIGINAL AUTHOR
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; LEN3 INITIALIZED AS
C ZERO (BEFORE WAS UNDEFINED WHEN FIRST
C REFERENCED)
C 2004-08-18 J. ATOR -- ADDED COMMON /MSGSTD/ AND OTHER LOGIC TO
C ALLOW OPTION OF CREATING A SECTION 3 THAT IS
C FULLY WMO-STANDARD; IMPROVED DOCUMENTATION;
C MAXIMUM MESSAGE LENGTH INCREASED FROM
C 20,000 TO 50,000 BYTES
C 2005-11-29 J. ATOR -- CHANGED DEFAULT MASTER TABLE VERSION TO 12
C 2009-05-07 J. ATOR -- CHANGED DEFAULT MASTER TABLE VERSION TO 13;
C REMOVED STANDARDIZATION LOGIC FOR SECTION 3
C
C USAGE: CALL CMSGINI
(LUN, MESG, SUBSET, IDATE, NSUB, NBYT)
C INPUT ARGUMENT LIST:
C LUN - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
C SUBSET - CHARACTER*8: TABLE A MNEMONIC FOR TYPE OF BUFR MESSAGE
C BEING WRITTEN
C IDATE - INTEGER: DATE-TIME STORED WITHIN SECTION 1 OF BUFR
C MESSAGE BEING WRITTEN, IN FORMAT OF EITHER YYMMDDHH OR
C YYYYMMDDHH, DEPENDING ON DATELEN() VALUE
C NSUB - INTEGER: NUMBER OF SUBSETS, STORED IN SECTION 3 OF
C BUFR MESSAGE BEING WRITTEN
C NBYT - INTEGER: ACTUAL LENGTH (IN BYTES) OF "COMPRESSED DATA
C PORTION" OF SECTION 4 (I.E. ALL OF SECTION 4 EXCEPT
C FOR THE FIRST FOUR BYTES)
C
C OUTPUT ARGUMENT LIST:
C MESG - INTEGER: *-WORD PACKED BINARY ARRAY CONTAINING BUFR
C MESSAGE
C NBYT - INTEGER: ACTUAL LENGTH OF BUFR MESSAGE (IN BYTES) UP
C TO THE POINT IN SECTION 4 WHERE COMPRESSED DATA ARE
C TO BE WRITTEN
C
C REMARKS:
C THIS ROUTINE CALLS: BORT I4DY NEMTAB NEMTBA
C PKB PKC
C THIS ROUTINE IS CALLED BY: WRCMPS
C Normally not called by any application
C programs.
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 77
C MACHINE: PORTABLE TO ALL PLATFORMS
C
C$$$
INCLUDE 'bufrlib.prm'
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( 13 , 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