dxmini.f

Go to the documentation of this file.

C> @file
C> @brief Initialize a DX BUFR tables message.
C> @author Woollen @date 1994-01-06
 
C> This subroutine initializes a DX BUFR tables (dictionary)
C> message, writing all the preliminary information into Sections 0,
C> 1, 3, 4.  Subroutine wrdxtb() will write the
C> actual table information into the message.
C>
C> @param[out] MBAY - integer: BUFR message.
C> @param[out] MBYT - integer: length (in bytes) of BUFR message.
C> @param[out] MB4 - integer: byte number in message of first byte in Section 4.
C> @param[out] MBA - integer: byte number in message of fourth byte in Section 4.
C> @param[out] MBB - integer: byte number in message of fifth byte in Section 4.
C> @param[out] MBD - integer: byte number in message of sixth byte in Section 4.
C>
C> @author Woollen @date 1994-01-06
      SUBROUTINE dxmini(MBAY,MBYT,MB4,MBA,MBB,MBD)
 
      USE modv_mxmsgl
 
      COMMON /dxtab / maxdx,idxv,nxstr(10),ldxa(10),ldxb(10),ldxd(10),
     .                ld30(10),dxstr(10)
 
      CHARACTER*128 BORT_STR
      CHARACTER*56  DXSTR
      dimension     mbay(*)
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
c  .... The local message subtype is set to the version number of the
c       local tables (here = 1)
      msbt = idxv
 
C  INITIALIZE THE MESSAGE
C  ----------------------
 
      mbit = 0
      DO i=1,mxmsgld4
      mbay(i) = 0
      ENDDO
 
C  For dictionary messages, the Section 1 date is simply zeroed out.
C  (Note that there is logic in function IDXMSG which relies on this!)
 
      ih   = 0
      id   = 0
      im   = 0
      iy   = 0
 
c  Dictionary messages get type 11 (see WMO Table A)
      mtyp = 11
      nsub = 1
 
      idxs = idxv+1
      ldxs = nxstr(idxs)
 
      nby0 = 8
      nby1 = 18
      nby2 = 0
      nby3 = 7 + nxstr(idxs) + 1
      nby4 = 7
      nby5 = 4
      mbyt = nby0+nby1+nby2+nby3+nby4+nby5
 
      IF(mod(nby3,2).NE.0) GOTO 900
 
C  SECTION 0
C  ---------
 
      CALL pkc('BUFR' ,  4 , mbay,mbit)
      CALL pkb(  mbyt , 24 , mbay,mbit)
      CALL pkb(     3 ,  8 , mbay,mbit)
 
C  SECTION 1
C  ---------
 
      CALL pkb(  nby1 , 24 , mbay,mbit)
      CALL pkb(     0 ,  8 , mbay,mbit)
      CALL pkb(     3 ,  8 , mbay,mbit)
      CALL pkb(     7 ,  8 , mbay,mbit)
      CALL pkb(     0 ,  8 , mbay,mbit)
      CALL pkb(     0 ,  8 , mbay,mbit)
      CALL pkb(  mtyp ,  8 , mbay,mbit)
      CALL pkb(  msbt ,  8 , mbay,mbit)
      CALL pkb(    36 ,  8 , mbay,mbit)
      CALL pkb(  idxv ,  8 , mbay,mbit)
      CALL pkb(    iy ,  8 , mbay,mbit)
      CALL pkb(    im ,  8 , mbay,mbit)
      CALL pkb(    id ,  8 , mbay,mbit)
      CALL pkb(    ih ,  8 , mbay,mbit)
      CALL pkb(     0 ,  8 , mbay,mbit)
      CALL pkb(     0 ,  8 , mbay,mbit)
 
C  SECTION 3
C  ---------
 
      CALL pkb(       nby3 ,   24 , mbay,mbit)
      CALL pkb(          0 ,    8 , mbay,mbit)
      CALL pkb(          1 ,   16 , mbay,mbit)
      CALL pkb(       2**7 ,    8 , mbay,mbit)
      DO i=1,ldxs
      CALL pkb(iupm(dxstr(idxs)(i:i),8),8,mbay,mbit)
      ENDDO
      CALL pkb(          0 ,    8 , mbay,mbit)
 
C  SECTION 4
C  ---------
 
      mb4 = mbit/8+1
      CALL pkb(nby4 , 24 , mbay,mbit)
      CALL pkb(   0 ,  8 , mbay,mbit)
      mba = mbit/8+1
      CALL pkb(   0 ,  8 , mbay,mbit)
      mbb = mbit/8+1
      CALL pkb(   0 ,  8 , mbay,mbit)
      mbd = mbit/8+1
      CALL pkb(   0 ,  8 , mbay,mbit)
 
      IF(mbit/8+nby5.NE.mbyt) GOTO 901
 
C  EXITS
C  -----
 
      RETURN
900   CALL bort
     . ('BUFRLIB: DXMINI - LENGTH OF SECTION 3 IS NOT A MULTIPLE OF 2')
901   WRITE(bort_str,'("BUFRLIB: DXMINI - NUMBER OF BYTES STORED FOR '//
     . 'A MESSAGE (",I6,") IS NOT THE SAME AS FIRST CALCULATED, MBYT '//
     . '(",I6)') mbit/8+nby5,mbyt
      CALL bort(bort_str)
      END