subroutine aptbitr (worda, ia, nbits, nbitw, wordb, nerr) ccbeg. cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c SUBROUTINE APTBITR c c call aptbitr (worda, ia, nbits, nbitw, wordb, nerr) c c Version: aptbitr Updated 1997 July 30 12:50. c aptbitr Originated 1992 March 3 14:20. c c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123. c c c Purpose: To insert into worda, starting at bit ia, a random bit string c of length nbits. There are nbitw bits per machine word, and c bits are counted from left to right, starting with 1 and ending c with nbitw. The result is stored in wordb. c Flag nerr indicates any input error. c c Input: worda, ia, nbits, nbitw. c c Output: wordb, nerr. c c Calls: aptbite, aptbitp c c c Glossary: c c ia Input The position in worda, counting from 1 at the leftmost c bit, of the first bit to be replaced by a random bit. c May not exceed 1 + nbitw - nbits. c c nbits Input The number of bits to be replaced by random bits. 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 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 c worda Input A word containing nbitw bits. c c wordb Output A word containing nbitw bits, produced by replacing c nbits bits in worda by random bits, starting at bit c position ia, counting from 1 at the leftmost bit. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ccend. c.... Local variables. common /laptbitb/ ibit (640) ! Array of bits from worda. integer*1 ibit ! Array of bits from worda. common /laptbitr/ n ! Index in bit array. common /laptbitr/ nbitx ! A positive multiple of 8. cbugc***DEBUG begins. cbug 9901 format (/ 'aptbitr replacing a bit string with random bits.', cbug & ' nbitw=',i5) cbug 9902 format (' worda=',z16,' ia=',i3,' nbits=',i3) cbug write ( 3, 9901) nbitw cbug write ( 3, 9902) worda, ia, nbits cbugc***DEBUG ends. c.... Initialize. nerr = 0 wordb = worda c.... Test for input errors. if (nbits .le. 0) then nerr = 1 go to 210 endif nbitx = 8 + 8 * ((nbitw - 1) / 8) 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 c.... Expand worda into a bit array. call aptbite (worda, nbitw, nbitw, ibit, nerr) c.... Replace bits ia through ia + nbits - 1 with random bits. do 110 n = ia, ia + nbits - 1 if (ranf () .lt. 0.5) then ibit(n) = 0 else ibit(n) = 1 endif 110 continue c.... Repack the wordb bit array back into wordb. call aptbitp (ibit, nbitw, nbitw, wordb, nerr) 210 continue cbugc***DEBUG begins. cbug 9903 format (/ 'aptbitr results: nerr=',i2) cbug 9904 format (' wordb=',z16,' ia=',i3,' nbits=',i3) cbug write ( 3, 9903) nerr cbug if (nerr .ne. 0) return cbug write ( 3, 9904) wordb, ia, nbits cbugc***DEBUG ends. return c.... End of subroutine aptbitr. (+1 line.) end UCRL-WEB-209832