wrfv2_fire/var/external/bufr/padmsg.inc

   1         SUBROUTINE PADMSG(MESG,LMESG,NPBYT)
   2
   3 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 !
   5 ! SUBPROGRAM:   PADMSG
   6 !   PRGMMR: ATOR             ORG: NP12       DATE: 2005-11-29
   7 !
   8 ! ABSTRACT: THIS SUBROUTINE PADS A BUFR MESSAGE WITH ZEROED-OUT BYTES
   9 !  FROM THE END OF THE MESSAGE UP TO THE NEXT 8-BYTE BOUNDARY.
  10 !
  11 ! PROGRAM HISTORY LOG:
  12 ! 2005-11-29  J. ATOR    -- ORIGINAL AUTHOR
  13 !
  14 ! USAGE:    CALL PADMSG (MESG, LMESG, NPBYT )
  15 !   INPUT ARGUMENT LIST:
  16 !     MESG     - INTEGER: *-WORD PACKED BINARY ARRAY CONTAINING BUFR
  17 !                MESSAGE
  18 !     LMESG    - INTEGER: DIMENSIONED SIZE (IN INTEGER WORDS) OF MESG;
  19 !                USED BY THE SUBROUTINE TO ENSURE THAT IT DOES NOT
  20 !                OVERFLOW THE MESG ARRAY
  21 !
  22 !   OUTPUT ARGUMENT LIST:
  23 !     MESG     - INTEGER: *-WORD PACKED BINARY ARRAY CONTAINING BUFR
  24 !                MESSAGE WITH NPBYT ZEROED-OUT BYTES APPENDED TO THE END
  25 !     NPBYT    - INTEGER: NUMBER OF ZEROED-OUT BYTES APPENDED TO MESG
  26 !
  27 ! REMARKS:
  28 !    THIS ROUTINE CALLS:        BORT     IUPBS01  NMWRD    PKB
  29 !    THIS ROUTINE IS CALLED BY: MSGWRT
  30 !                               Also called by application programs.
  31 !
  32 ! ATTRIBUTES:
  33 !   LANGUAGE: FORTRAN 77
  34 !   MACHINE:  PORTABLE TO ALL PLATFORMS
  35 !
  36 !$$$
  37
  38         COMMON /HRDWRD/ NBYTW,NBITW,NREV,IORD(8)
  39
  40         DIMENSION MESG(*)
  41
  42 !-----------------------------------------------------------------------
  43 !-----------------------------------------------------------------------
  44
  45 !       Make sure that the array is big enough to hold the additional
  46 !       byte padding that will be appended to the end of the message.
  47
  48         NMW = NMWRD(MESG)
  49         IF(NMW.GT.LMESG) GOTO 900
  50
  51 !       Pad from the end of the message up to the next 8-byte boundary.
  52
  53         NMB = IUPBS01(MESG,'LENM')
  54         IBIT = NMB*8
  55         NPBYT = ( NMW * NBYTW ) - NMB
  56         DO I = 1, NPBYT
  57             CALL PKB(0,8,MESG,IBIT)
  58         ENDDO
  59
  60         RETURN
  61 900     CALL BORT('BUFRLIB: PADMSG - CANNOT ADD PADDING TO MESSAGE '// &
  62           'ARRAY; TRY A LARGER DIMENSION FOR THIS ARRAY')
  63         END SUBROUTINE PADMSG