var/external/bufr/pad.f

   1       SUBROUTINE PAD(IBAY,IBIT,IBYT,IPADB)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    PAD
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS SUBROUTINE FIRST PACKS THE VALUE FOR THE NUMBER OF
   9 C   BITS BEING "PADDED" (WE'LL GET TO THAT LATER), STARTING WITH BIT
  10 C   IBIT+1 AND USING EIGHT BITS IN THE PACKED ARRAY IBAY (WHICH
  11 C   REPRESENTS A SUBSET PACKED INTO IBIT BITS).  THEN, STARTING WITH
  12 C   IBIT+9, IT PACKS ZEROES (I.E., "PADS") TO THE SPECIFIED BIT
  13 C   BOUNDARY (IPADB).  (NOTE: IT'S THE NUMBER OF BITS PADDED HERE THAT
  14 C   WAS PACKED IN BITS IBIT+1 THROUGH IBIT+8 - THIS IS ACTUALLY A
  15 C   DELAYED REPLICATION FACTOR).  IPADB MUST BE A MULTIPLE OF EIGHT AND
  16 C   REPRESENTS THE BIT BOUNDARY ON WHICH THE PACKED SUBSET IN IBAY
  17 C   SHOULD END AFTER PADDING.  FOR EXAMPLE, IF IPABD IS "8", THEN THE
  18 C   NUMBER OF BITS IN IBAY ACTUALLY CONSUMED BY PACKED DATA (INCLUDING
  19 C   THE PADDING) WILL BE A MULTIPLE OF EIGHT.  IF IPADB IS "16", IT
  20 C   WILL BE A MULTIPLE OF SIXTEEN.  IN EITHER (OR ANY) CASE, THIS
  21 C   ENSURES THAT THE PACKED SUBSET WILL ALWAYS END ON A FULL BYTE
  22 C   BOUNDARY.
  23 C
  24 C PROGRAM HISTORY LOG:
  25 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  26 C 1998-07-08  J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
  27 C                           "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
  28 C                           ROUTINE "BORT"
  29 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  30 C                           INTERDEPENDENCIES
  31 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED
  32 C                           DOCUMENTATION (INCLUDING HISTORY); OUTPUTS
  33 C                           MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
  34 C                           TERMINATES ABNORMALLY
  35 C
  36 C USAGE:    CALL PAD (IBAY, IBIT, IBYT, IPADB)
  37 C   INPUT ARGUMENT LIST:
  38 C     IBAY     - INTEGER: *-WORD PACKED BINARY ARRAY NOT YET PADDED
  39 C     IBIT     - INTEGER: BIT POINTER WITHIN IBAY TO START PADDING FROM
  40 C     IPADB    - INTEGER: BIT BOUNDARY TO PAD TO (MUST BE A MULTIPLE OF
  41 C                8)
  42 C
  43 C   OUTPUT ARGUMENT LIST:
  44 C     IBAY     - INTEGER: *-WORD PACKED BINARY ARRAY NOW PADDED
  45 C     IBIT     - INTEGER: NUMBER OF BITS WITHIN IBAY CONTAINING PACKED
  46 C                DATA (INCLUDING PADDING, MUST BE A MULTIPLE OF 8)
  47 C     IBYT     - INTEGER: NUMBER OF BYTES WITHIN IBAY CONTAINING PACKED
  48 C                DATA (INCLUDING PADDING) (I.E., IBIT/8)
  49 C
  50 C REMARKS:
  51 C    THIS ROUTINE CALLS:        BORT     PKB
  52 C    THIS ROUTINE IS CALLED BY: MSGUPD
  53 C                               Normally not called by any application
  54 C                               programs.
  55 C
  56 C ATTRIBUTES:
  57 C   LANGUAGE: FORTRAN 77
  58 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  59 C
  60 C$$$
  61
  62       CHARACTER*128 BORT_STR
  63       DIMENSION     IBAY(*)
  64
  65 C----------------------------------------------------------------------
  66 C----------------------------------------------------------------------
  67
  68 C  PAD THE SUBSET TO AN IPADB BIT BOUNDARY
  69 C  ----------------------------------------
  70
  71       IPAD = IPADB - MOD(IBIT+8,IPADB)
  72 c  .... First pack the # of bits being padded (this is a delayed
  73 c  .... replication factor)
  74       CALL PKB(IPAD,8,IBAY,IBIT)
  75 c  .... Now pad with zeroes to the byte boundary
  76       CALL PKB(0,IPAD,IBAY,IBIT)
  77       IBYT = IBIT/8
  78
  79       IF(MOD(IBIT,IPADB).NE.0) GOTO 900
  80       IF(MOD(IBIT,8    ).NE.0) GOTO 901
  81
  82 C  EXITS
  83 C  -----
  84
  85       RETURN
  86 900   WRITE(BORT_STR,'("BUFRLIB: PAD - THE INPUT BIT BOUNDARY TO PAD '//
  87      . 'TO (",I8,") IS NOT A MULTIPLE OF 8")') IPADB
  88       CALL BORT(BORT_STR)
  89 901   WRITE(BORT_STR,'("BUFRLIB: PAD - THE NUMBER OF BITS IN A PACKED'//
  90      . ' SUBSET AFTER PADDING (",I8,") IS NOT A MULTIPLE OF 8")') IBIT
  91       CALL BORT(BORT_STR)
  92       END