dxmini.f

Go to the documentation of this file.

C> @file
C> @author WOOLLEN @date 1994-01-06
      
C> THIS SUBROUTINE INITIALIZES A BUFR TABLE (DICTIONARY)
C>   MESSAGE, WRITING ALL THE PRELIMINARY INFORMATION INTO SECTIONS 0,
C>   1, 3, 4.  BUFR ARCHIVE LIBRARY SUBROUTINE WRDXTB WILL WRITE THE
C>   ACTUAL TABLE INFORMATION INTO THE MESSAGE.
C>
C> PROGRAM HISTORY LOG:
C> 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
C> 1997-07-29  J. WOOLLEN -- MODIFIED TO UPDATE THE CURRENT BUFR VERSION
C>                           WRITTEN IN SECTION 0 FROM 2 TO 3
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-09  J. ATOR    -- 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> 2019-05-21  J. ATOR    -- CHANGED DEFAULT MASTER TABLE VERSION TO 29 
C> 2021-05-14  J. ATOR    -- CHANGED DEFAULT MASTER TABLE VERSION TO 36
C>
C> USAGE:    CALL DXMINI (LUN, MBAY, MBYT, MB4, MBA, MBB, MBD)
C>   INPUT ARGUMENT LIST:
C>     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
C>
C>   OUTPUT ARGUMENT LIST:
C>     MBAY     - INTEGER: (MXMSGLD4)-WORD PACKED BINARY ARRAY
C>                CONTAINING BUFR MESSAGE
C>     MBYT     - INTEGER: LENGTH OF BUFR MESSAGE (BYTES)
C>     MB4      - INTEGER: BYTE NUMBER IN MESSAGE OF FIRST BYTE IN
C>                SECTION 4
C>     MBA      - INTEGER: BYTE NUMBER IN MESSAGE OF FOURTH BYTE IN
C>                SECTION 4
C>     MBB      - INTEGER: BYTE NUMBER IN MESSAGE OF FIFTH BYTE IN
C>                SECTION 4
C>     MBD      - INTEGER: BYTE NUMBER IN MESSAGE OF SIXTH BYTE IN
C>                SECTION 4
C>
C> REMARKS:
C>    ARGUMENT LUN IS NOT REFERENCED IN THIS SUBROUTINE.  IT IS LEFT
C>    HERE IN CASE AN APPLICATION PROGRAM CALLS THIS SUBROUTINE.
C>
C>    THIS ROUTINE CALLS:        BORT     IUPM     PKB      PKC
C>    THIS ROUTINE IS CALLED BY: WRDXTB
C>                               Normally not called by any application
C>                               programs.
C>
      SUBROUTINE dxmini(LUN,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