subroutine aptchrp (asrce, isrce, nchar, chold, chnew, nrep, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTCHRP
c
c call aptchrp (asrce, isrce, nchar, chold, chnew, nrep, nerr)
c
c Version: aptchrp Updated 1991 November 19 10:20.
c aptchrp Originated 1991 November 19 10:20.
c
c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: To modify characters in array asrce, in the character string
c starting at character position isrce in asrce, of length nchar,
c by replacing any character in the list chold with the
c corresponding character in the list chnew, of length nrep.
c For example, to convert from lower to upper case:
c chold = "abcdefghijklmnopqrstuvwxyz"
c chnew = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
c nrep = 26
c Flag nerr indicates any input error.
c
c Input: asrce, isrce, nchar, chold, chnew, nrep.
c
c Output: asrce, nerr.
c
c Glossary:
c
c asrce In/Out An array containing a character string of length nchar,
c starting at the isrce'th character, counting from
c left to right, beginning with 1.
c
c chold Input Characters to be compared with the characters in the
c specified character string in asrce. Any occurrence
c of character chold(n) will be replaced by character
c chnew(n). Size nrep.
c
c chnew Input Replacement characters. Size nrep. Any occurrence of
c character chold(n) in the specified character string
c in asrce will be replaced by chnew(n).
c
c isrce Input The character position in array asrce of the first
c character to be tested. E. g., 1 for the leftmost
c character of asrce(1). Must be positive.
c
c nchar Input The length of the character string to be tested. Must
c be positive.
c
c nerr Output Indicates an input error, if not zero.
c 1 if nchar is not positive.
c 2 if isrce is not positive.
c 3 if nrep is not positive.
c
c nrep Input The number of characters in lists chold and chnew.
c Must be positive.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
c.... Dimensioned arguments.
c---- Array containing character string.
dimension asrce (1)
c---- Array containing character string.
character asrce*1
c---- Characters to be replaced by chnew.
dimension chold (1)
c---- Characters to be replaced by chnew.
character chold*1
c---- Characters to replace chold.
dimension chnew (1)
c---- Characters to replace chold.
character chnew*1
c.... Local variables.
c---- Index in character string.
common /laptchrp/ n
c---- Index in chold, chnew.
common /laptchrp/ nn
cbugc***DEBUG begins.
cbugc---- Number of character of asrce to write.
cbug common /laptchrp/ nmaxa
cbug 9901 format (/ 'aptchrp replacing characters in a string.' /
cbug & ' isrce=',i6,' nchar=',i6,' nrep=',i6)
cbug 9902 format (' asrce=',64a1)
cbug 9903 format (' chold=',64a1)
cbug 9904 format (' chnew=',64a1)
cbug write ( 3, 9901) isrce, nchar, nrep
cbug nmaxa = 8 * (1 + (isrce + nchar - 2) / 8)
cbug write ( 3, 9902) (asrce(n), n = 1, nmaxa)
cbug write ( 3, 9903) (chold(n), n = 1, nrep)
cbug write ( 3, 9904) (chnew(n), n = 1, nrep)
cbugc***DEBUG ends.
c.... initialize.
nerr = 0
c.... Test for input errors.
if (nchar .le. 0) then
nerr = 1
go to 210
endif
if (isrce .le. 0) then
nerr = 2
go to 210
endif
if (nrep .le. 0) then
nerr = 3
go to 210
endif
c.... Replace any occurrences of chold with chnew in asrce(isrce) to
c.... asrce(isrce +nchar-1).
do 120 n = 1, nchar
do 110 nn = 1, nrep
if (asrce(isrce +n-1) .eq. chold(nn)) then
asrce(isrce +n-1) = chnew(nn)
go to 120
endif
110 continue
120 continue
cbugc***DEBUG begins.
cbug 9905 format (/ 'aptchrp results:')
cbug write ( 3, 9905)
cbug write ( 3, 9902) (asrce(n), n = 1, nmaxa)
cbugc***DEBUG ends.
210 return
c.... End of subroutine aptchrp. (+1 line.)
end
UCRL-WEB-209832