w3ai40.f

Go to the documentation of this file.

C> @file
C> @brief Constant size binary string packer.
C> @author Robert Allard @date 1980-04-01
 
C> Packs constant size binary strings into an array. This
C> packing replaces bits in the part of the output array indicated
C> by the offset value. W3AI40 is the reverse of W3AI41. (see W3AI32
C> to pack variable size binary strings.)
C>
C> Program history log:
C> - Robert Allard 1980-04-01 Asmembler language version.
C> - Ralph Jones 1984-07-05 Recompiled for nas-9050.
C> - Ralph Jones 1989-11-04 Wrote fortran version of w3ai40 to pack
C> constant size binary strings.
C> - Ralph Jones 1989-11-05 Convert to cray cft77 fortran.
C> - Boi Vuong 1998-03-10 Remove the cdir$ integer=64 directive.
C>
C> @param[in] KFLD Integer input array of right adjusted strings.
C> @param[in] KLEN Integer number of bits per string (0 < klen < 33).
C> @param[in] KNUM Integer number of strings in 'kfld' to pack.
C> @param[in] KOFF Integer number specifying the bit offset of the
C> first output string. the offset value is reset to
C> include the low order bit of the last packed string.
C> @param[out] KOUT Integer output array to hold packed string(s).
C>
C> exit states:
C> error  - koff < 0 if klen has an illegal value or knum < 1
C> then kout has no strings stored.
C>
C> @note This subroutine should be written in assembler language.
C> The fortran version runs two or three times slower than the asembler
C> version. The fortran version can be converted to run on other
C> computers with a few changes. The bit manipulation functions are the
C> same in IBM370 vs fortran 4.1, microsoft fortran 4.10, vax fortran.
C> Most modern fortran compiler have and, or, shift functions. If you
C> are running on a pc, vax and your input was made on a IBM370, apollo
C> sun, h.p.. etc. you may have to add more code to reverse the order of
C> bytes in an integer word. NCAR sbytes() can be used instead of this
C> subroutine. Please use NCAR sbytes() subroutine instead of this
C> subroutine.
C>
C> @author Robert Allard @date 1980-04-01
      SUBROUTINE w3ai40(KFLD,KOUT,KLEN,KNUM,KOFF)
C
      INTEGER  KFLD(*)
      INTEGER  KOUT(*)
      INTEGER  BIT
      INTEGER  OFFSET
      INTEGER  WRD
C
      DATA  mask  /-1/
C
      offset = koff
      IF (offset.LT.0) RETURN
      IF (klen.GT.64.OR.klen.LT.1) THEN
        koff = -1
        RETURN
      ENDIF
C
      IF (knum.LT.1) THEN
        koff = -1
        RETURN
      ENDIF
C
        jcount  = 64 - klen
        length  = klen
        maskwd  = ishft(mask,jcount)
C
      DO 100  i = 1,knum
        wrd       = ishft(offset,-6) + 1
        bit       = mod(offset,64)
        mask8     = not(ishft(maskwd,-bit))
        offset    = offset + length
        jtemp     = iand(kout(wrd),mask8)
        ncount    = 64 - bit
        IF (ncount.LT.length) THEN
          mask9   = not(ishft(maskwd,ncount))
          ntemp   = iand(kout(wrd+1),mask9)
        ENDIF
        itemp     = ishft(ishft(kfld(i),jcount),-bit)
        kout(wrd) = ior(itemp,jtemp)
        IF (ncount.LT.length) THEN
          itemp       = ishft(kfld(i),(jcount+ncount))
          kout(wrd+1) = ior(itemp,ntemp)
        ENDIF
 100  CONTINUE
        koff = offset
      RETURN
      END