subroutine aptchrn (kset, asrce, isrce, nchar, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTCHRN
c
c     call aptchrn (kset, asrce, isrce, nchar, nerr)
c
c     Version:  aptchrn  Updated    1991 December 7 9:30.
c               aptchrn  Originated 1991 December 7 9:30.
c
c     Author:   Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c     Purpose:  To put random characters, from a list determined by kset,
c               into a character string in asrce, starting at character
c               position isrce in asrce, and with length nchar.
c               Flag nerr indicates any input error.
c
c     Input:    kset, asrce, isrce, nchar.
c
c     Output:   asrce, nerr.
c
c     Glossary:
c
c     asrce     In/Out   A type character word or array, containing at least
c                          isrce + nchar - 1 characters.  Character positions
c                          are counted to the right, from 1 at the leftmost
c                          character.  Characters in positions from isrce to
c                          isrce + nchar - 1 will be replaced by randomly
c                          selected characters.
c
c     isrce     Input    The character position in array asrce of the first
c                          character to be replaced.  Must be positive.
c
c     kset      Input    Indicates the group of characters from which random
c                          characters will be selected.  Must be from 1 to 7.
c                          1 for lower case a-z.
c                          2 for upper case A-Z.
c                          4 for numerals 0-9.
c                          Any sum of 1, 2, and 4 for combinations.
c
c     nchar     Input    The length of the character string to be replaced.
c                          Must be positive.
c
c     nerr      Output   Indicates an input error, if not zero.
c                          1 if kset is not in the range 1-7.
c                          2 if isrce is not positive.
c                          3 if nchar is not positive.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

c.... Dimensioned arguments.

c---- Array containing character string.
      dimension asrce   (1)
c---- Array containing character string.
      character asrce*1

c.... Local variables.

c---- Characters to be randomly selected.
      dimension achar  (72)
c---- Characters to be randomly selected.
      character*1 achar
      data achar / '1', '2', '3', '4', '5', '6', '7', '8', '9', '0',
     &             'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j',
     &             'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't',
     &             'u', 'v', 'w', 'x', 'y', 'z' ,
     &             'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J',
     &             'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T',
     &             'U', 'V', 'W', 'X', 'Y', 'Z' ,
     &             '1', '2', '3', '4', '5', '6', '7', '8', '9', '0' /

c---- Lowest index in subset of achar.
      common /laptchrn/ ibeg
c---- Randomly sampled index in achar.
      common /laptchrn/ ichar
c---- Highest index in subset of achar.
      common /laptchrn/ iend
c---- Index in character string.
      common /laptchrn/ n
c---- Number of random characters in subset.
      common /laptchrn/ nset
cbugc***DEBUG begins.
cbugc---- Number of character of asrce to write.
cbug      common /laptchrn/ nmaxa
cbug 9901 format (/ 'aptchrn putting random characters in a string.' /
cbug     &  '  kset=',i2,' isrce=',i6,'  nchar=',i6)
cbug 9902 format ('  asrce=',64a1)
cbug      write ( 3, 9901) kset, isrce, nchar
cbug      nmaxa = 8 * (1 + (isrce + nchar - 2) / 8)
cbug      write ( 3, 9902) (asrce(n), n = 1, nmaxa)
cbugc***DEBUG ends.

c.... initialize.

      nerr = 0

c.... Test for input errors.
      if ((kset .lt. 1) .or. (kset .gt. 7)) then
        nerr = 1
        go to 210
      endif

      if (isrce .le. 0) then
        nerr = 2
        go to 210
      endif

      if (nchar .le. 0) then
        nerr = 3
        go to 210
      endif

c.... Choose the character set to be randomly sampled.

c---- Characters a-z.
      if (kset .eq. 1) then
        ibeg = 11
        iend = 36
c---- Characters A-Z.
      elseif (kset. eq. 2) then
        ibeg = 37
        iend = 62
c---- Characters a-z, A-Z.
      elseif (kset .eq. 3) then
        ibeg = 11
        iend = 62
c---- Characters 0-9.
      elseif (kset. eq. 4) then
        ibeg = 1
        iend = 10
c---- Characters a-z, 0-9.
      elseif (kset. eq. 5) then
        ibeg = 1
        iend = 36
c---- Characters A-Z, 0-9.
      elseif (kset. eq. 6) then
        ibeg = 37
        iend = 72
c---- Characters a-z, A-Z, 0-9.
      elseif (kset. eq. 7) then
        ibeg = 1
        iend = 62
c---- Tested kset.
      endif

      nset = iend - ibeg + 1

c.... Put random characters from achar into asrce(isrce) to
c....   asrce(isrce +nchar-1).

      do 110 n = isrce, isrce + nchar - 1
        ichar    = ibeg + ranf( ) * nset
        asrce(n) = achar(ichar)
  110 continue

  210 continue
cbugc***DEBUG begins.
cbug 9905 format (/ 'aptchrn results:  nerr=',i3)
cbug      write ( 3, 9905) nerr
cbug      write ( 3, 9902) (asrce(n), n = 1, nmaxa)
cbugc***DEBUG ends.
      return

c.... End of subroutine aptchrn.      (+1 line.)
      end

UCRL-WEB-209832