cnved4.f

Go to the documentation of this file.

C> @file
C> @brief Convert a BUFR edition 3 message to BUFR edition 4.

C> This subroutine reads an input BUFR message encoded using BUFR
C> edition 3 and outputs an equivalent BUFR message encoded using
C> BUFR edition 4.
C>
C> <p>This subroutine performs the same function as subroutine pkvs01()
C> when the latter is called with S01MNEM = 'BEN' and IVAL = 4, except
C> that the latter subroutine operates on BUFR messages internally
C> within the software, whereas this subroutine operates on a single
C> BUFR message passed in via a memory array.
C>
C> @author J. Ator
C> @date 2005-11-29
C>
C> @param[in] MSGIN    - integer(*): BUFR message
C> @param[in] LMSGOT   - integer: Dimensioned size (in integers) of
C>                       MSGOT; used by the subroutine to ensure that
C>                       it doesn't overflow the MSGOT array
C> @param[out] MSGOT   - integer(*): Copy of MSGIN encoded using
C>                       BUFR edition 4
C>
C> @remarks
C> - MSGIN and MSGOT must be separate arrays.
C> - BUFR edition 4 messages are usually longer in length than their
C> BUFR edition 3 counterparts, so it's usually a good idea to allow
C> for extra space when allocating MSGOT within the application program.
C>
C> <b>Program history log:</b>
C> - 2005-11-29  J. Ator    -- Original author
C> - 2009-08-12  J. Ator    -- Allow silent return (instead of bort()
C>                           return) if MSGIN is already encoded using
C>                           edition 4
C>
    SUBROUTINE cnved4(MSGIN,LMSGOT,MSGOT)

    dimension msgin(*), msgot(*)

    COMMON /hrdwrd/ nbytw,nbitw,iord(8)

C-----------------------------------------------------------------------
C-----------------------------------------------------------------------

    IF(iupbs01(msgin,'BEN').EQ.4) THEN

C     The input message is already encoded using edition 4, so just
C     copy it from MSGIN to MSGOT and then return.

      nmw = nmwrd(msgin)
      IF(nmw.GT.lmsgot) goto 900 
      DO i = 1, nmw
        msgot(i) = msgin(i)
      ENDDO
      RETURN
    ENDIF

C   Get some section lengths and addresses from the input message.

    CALL getlens(msgin,3,len0,len1,len2,len3,l4,l5)

    iad2 = len0 + len1
    iad4 = iad2 + len2 + len3 

    lenm = iupbs01(msgin,'LENM')

C   Check for overflow of the output array.  Note that the new
C   edition 4 message will be a total of 3 bytes longer than the
C   input message (i.e. 4 more bytes in Section 1, but 1 fewer
C   byte in Section 3).

    lenmot = lenm + 3
    IF(lenmot.GT.(lmsgot*nbytw)) goto 900 

    len1ot = len1 + 4
    len3ot = len3 - 1

C   Write Section 0 of the new message into the output array.

    CALL mvb( msgin, 1, msgot, 1, 4 )
    ibit = 32
    CALL pkb( lenmot, 24, msgot, ibit )
    CALL pkb( 4, 8, msgot, ibit )

C   Write Section 1 of the new message into the output array.

    CALL pkb( len1ot, 24, msgot, ibit )
    CALL pkb( iupbs01(msgin,'BMT'), 8, msgot, ibit )
    CALL pkb( iupbs01(msgin,'OGCE'), 16, msgot, ibit )
    CALL pkb( iupbs01(msgin,'GSES'), 16, msgot, ibit )
    CALL pkb( iupbs01(msgin,'USN'), 8, msgot, ibit )
    CALL pkb( iupbs01(msgin,'ISC2')*128, 8, msgot, ibit )
    CALL pkb( iupbs01(msgin,'MTYP'), 8, msgot, ibit )

C   Set a default of 255 for the international subcategory.

    CALL pkb( 255, 8, msgot, ibit )
    CALL pkb( iupbs01(msgin,'MSBT'), 8, msgot, ibit )
    CALL pkb( iupbs01(msgin,'MTV'), 8, msgot, ibit )
    CALL pkb( iupbs01(msgin,'MTVL'), 8, msgot, ibit )
    CALL pkb( iupbs01(msgin,'YEAR'), 16, msgot, ibit )
    CALL pkb( iupbs01(msgin,'MNTH'), 8, msgot, ibit )
    CALL pkb( iupbs01(msgin,'DAYS'), 8, msgot, ibit )
    CALL pkb( iupbs01(msgin,'HOUR'), 8, msgot, ibit )
    CALL pkb( iupbs01(msgin,'MINU'), 8, msgot, ibit )

C   Set a default of 0 for the second.

    CALL pkb( 0, 8, msgot, ibit )

C   Copy Section 2 (if it exists) through the next-to-last byte
C   of Section 3 from the input array to the output array.

    CALL mvb( msgin, iad2+1, msgot, (ibit/8)+1, len2+len3-1 )

C   Store the length of the new Section 3.

    ibit = ( len0 + len1ot + len2 ) * 8
    CALL pkb( len3ot, 24, msgot, ibit )
    
C   Copy Section 4 and Section 5 from the input array to the
C   output array.

    ibit = ibit + ( len3ot * 8 ) - 24
    CALL mvb( msgin, iad4+1, msgot, (ibit/8)+1, lenm-iad4 )

    RETURN
900 CALL bort('BUFRLIB: CNVED4 - OVERFLOW OF OUTPUT (EDITION 4) '//
     .    'MESSAGE ARRAY; TRY A LARGER DIMENSION FOR THIS ARRAY')
    END