subroutine aptchap (asrce, isrce, nchar, nwordm, fd, iamax, idmax,
& iemax, aword, iword, fword, mtype, lword,
& nword, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTCHAP
c
c call aptchap (asrce, isrce, nchar, nwordm, fd, iamax, idmax,
c & iemax, aword, iword, fword, mtype, lword,
c & nword, nerr)
c
c Version: aptchap Updated 1993 February 18 13:40.
c aptchap Originated 1993 February 16 13:20.
c
c Authors: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: To translate the character string in asrce, starting at
c character position isrce, and with length nchar, into no more
c than nwordm data fields delimited by the character fd, to
c translate and return the data in arrays aword (characters),
c iword (integers) and fword (floating-point), and to return the
c data type mtype of each field, the number of characters in each
c field, lword, and the number of fields, nword.
c The word length in character array aword is iamax characters.
c Integer data in iword may contain up to idmax digits.
c Floating-point data in fword may have an exponent up to iemax.
c Flag nerr indicates any input error.
c
c Note: Data fields of known location and length may be translated
c directly by calling aptchtp.
c
c Input: asrce, isrce, nchar, nwordm, fd, iamax, idmax, iemax.
c
c Output: aword, iword, fword, mtype, lword, nword, nerr.
c
c Calls: aptchtp
c
c Glossary:
c
c asrce Input A character array, containing a character string of
c length nchar, starting in character position isrce,
c to be separated into strings delimited by the
c character fd, and translated into integer and
c floating-point words, as appropriate.
c
c aword Output A character array of type character*iamax, size
c nwordm or more. Initialized to blank characters.
c the first subscript is the character position in an
c iamax-character word. The second subscript is the
c field number. If the n'th data field translated is a
c character field (mtype = 0 or 1), it will be stored
c in the leftmost characters of aword(i,n),
c i = 1,iamax, and right-filled with blank characters,
c as necessary.
c
c fd Input The special character that delimits fields. If fd is a
c blank character, adjacent fields may be separated
c by any number of blanks. Otherwise, two adjacent
c delimiters define a "zero-length" field, and
c mtype = -1 will be returned, with aword blank, and
c iword and fword zero. If the last non-blank field
c does not include the end of the character string, it
c must be followed by the delimiter. If a non-blank
c delimiter is followed only by blanks, to the end of
c the character string, the last field will be blank.
c
c fword Output A floating-point array, size nwordm or more.
c Initialized to zero.
c The maximum allowable exponent is iemax.
c If the data field is translated into an integer
c (mtype = 2) or into a floating-point number
c (mtype = 3), its floating-point value will be
c returned in fword. If the field is formatted as an
c integer, but contains more than idmax digits after
c any leading zeros, it will be translated into a
c floating-point number, and returned in fword.
c The data field may have leading or trailing
c blanks. The first non-blank character may be a "+"
c or "-". The mantissa may contain any number of
c digits, but no more than one decimal point, and
c may have trailing blanks. If an exponent is given,
c it must begin with "e", "E", "d", "D", "+" or "-".
c An initial "e", "E", "d" or "D" may be followed by
c a "+" or "-". The digits of the exponent may have
c leading and trailing blanks, but no additional
c characters following any trailing blanks.
c Note: do not equivalence iword to fword.
c Note: the largest floating-point value possible on
c the Cray is approximately 1.e+2465.
c
c iamax Input Number of characters in each word of character array
c aword.
c
c idmax Input Maximum number of digits in an integer. Depends on
c the machine. At least 13 on a Cray.
c
c iemax Input Maximum size (positive or negative) of the exponent
c of a floating-point number. Depends on the machine.
c Approximately 2465 on a Cray.
c
c isrce Input The character position in array asrce of the first
c character of the string. E. g., isrce = 1 means
c the leftmost character of asrce(1).
c Must be positive.
c
c iword Output An integer array, size nwordm or more. Initialized
c to zero. If the n'th data field translated is
c an integer (mtype = 2), its integer value will be
c stored in iword(n), and its floating-point value
c stored in fword(n). The maximum number of digits
c is idmax. The data field may have leading or
c trailing blanks. The first non-blank character may
c be a "+" or "-". All other characters must be
c digits, with no more than idmax digits following any
c leading zeros.
c Note: the largest integer possible on the Cray
c is 2**46 - 1 = 7.03687e+13.
c Note: do not equivalence iword to fword.
c
c lword Output An integer array, size nwordm or more. Initialized to
c zero. The number of characters in the n'th data
c field is stored in lword(n).
c
c mtype Output An integer array, size nwordm. The first nword values
c indicate the data types of the data fields
c translated from the character string in asrce:
c -1: A field of zero length, between two non-blank
c field delimiters. A blank word is returned in
c aword. Zeros are returned in iword and fword.
c 0: Not recognizable as an integer or floating-point
c number, and longer than iamax characters
c (nerr = 0), or a floating-point number whose
c exponent exceeds the limit iemax (nerr = 5).
c Returned in aword.
c 1: Not recognizable as an integer or floating-point
c number. Field has from 1 to iamax characters.
c Returned in aword, left-adjusted, right-filled
c with blanks, as necessary.
c 2: Data field translated into integer mode.
c The integer value is returned in iword, and the
c floating-point value is returned in fword.
c Also returned in aword, as for mtype = 1.
c 3: Data field translated into floating-point
c mode, and returned in fword. The integer value
c can not be stored in iword, because of the
c possibility of overflow of numbers with large
c exponents. If nerr = 4, the data field was
c an integer with more than idmax digits.
c Also returned in aword, as for mtype = 1.
c
c nchar Input The number of characters in the string to be
c translated.
c
c nerr Output Indicates an input error, if not zero. The last error
c found is indicated by:
c 1 if nchar is not positive.
c 2 if isrce is not positive.
c 3 if nwordm is not positive.
c 4 if an integer exceeds idmax characters (in any
c field). If so, a floating-point result is returned
c in fword, with mtype = 3.
c 5 if a floating-point exponent exceeds iemax (in any
c field). If so, a character string is returned in
c aword, with mtype = 0.
c 6 if case conversion caused an error in aptchtp.
c 7 if iamax, idmax or iemax is not positive.
c
c nword Output The number of data fields found in asrce.
c
c nwordm Input The maximum number of data fields to be translated.
c Any more than this will be ignored.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
c.... Declarations for arguments.
c---- Input line characters.
dimension asrce (1)
character*1 asrce
c---- Character interpretation of a field
dimension aword (iamax ,1)
character*1 aword
c---- Integer interpretation of a field.
dimension iword (1)
c---- Floating point interpretation.
dimension fword (1)
c---- Field type (integer).
dimension mtype (1)
c---- Number of characters in field (integer).
dimension lword (1)
c---- Delimiting character.
character*1 fd
c.... Local variables.
c---- Character index in field.
common /laptchap/ i
c---- Character index of beginning of field.
common /laptchap/ ibeg
c---- Character index of end of field + 1.
common /laptchap/ iendp
c---- Character index to end testing.
common /laptchap/ ilast
c---- Character index to start testing.
common /laptchap/ ipre
c---- Error flag from aptchtp.
common /laptchap/ nerrl
cbugc***DEBUG begins.
cbugc---- Index of delimited field.
cbug common /laptchap/ n
cbugc---- Data field mode label.
cbug common /captchap/ atype(-1:3)
cbugc---- Data field mode label.
cbug character*16 atype
cbug atype(-1) = 'zero-length'
cbug atype( 0) = 'bad data'
cbug atype( 1) = 'character'
cbug atype( 2) = 'integer'
cbug atype( 3) = 'floating-point'
cbug 9901 format (/ 'aptchap cracking a character string.' /
cbug & ' isrce=',i3,' nchar=',i3,' nwordm='i3,' fd="',a1,'"',
cbug & ' iamax=',i2,' idmax=',i2,' iemax=',i6)
cbug 9902 format (' asrce=' / (64a1))
cbug write ( 3, 9901) isrce, nchar, nwordm, fd, iamax, idmax, iemax
cbug write ( 3, 9902) (asrce(isrce +ibeg-1), ibeg = 1, nchar)
cbugc***DEBUG ends.
c.... Initialize.
nword = 0
c.... Test for input errors.
nerr = 0
if (nchar .le. 0) then
nerr = 1
go to 210
endif
if (isrce .le. 0) then
nerr = 2
go to 210
endif
if (nwordm .le. 0) then
nerr = 3
go to 210
endif
if ((iamax .le. 0) .or. (idmax .le. 0) .or. (iemax .le. 0)) then
nerr = 7
go to 210
endif
c.... Initialize the field lengths.
do 100 n = 1, nwordm
lword(n) = 0
100 continue
c.... Initialize the indices of the first and last characters of the string.
iendp = isrce - 1
ilast = iendp + nchar
c.... Find the start of the next field, if any.
110 ipre = iendp + 1
do 120 ibeg = ipre, ilast
if (asrce(ibeg) .eq. fd) then
c---- Found next non-blank delimiter.
if (fd .ne. ' ') then
iendp = ibeg
go to 150
endif
else
go to 130
endif
120 continue
c---- No more fields. Rest is blank.
go to 210
c.... Found the beginning of a field. Find the end of the field.
130 do 140 iendp = ibeg + 1, ilast
if (asrce(iendp) .eq. fd) go to 150
140 continue
c---- Last field. Extends to end.
iendp = ilast + 1
c.... Define the field number, starting character and length.
150 nword = nword + 1
lword(nword) = iendp - ibeg
c.... Test for zero-length fields.
c---- Two adjacent delimiters.
if (lword(nword) .eq. 0) then
do 160 i = 1, iamax
aword(i,nword) = ' '
160 continue
iword(nword) = 0
fword(nword) = 0.0
mtype(nword) = -1
go to 170
endif
c.... Find the field type, and any translation into integer and/or
c.... floating-point format.
call aptchtp (asrce, ibeg, lword(nword), iamax, idmax, iemax,
& aword(1,nword), iword(nword), fword(nword),
& mtype(nword), nerrl)
if (nerrl .gt. 0) nerr = nerrl
c.... See if there are more fields to translate.
170 if ((iendp .lt. ilast) .and. (nword .lt. nwordm)) go to 110
210 continue
cbugc***DEBUG begins.
cbug 9903 format (/ 'aptchap results: nword=',i3,' nerr=',i2)
cbug 9904 format (' field='i2,2x / 80a1 / i20,1pe22.14,i3,2x,a16)
cbug 9905 format (' Entire string is blank.')
cbug write ( 3, 9903) nword, nerr
cbug if (nword .gt. 0) then
cbug do 220 n = 1, nword
cbug write ( 3, 9904) n, (aword(i,n), i = 1,80),
cbug & iword(n), fword(n), mtype(n), atype(mtype(n))
cbug 220 continue
cbug else
cbug write ( 3, 9905)
cbug endif
cbugc***DEBUG ends.
return
c.... End of subroutine aptchap. (+1 line.)
end
UCRL-WEB-209832