subroutine aptbitm (worda, ia, nbits, nbitw, wordb, ib, nerr) ccbeg. cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c SUBROUTINE APTBITM c c call aptbitm (worda, ia, nbits, nbitw, wordb, ib, nerr) c c Version: aptbitm Updated 1997 July 30 12:50. c aptbitm Originated 1992 February 28 14:40. c c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123. c c c Purpose: To move a bit string of length nbits from worda, starting at c bit ia, to wordb, starting at bit ib. The number of bits per c machine word is nbitw. Bits are counted from left to right, c starting with 1, and ending with nbitw. c Flag nerr indicates any input error. c c Input: worda, ia, nbits, nbitw. c c Output: wordb, ib, nerr. c c Calls: aptbite, aptbitp c c c Glossary: c c ia Input The bit position in worda of the first bit in the c bit string to be moved to wordb. Counted from the c left, beginning with 1. c May not exceed 1 + nbitw - nbits. c c ib Input The bit position in wordb of the first bit in the c bit string to be moved from worda. Counted from the c left, beginning with 1. c May not exceed 1 + nbitw - nbits. c c nbits Input The number of bits to be moved from worda to wordb. c Must be positive. May not exceed nbitw. c c nbitw Input The number of bits in a machine word. Limit is 640. c Must be a positive multiple of 8. c c nerr Output Indicates an input or result error, if not zero. c 1 if nbits is not positive. c 2 if nbitw is not a positive multiple of 8, or c exceeds 640. c 3 if ia is not between 1 and 1 + nbitw - nbits. c 4 if ib is not between 1 and 1 + nbitw - nbits. c c worda Input A word containing nbitw bits, including the bit string c to be moved. c c wordb Output A word containing nbitw bits, including the bit string c moved from worda. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ccend. c.... Local variables. common /laptbitm/ ibita (640) ! Array of bits from worda. integer*1 ibita ! Array of bits from worda. common /laptbitm/ ibitb (640) ! Array of bits from wordb. integer*1 ibitb ! Array of bits from wordb. common /laptbitm/ n ! Index in bit string. common /laptbitm/ nbitx ! A multiple of 8. common /laptbitm/ ncharw ! Number of 8-bit bytes per word. cbugc***DEBUG begins. cbug 9901 format (/ 'aptbitm moving a bit string from worda to wordb.', cbug & ' nbits=',i5) cbug 9902 format (' worda=',z16,' ia=',i3) cbug 9903 format (' wordb=',z16,' ib=',i3) cbug write ( 3, 9901) nbits cbug write ( 3, 9902) worda, ia cbug write ( 3, 9903) wordb, ib cbugc***DEBUG ends. c.... Test for input errors. nerr = 0 if (nbits .le. 0) then nerr = 1 go to 210 endif ncharw = 1 + (nbitw - 1) / 8 nbitx = 8 * ncharw if ((nbitw .ne. nbitx) .or. (nbitw .gt. 640))then nerr = 2 go to 210 endif if ((ia .lt. 1) .or. (ia .gt. (1 + nbitw - nbits))) then nerr = 3 go to 210 endif if ((ib .lt. 1) .or. (ib .gt. (1 + nbitw - nbits))) then nerr = 4 go to 210 endif c.... Expand each word into bit arrays. call aptbite (worda, nbitw, nbitw, ibita, nerr) call aptbite (wordb, nbitw, nbitw, ibitb, nerr) c.... Move bits from worda bit array to wordb bit array. do 110 n = 1, nbits ibitb(n+ib-1) = ibita(n+ia-1) 110 continue c.... Repack the wordb bit array back into wordb. call aptbitp (ibitb, nbitw, nbitw, wordb, nerr) 210 continue cbugc***DEBUG begins. cbug 9904 format (/ 'aptbitm results: nerr=',i2) cbug write ( 3, 9904) nerr cbug if (nerr .ne. 0) return cbug write ( 3, 9903) wordb, ib cbugc***DEBUG ends. return c.... End of subroutine aptbitm. (+1 line.) end UCRL-WEB-209832