subroutine aptchat (asrce, isrce, nchar, nwordm, fd, idmax, iemax,
& aword, iword, fword, mtype, nword, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTCHAT (OBSOLETE, USE APTCHAP)
c
c call aptchat (asrce, isrce, nchar, nwordm, fd, idmax, iemax,
c & aword, iword, fword, mtype, nword, nerr)
c
c Version: aptchat Updated 1991 December 4 14:30.
c aptchat Originated 1991 August 27 12:00.
c
c Authors: Dermott "Red" Cullen, LLNL, L-298, Telephone (925) 423-7359.
c 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, and the number of fields, nword.
c Character data in aword may contain up to 8 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 aptchty.
c
c Input: asrce, isrce, nchar, nwordm, fd, idmax, iemax.
c
c Output: aword, iword, fword, mtype, nword, nerr.
c
c Calls: aptchty
c
c Glossary:
c
c asrce Input An array containing a character string, compatible with
c a calling routine argument of type character*8,
c character*1, etc.
c
c aword Output A character array of type character*1, size (8,nwordm)
c or more. Initialized to blank characters.
c Compatible with a calling routine argument of type
c character*8, size nwordm or more.
c The first subscript is the character position in an
c 8-character word. The second subscript is the field
c 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), i = 1,8,
c and right-filled with blank characters, as necessary.
c
c fd Input The special field-delimiting character. 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,
c iword and fword zero. If the last field does not
c include the end of the character string, it must be
c followed by the delimiter.
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 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 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 8 characters (nerr = 0),
c or a floating-point number whose exponent exceeds
c the limit iemax (nerr = 5). Returned in aword.
c 1: Not recognizable as an integer or floating-point
c number. Field has 1-8 characters. Returned in
c aword, left-adjusted, right-filled with blanks,
c 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 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 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 aptchty.
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
c nchar Input The number of characters in array asrce.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
c.... Declarations for arguments.
c---- Input line characters.
dimension asrce (1)
c---- Input line characters.
character*1 asrce
c---- Character interpretation of a field
dimension aword (8,1)
c---- Character interpretation of a field.
character*1 aword
c---- Integer interpretation of a field.
dimension iword (1)
c---- Field type (integer).
dimension mtype (1)
c---- Floating point interpretation.
dimension fword (1)
c---- Delimiting character.
character*1 fd
c.... Local variables.
c---- Character index in field.
common /laptchat/ i
c---- Character index of beginning of field.
common /laptchat/ ibeg
c---- Character index of end of field + 1.
common /laptchat/ iendp
c---- Character index to end testing.
common /laptchat/ ilast
c---- Character index to start testing.
common /laptchat/ ipre
c---- Number of characters in field.
common /laptchat/ ncharw
c---- Error flag from aptchty.
common /laptchat/ nerrl
cbugc***DEBUG begins.
cbugc---- Data field mode label.
cbug common /captchat/ atype(-1:3)
cbugc---- Data field mode label.
cbug character*16 atype
cbug data atype / 'zero-length', 'bad data', 'character', 'integer',
cbug & 'floating-point' /
cbugc---- Index of delimited field.
cbug common /laptchat/ n
cbug 9901 format (/ 'aptchat cracking a character string.' /
cbug & ' isrce=',i3,' nchar=',i3,' nwordm='i3,' fd=',a1,
cbug & ' idmax=',i2,' iemax=',i3)
cbug 9902 format (' asrce=',64a1,(/ 8x,64a1))
cbug write ( 3, 9901) isrce, nchar, nwordm, fd, 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
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
ncharw = iendp - ibeg
c.... Test for zero-length fields.
c---- Two adjacent delimiters.
if (ncharw .eq. 0) then
do 160 i = 1, 8
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 aptchty (asrce, ibeg, ncharw, 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 (/ 'aptchat results: nword=',i3,' nerr=',i2)
cbug 9904 format (' field='i2,2x,8a1,i15,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,8),
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 aptchat. (+1 line.)
end
UCRL-WEB-209832