blocks.f

Go to the documentation of this file.

C> @file
C> @brief Encapsulate a BUFR message with IEEE Fortran control
C> words.
 
C> This subroutine encapsulates a BUFR message with IEEE Fortran
C> control words as specified via the most recent call to
C> subroutine setblock(). 
C>
C> <p>A previous call to subroutine setblock() is required in
C> order to activate encapsulation with control words, and to
C> specify whether the control words should be encoded using
C> big-endian or little-endian byte ordering.  In such cases,
C> the input parameter MBAY is then modified to
C> add the specified control words to the existing BUFR message
C> whenever this subroutine is called, and MWRD is also
C> modified accordingly.
C>
C> <p>Alternatively, if subroutine setblock() was never previously
C> called, or if no encapsulation was specified during the most
C> recent call to subroutine setblock(), then this subroutine
C> simply returns without modifying either of its input parameters.
C>
C> @author J. Woollen
C> @date 2012-09-15
C>
C> @param[in,out] MBAY -- integer(*): BUFR message, possibly with
C>                        added control words on output
C> @param[in,out] MWRD -- integer: Size (in integers) of contents
C>                        of MBAY
C>
C> @remarks
C> - For more information about IEEE Fortran control words, as
C> well as their historical use within the BUFRLIB software, see
C> the documentation for subroutine setblock().
C> - Whenever a BUFR message in MBAY is to be encapsulated with
C> control words, the user must ensure the availability of
C> sufficient extra space when allocating MBAY within the
C> application program.
C>
C> <b>Program history log:</b>
C> | Date | Programmer | Comments |
C> | -----|------------|----------|
C> | 2012-09-15 | J. Ator  | Original author |
C>
      SUBROUTINE blocks(MBAY,MWRD)
 
      COMMON /hrdwrd/ nbytw,nbitw,iord(8)
      COMMON /endord/ iblock,iordbe(4),iordle(4)
 
      INTEGER*4 MBAY(MWRD),IINT,JINT
 
      CHARACTER*1 CINT(4),DINT(4)
      equivalence(cint,iint)
      equivalence(dint,jint)
 
      DATA ifirst/0/
      SAVE ifirst
 
c----------------------------------------------------------------------
c----------------------------------------------------------------------
 
      if(iblock.eq.0) return
 
      if(ifirst.eq.0) then
 
c        Initialize some arrays for later use.  Note that Fortran
c        record control words are always 4 bytes.
 
         iint=0; cint(1)=char(1)
         do i=1,4 
         if(cint(1).eq.char(01)) then 
            iordbe(i)=4-i+1
            iordle(i)=i 
         else
            iordle(i)=4-i+1
            iordbe(i)=i 
         endif
         enddo
         ifirst=1
      endif
 
c  make room in mbay for control words - one at each end of the record
c  -------------------------------------------------------------------
 
      if(nbytw.eq.8) mwrd=mwrd*2
 
      do m=mwrd,1,-1
      mbay(m+1) = mbay(m)  
      enddo
 
c  store the endianized control word in bytes in dint/jint
c  -------------------------------------------------------
 
      iint=mwrd*4        
 
      do i=1,4         
      if(iblock.eq.+1) dint(i)=cint(iordbe(i))
      if(iblock.eq.-1) dint(i)=cint(iordle(i))
      enddo
 
c  increment mrwd and install the control words in their proper places
c  -------------------------------------------------------------------
 
      mwrd = mwrd+2
      mbay(1) = jint
      mbay(mwrd) = jint
 
      if(nbytw.eq.8) mwrd=mwrd/2
 
      return
      end