cnved4.f

Go to the documentation of this file.

C> @file
C> @brief Convert a BUFR edition 3 message to BUFR edition 4.
C>
C> @author J. Ator @date 2005-11-29
 
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> 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> @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> @author J. Ator @date 2005-11-29
        RECURSIVE SUBROUTINE cnved4(MSGIN,LMSGOT,MSGOT)
 
        USE modv_im8b
 
        dimension msgin(*), msgot(*)
 
        COMMON /hrdwrd/ nbytw,nbitw,iord(8)
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C       Check for I8 integers.
 
        IF(im8b) THEN
           im8b=.false.
 
           CALL x84 ( lmsgot, my_lmsgot, 1 )
           CALL cnved4 ( msgin, my_lmsgot*2, msgot )
 
           im8b=.true.
           RETURN
        ENDIF
 
        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