subroutine aptatob (asrce, isrce, nchar, idigita, ndigitm, nerr) ccbeg. cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c SUBROUTINE APTATOB c c call aptatob (asrce, isrce, nchar, idigita, ndigitm, nerr) c c Version: aptatob Updated 2005 August 22 16:20. c aptatob Originated 2005 June 10 13:40. c c Author: Arthur L. Edwards, LLNL, L -298, Telephone (925) 422-4123. c c c Purpose: To separate the character string in asrce, containing only the c digits 0-9, starting at character position isrce, with length c nchar, into array idigita with one digit per machine word, and c maximum length ndigitm. c c Input: asrce, isrce, nchar, ndigitm. c c Output: idigita, nerr. c c Glossary: c c asrce Input A character string containing only the digits 0-9, c with at least isrce + nchar - 1 digits, counted from c left to right, starting with 1. c c idigita Output An array of ndigita single digits 0-9, one per machine c word, with no leading zeros. Memory space must be c at least nchar. c c isrce Input The character position in asrce at which the character c string begins. Must be positive. c c nchar Input The number of digits in the character string to be put c into array idigita. Must be positive. c c ndigitm Input The maximum length of idigita. c c nerr Output Indicates an input error, if not zero. c 1 if isrce is not positive. c 2 if nchar is not positive. c 3 if asrce contains other than digits 0-9, in the c part to be separated. c 4 if nchar exceeds ndigitm. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ccend. c.... Dimensioned arguments. character*1 asrce(1) ! Character string containing only digits. integer idigita(1) ! Array of single digits. c.... Local variables. character*1 adig(0:9) ! Array of ASCII digits. data adig / '0', '1', '2', '3', '4', '5', '6', '7', '8', '9' / integer ibeg ! Initial index in asrce. integer iend ! Final index in asrce. integer n ! Current index in asrce. integer nn ! Index in array adig. integer nnn ! Index in array idigita. integer nx ! Index in array idigita. cbugc***DEBUG begins. cbug character*1 adit cbug 9901 format (/ 'aptatob translating ASCII digit string to integer', cbug & ' array.' / cbug & ' isrce=',i6,' nchar=',i3 ) cbug 9902 format (' asrce = ',64a1) cbug adit = '"' cbug ibeg = isrce cbug iend = isrce + nchar - 1 cbug write ( 3, 9901) isrce, nchar cbug write ( 3, 9902) adit, (asrce(i), i = ibeg, iend), adit cbugc***DEBUG ends. c.... Initialize. nerr = 0 c.... Test for input errors. if (isrce .le. 0) then nerr = 1 go to 210 endif if (nchar .le. 0) then nerr = 2 go to 210 endif ibeg = isrce iend = isrce + nchar - 1 do 100 n = ibeg, iend ! Loop over source characters. do nn = 0, 9 ! Loop over allowed digits. if (asrce(n) .eq. adig(nn)) then go to 100 endif enddo ! End of loop over allowed digits. nerr = 3 ! Unidentifiable character found. go to 210 100 continue ! End of loop over source characters. if (nchar .gt. ndigitm) then nerr = 4 go to 210 endif c.... Initialize. do nx = 1, nchar idigita(nx) = 0 enddo c.... Identify digits in asrce, store in idigita. do 110 n = ibeg, iend ! Loop over source characters. nnn = n - isrce + 1 do nn = 0, 9 ! Loop over allowed digits. if (asrce(n) .eq. adig(nn)) then idigita(nnn) = nn go to 110 endif enddo ! End of loop over allowed digits. 110 continue ! End of loop over source characters. 210 continue cbugc***DEBUG begins. cbug 9903 format (/ 'aptatob results. nerr=',i3 ) cbug 9904 format (' idigita =',6(1x,10i1)) cbug write ( 3, 9903) nerr cbug write ( 3, 9904) (idigita(n), n = 1, nchar) cbugc***DEBUG ends. return c.... End of subroutine aptatob. (+1 line.) end UCRL-WEB-209832