Trailing-Edge
-
PDP-10 Archives
-
decuslib10-08
-
43,50476/dateam.for
There are 2 other files named dateam.for in the archive. Click here to see a list.
SUBROUTINE DATEAM(KONTNU,KONTRL,ITRAIL,NUMMAX,MAXBFR,
1 IBUFFR,LOWBFR,NUMKNT,KIND ,NUMVAL,VALNUM)
C RENBR(/EVALUATE SEVERAL NUMBERS IN SINGLE LINE)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C A SINGLE CALL TO DATEAM INTERPRETS AN ARRAY READ BY
C THE CALLING PROGRAM WITH A MULTIPLE OF AN A1 FORMAT
C AND RETURNS ALL OF THE VALUES REPRESENTED IN THIS
C ARRAY. IF MORE VALUES ARE FOUND THAN CAN BE STORED
C IN THE ARRAY PROVIDED FOR RETURNING THESE VALUES TO
C THE CALLING PROGRAM, THEN DATEAM CAN INDICATE THE
C FIRST CHARACTER OF THE FIRST EXTRA NUMBER, OR CAN
C SCAN ACROSS AND POSSIBLY COUNT THE EXCESS NUMBERS.
C
C FOLLOWING ARGUMENTS ARE USED FOR INPUT ONLY AND ARE
C RETURNED UNCHANGED.
C
C KONTNU = -1, IF MORE VALUES ARE FOUND THAN CAN BE
C RETURNED IN NUMVAL OR VALNUM ARRAY, THEN
C KIND IS RETURNED CONTAINING 5 AND LOWBFR IS
C RETURNED POINTING TO LEFT CHARACTER OF FIRST
C EXCESS NUMBER.
C = 0, IF MORE VALUES ARE FOUND THAN CAN BE
C RETURNED IN NUMVAL OR VALNUM ARRAY, THEN
C EXCESS VALUES ARE INTERPRETED AND LOWBFR IS
C RETURNED POINTING BEYOND FINAL NUMBER, BUT
C NUMKNT IS NOT INCREMENTED FOR THESE EXCESS
C VALUES AND EXCESS VALUES ARE NOT RETURNED TO
C CALLING PROGRAM.
C = 1, IF MORE VALUES ARE FOUND THAN CAN BE
C RETURNED IN NUMVAL OR VALNUM ARRAY, THEN
C EXCESS VALUES ARE INTERPRETED, LOWBFR IS
C RETURNED POINTING BEYOND FINAL NUMBER, AND
C NUMKNT IS INCREMENTED FOR EACH VALUE FOUND,
C BUT EXCESS VALUES ARE NOT RETURNED TO
C CALLING PROGRAM.
C KONTRL = IF REPRESENTATION OF NUMBER IS FOUND, KONTRL
C SPECIFIES WHETHER VALUE IS TO BE RETURNED IN
C INTEGER ARRAY WHICH IS NAMED NUMVAL OR IN
C REAL ARRAY WHICH IS NAMED VALNUM. NUMBER
C CAN BE TYPED WITH DECIMAL POINT AND/OR
C EXPONENT REGARDLESS OF VALUE OF KONTRL.
C = -1, VALUE IS CALCULATED AS OCTAL INTEGER AND
C IS RETURNED IN NUMVAL ARRAY. HOWEVER,
C NUMBER FOLLOWING LETTER E OF EXPONENT IS
C EVALUATED IN DECIMAL.
C = 0, VALUE IS CALCULATED AS DECIMAL INTEGER
C AND IS RETURNED IN NUMVAL ARRAY.
C = 1 OR GREATER, VALUE IS RETURNED IN VALNUM
C ARRAY. IF POSSIBLE, REAL NUMBER WILL BE
C ACCUMULATED AS INTEGER, THEN BE CONVERTED TO
C REAL AND SHIFTED AS NECESSARY. KONTRL IS
C MAXIMUM NUMBER OF DIGITS IN INTEGER.
C ITRAIL = SELECTS WHETHER EXPONENTS ARE TO BE
C RECOGNIZED. IF EXPONENTS ARE NOT TO BE
C RECOGNIZED BUT EXPONENT IS FOUND, THEN
C EVALUATION OF CONTENTS OF INPUT TEXT BUFFER
C WILL BE TERMINATED PRIOR TO EXPONENT AND
C FIRST CHARACTER OF EXPONENT WILL BE TREATED
C SAME AS ANY OTHER UNKNOWN ALPHABETIC
C CHARACTER. WHEN SUCH UNKNOWN CHARACTER IS
C FOUND, KIND IS RETURNED CONTAINING 4 AND
C LOWBFR IS RETURNED POINTING TO UNKNOWN
C CHARACTER.
C = -1, EXPONENTS EXPRESSED IN E NOTATION ARE TO
C BE RECOGNIZED, BUT PERCENT SIGN AND LETTERS
C K AND M ARE TO BE TREATED SAME AS ANY OTHER
C ALPHABETIC CHARACTERS.
C = 0, NO EXPONENTS ARE TO BE RECOGNIZED.
C EVALUATION WILL BE TERMINATED PRIOR TO
C PERCENT SIGNS OR TO LETTERS E OR K OR M.
C = 1, PERCENT SIGNS, LETTERS K AND M, AND
C EXPONENTS EXPRESSED IN E NOTATION ARE ALL TO
C BE RECOGNIZED.
C NUMMAX = HIGHEST SUBSCRIPT OF NUMVAL OR VALNUM ARRAY
C LOCATIONS INTO WHICH CAN BE PLACED VALUES
C REPRESENTED BY CHARACTERS IN IBUFFR ARRAY.
C MAXBFR = SUBSCRIPT OF IBUFFR ARRAY LOCATION
C CONTAINING RIGHTMOST (HIGHEST SUBSCRIPT)
C CHARACTER IN LINE OF TEXT BEING INTERPRETED.
C MAXBFR WOULD NORMALLY BE DIMENSION OF IBUFFR
C ARRAY.
C IBUFFR = INPUT BUFFER ARRAY CONTAINING CHARACTERS OF
C LINE OF TEXT TO BE INTERPRETED, ONE
C CHARACTER PER ARRAY LOCATION, AS READ BY
C MULTIPLE OF A1 FORMAT.
C
C FOLLOWING ARGUMENTS ARE USED BOTH FOR INPUT TO THIS
C ROUTINE AND FOR OUTPUT TO CALLING PROGRAM.
C
C LOWBFR = INPUT CONTAINING SUBSCRIPT OF IBUFFR ARRAY
C LOCATION WHICH CONTAINS LEFTMOST (LOWEST
C SUBSCRIPT) CHARACTER WHICH IS TO BE
C INTERPRETED BY THIS ROUTINE. LOWBFR IS
C RETURNED POINTING TO LEFTMOST CHARACTER NOT
C YET IDENTIFIED BY THIS ROUTINE. LOWBFR IS
C RETURNED CONTAINING SUBSCRIPT OF IBUFFR
C ARRAY LOCATION CONTAINING UNKNOWN CHARACTER
C (KIND BEING RETURNED CONTAINING 4) OR
C CONTAINING CHARACTER TO RIGHT OF SEMICOLON
C (KIND BEING RETURNED CONTAINING 2). IF
C KONTNU IS SET TO -1 AND IF MORE VALUES ARE
C FOUND THAN CAN BE STORED IN AVAILABLE
C PORTION OF NUMVAL OR VALNUM ARRAY, THEN
C LOWBFR IS RETURNED CONTAINING SUBSCRIPT OF
C IBUFFR ARRAY LOCATION WHICH CONTAINS FIRST
C CHARACTER OF FIRST VALUE WHICH COULD NOT BE
C STORED. IF AMPERSAND OR EXCLAMATION POINT
C IS FOUND OR IF ALL CHARACTERS IN INPUT TEXT
C BUFFER HAVE BEEN INTERPRETED, THEN LOWBFR IS
C RETURNED POINTING BEYOND RIGHT END OF
C BUFFER.
C NUMKNT = INPUT CONTAINING SUBSCRIPT OF HIGHEST
C LOCATION IN NUMVAL OR VALNUM ARRAY WHICH IS
C CURRENTLY IN USE AND WHICH MUST THEREFORE BE
C RETURNED UNCHANGED. FIRST VALUE FOUND BY
C THIS ROUTINE WILL BE STORED IN
C NUMVAL(NUMKNT+1) OR IN VALNUM(NUMKNT+1). IF
C KONTNU IS LESS THAN OR EQUAL TO ZERO, OR IF
C KONTNU IS GREATER THAN ZERO BUT NO MORE THAN
C NUMMAX-NUMKNT VALUES ARE FOUND, THEN NUMKNT
C IS RETURNED CONTAINING SUBSCRIPT OF HIGHEST
C LOCATION IN NUMVAL OR VALNUM ARRAY WHICH WAS
C USED BY THIS ROUTINE FOR STORAGE OF VALUES
C REPRESENTED BY TEXT IN IBUFFR ARRAY. IF
C KONTNU IS GREATER THAN ZERO, BUT MORE THAN
C NUMMAX-NUMKNT VALUES ARE FOUND, THEN
C LOCATIONS ABOVE NUMVAL(NUMMAX) OR
C VALNUM(NUMMAX) ARE RETURNED UNCHANGED, BUT
C NUMKNT IS RETURNED INCREMENTED AS THOUGH
C THESE EXCESS VALUES HAD BEEN STORED.
C
C FOLLOWING ARGUMENTS ARE USED ONLY FOR OUTPUT TO
C CALLING PROGRAM. THEIR INPUT VALUES ARE IGNORED.
C
C KIND = RETURNED DESCRIBING REASON FOR TRANSFER OF
C CONTROL BACK TO CALLING PROGRAM. KIND DOES
C NOT INDICATE WHETHER ANY VALUES HAVE BEEN
C STORED IN NUMVAL OR VALNUM ARRAY.
C = 1, ALL CHARACTERS CURRENTLY WITHIN IBUFFR
C ARRAY HAVE BEEN INTERPETED. IF EXCLAMATION
C POINT WAS FOUND, THEN CHARACTERS TO RIGHT OF
C EXCLAMATION POINT HAVE BEEN IGNORED AND
C LOWBFR IS RETURNED CONTAINING MAXBFR+1.
C = 2, SEMICOLON WAS FOUND. LOWBFR IS RETURNED
C POINTING TO CHARACTER TO RIGHT OF SEMICOLON.
C IF SEMICOLONS ARE TO BE CONSIDERED AS
C EQUIVALENT TO SPACES, THEN CALLING PROGRAM
C SHOULD AGAIN CALL THIS ROUTINE WITHOUT FIRST
C CHANGING VALUES OF ANY OF ARGUMENTS.
C = 3, AMPERSAND WAS FOUND. CHARACTERS TO RIGHT
C OF AMPERSAND HAVE BEEN IGNORED AND LOWBFR IS
C RETURNED CONTAINING MAXBFR+1. IF AMPERSAND
C INDICATES THAT TEXT REPRESENTING ADDITIONAL
C VALUES IS TO BE READ BY CALLING PROGRAM,
C THEN LOWBFR SHOULD BE RESET TO POINT TO
C START OF NEW TEXT BEFORE THIS ROUTINE IS
C CALLED AGAIN.
C = 4, UNKNOWN CHARACTER WAS FOUND. LOWBFR IS
C RETURNED CONTAINING SUBSCRIPT OF IBUFFR
C ARRAY LOCATION CONTAINING THIS UNKNOWN
C CHARACTER. IF UNKNOWN CHARACTER IS TO BE
C CONSIDERED AS EQUIVALENT TO SPACE, THEN
C LOWBFR MUST BE INCREMENTED BY ONE BEFORE
C THIS ROUTINE IS CALLED AGAIN.
C = 5, KONTNU CONTAINS -1 AND VALUE WAS FOUND
C WHICH COULD NOT BE STORED IN AVAILABLE
C PORTION OF NUMVAL OR VALNUM ARRAY. LOWBFR
C IS RETURNED POINTING TO LEFTMOST CHARACTER
C IN REPRESENTATION OF NUMBER. CALLING
C PROGRAM MUST SUPPLY ADDITONAL SPACE IN
C NUMVAL OR VALNUM ARRAY OR ELSE MUST RESET
C KONTNU TO BE ZERO OR GREATER BEFORE AGAIN
C CALLING THIS ROUTINE TO PROCESS REMAINING
C TEXT IN IBUFFR ARRAY.
C NUMVAL = ARRAY INTO WHICH ARE STORED INTEGER VALUES
C REPRESENTED BY TEXT IN IBUFFR ARRAY IF
C KONTRL IS LESS THAN OR EQUAL TO ZERO.
C VALNUM = ARRAY INTO WHICH ARE STORED REAL VALUES
C REPRESENTED BY TEXT IN IBUFFR ARRAY IF
C KONTRL IS GREATER THAN ZERO.
C
DIMENSION NUMVAL(NUMMAX),VALNUM(NUMMAX),
1IBUFFR(MAXBFR)
DATA KOMMA,KOMENT,IAND,IEND/1H,,1H!,1H&,1H;/
C
C OBTAIN NEXT NUMBER
1 INITAL=LOWBFR
CALL DAHEFT(KONTRL,ITRAIL,0,IBUFFR,MAXBFR,
1LOWBFR,ITYPE,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE,
2VALUE)
GO TO (11,2,6),ITYPE
C
C UNKNOWN CHARACTER FOUND
2 LETTER=IBUFFR(LOWBFR)
IF(LETTER.EQ.KOMMA)GO TO 3
IF(LETTER.EQ.IEND)GO TO 4
IF(LETTER.EQ.IAND)GO TO 5
IF(LETTER.EQ.KOMENT)GO TO 10
KIND=4
GO TO 12
C
C SKIP OVER COMMA AND CONTINUE
3 LOWBFR=LOWBFR+1
GO TO 1
C
C SEMICOLON FOUND
4 KIND=2
LOWBFR=LOWBFR+1
GO TO 12
C
C AMPERSAND FOUND
5 KIND=3
LOWBFR=MAXBFR+1
GO TO 12
C
C INSERT NEW VALUE INTO THE LIST
6 IF(NUMKNT.GE.NUMMAX)GO TO 8
NUMKNT=NUMKNT+1
IF(KONTRL.GT.0)GO TO 7
NUMVAL(NUMKNT)=IVALUE
GO TO 1
7 VALNUM(NUMKNT)=VALUE
GO TO 1
C
C TOO MANY VALUES FOUND
8 IF(KONTNU.LT.0)GO TO 9
IF(KONTNU.GT.0)NUMKNT=NUMKNT+1
GO TO 1
9 KIND=5
LOWBFR=INITAL
GO TO 12
C
C INPUT BUFFER IS EMPTY
10 LOWBFR=MAXBFR+1
11 KIND=1
C
C RETURN TO CALLING PROGRAM
12 RETURN
C293727231057!&;
END