Trailing-Edge
-
PDP-10 Archives
-
decuslib10-08
-
43,50476/daihft.for
There are 2 other files named daihft.for in the archive. Click here to see a list.
SUBROUTINE DAIHFT(KONTRL,ITRAIL,IEXTRA,IBUFFR,MAXBFR,
1 LOWBFR,KIND ,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE)
C RENBR(/FREE FORMAT INTEGER INPUT ROUTINE)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C DAIHFT INTERPRETS AN ARRAY READ BY THE CALLING
C PROGRAM WITH A MULTIPLE OF AN A1 FORMAT AND RETURNS
C THE VALUES IN THIS ARRAY.
C
C NUMBERS INTERPRETTED BY DAIHFT CAN CONTAIN LEADING
C SIGN, EMBEDDED DECIMAL POINT AND/OR TRAILING E WITH
C SIGNED EXPONENT. A PERCENT SIGN FOLLOWING THE NUMBER
C IMPLIES E-2, TRAILING LETTER K IMPLIES E3 AND
C TRAILING LETTER M IMPLIES E6.
C
C ARGUMENT LIST DEFINITIONS:
C
C KONTRL = 0 OR GREATER, NUMBER IS EVALUATED AS DECIMAL
C INTEGER. NUMBER CAN CONTAIN A DECIMAL POINT
C (FOR EXAMPLE 1.23K OR 1.23E3 EQUALS 1230),
C BUT IS STORED AS AN INTEGER IN DAIHFT, AND
C IS OUTPUT AS ARGUMENT IVALUE. ANY DECIMAL
C INTEGER WHICH THE COMPUTER CAN REPRESENT CAN
C BE EVALUATED. THIS INCLUDES, ON TWOS
C COMPLEMENT COMPUTERS, THE LARGEST NEGATIVE
C NUMBER THE ABSOLUTE VALUE OF WHICH CANNOT BE
C STORED. ON THE PDP10, A 36 BIT COMPUTER
C WITH TWOS COMPLEMENT NOTATION, THE RANGE OF
C DECIMAL INTEGERS IS -34359738368 THROUGH
C 34359738367 (OCTAL NOTATION OF BIT PATTERNS
C BEING 400000000000 THROUGH 377777777777).
C = -1, ITEM IN IBUFFR ARRAY IS OCTAL. THE
C NUMBER CAN BE TYPED WITH A DECIMAL POINT
C AND/OR WITH AN EXPONENT. HOWEVER, THE
C NUMBER FOLLOWING THE LETTER E OF THE
C EXPONENT IS EVALUATED IN DECIMAL. THE VALUE
C OF THE OCTAL NUMBER IS RETURNED AS THE
C ARGUMENT IVALUE. IT MUST BE NOTED THAT
C NUMBERS EVALUATED AS NEGATIVE OCTAL INTEGERS
C HAVE THE NEGATIVE OCTAL INTEGER AS THEIR
C VALUE, NOT AS THEIR BIT REPRESENTATION IN
C COMPUTER STORAGE. FOR EXAMPLE, ON A 36 BIT
C TWOS COMPLEMENT COMPUTER, THE OCTAL NUMBER
C -400000000000 (WHICH COULD ALSO BE TYPED AS
C -4E11 OR -4E+11 WHERE THE 11 AFTER THE E IS
C IN DECIMAL) IS REPRESENTED AS BIT PATTERN
C HAVING OCTAL NOTATION 400000000000 AND THE
C OCTAL NUMBER -377777777777 IS REPRESENTED BY
C THE BIT PATTERN 400000000001.
C = -2, DO NOT EVALUATE NUMBERS. INSTEAD THE
C CHARACTERS FORMING NUMBER ARE TREATED LIKE
C ANY OTHER PRINTING CHARACTERS.
C ITRAIL = SPECIFIES WHETHER EXPONENTS ARE TO BE
C RECOGNIZED.
C = -1, ALLOW NUMBERS TO BE FOLLOWED BY E
C EXPONENT, BUT DO NOT RECOGNIZE PERCENT SIGN,
C K OR M AT END OF NUMBER. E IS NOT
C RECOGNIZED IF NOT PRECEDED BY SIGN, DECIMAL
C POINT OR DIGIT.
C = 0, DO NOT ALLOW TRAILING PERCENT SIGN, K M
C OR E EXPONENT.
C = 1, ALLOW NUMBERS TO BE FOLLOWED BY PERCENT
C SIGN, K M OR E EXPONENT. PERCENT SIGN, K M
C OR E IS NOT RECOGNIZED IF NOT PRECEDED BY
C SIGN, DECIMAL POINT OR DIGIT.
C
C FOLLOWING VALUES DO NOT REQUIRE THAT EXPONENT
C BE PRECEDED BY NUMBER. ALTHOUGH RETURNED
C VALUE WILL ALWAYS BE ZERO IF NO VALUE DIGITS
C ARE FOUND, CALLING PROGRAM COULD ADJUST THIS
C RETURNED VALUE.
C
C = -3, LEADING E EXPONENT IS RECOGNIZED.
C LEADING DIGITS, SIGNS AND DECIMAL POINTS ARE
C NOT ALLOWED.
C = -2, SAME AS ITRAIL=-1, EXCEPT THAT IN
C ADDITION E EXPONENT IS RECOGNIZED EVEN IF
C NOT PRECEDED BY DIGITS, SIGN OR DECIMAL
C POINT.
C = 2, SAME AS ITRAIL=1, EXCEPT THAT IN ADDITION
C LEADING PERCENT SIGN, OR LETTERS K M OR E
C EXPONENT ARE RECOGNIZED EVEN IF NOT PRECEDED
C BY DIGITS, SIGN OR DECIMAL POINT.
C = 3, ONLY LEADING PERCENT SIGN OR LETTERS K M
C OR E EXPONENT ARE RECOGNIZED. LEADING
C DIGITS, SIGNS OR DECIMAL POINTS ARE NOT
C ALLOWED.
C
C IF 10 IS SUBTRACTED FROM ITRAIL VALUES -3
C THROUGH 3, AND IF EITHER VALUE DIGITS OR
C DIGITS FOLLOWING LETTER E ARE MISSING, THEN
C ONE, RATHER THAN ZERO, IS ASSUMED TO BE THE
C DEFAULT FOR THE VALUE OR THE EXPONENT
C RESPECTIVELY. -E- WOULD BE EQUIVALENT TO
C -1E-1 AND -E OR -E+ WOULD BE EQUIVALENT TO
C -1E1
C
C IF 10 IS ADDED TO ITRAIL VALUES -3 THROUGH 3,
C THEN VALUE IS RETURNED AS THOUGH NEITHER
C EXPONENT NOR DECIMAL POINT HAD BEEN TYPED.
C VALUE INDICATED BY COMBINATION OF DIGITS,
C DECIMAL POINT AND/OR EXPONENT CAN BE OBTAINED
C AS VALUE*10**KSHIFT OR IVALUE*10**KSHIFT.
C VALUE INDICATED BY COMBINATION OF DIGITS AND
C DECIMAL POINT BUT IGNORING EXPONENT CAN BE
C OBTAINED AS VALUE*10**(KSHIFT-JSHIFT) OR
C IVALUE*10**(KSHIFT-JSHIFT).
C IEXTRA = EXTRA SHIFT TO BE APPLIED TO VALUE. SHIFT
C IS STATED AS POWER OF RADIX. THIS IS
C APPLIED IN ADDITION TO SHIFT REPORTED IN
C ISHIFT, JSHIFT AND KSHIFT AS SPECIFIED BY
C USER. FOR EXAMPLE, IF DOLLAR VALUE IS TO BE
C RETURNED AS INTEGER NUMBER OF CENTS, IEXTRA
C WOULD HAVE VALUE 2.
C IBUFFR = INPUT BUFFER ARRAY CONTAINING CHARACTERS
C TYPED BY USER, READ BY A MULTIPLE OF AN A1
C FORMAT, WHICH IS TO BE SEARCHED FOR WORDS
C AND NUMBERS. IBUFFR THEN CONTAINS 1 LETTER
C PER COMPUTER STORAGE LOCATION.
C MAXBFR = MAXIMUM SUBSCRIPT OF IBUFFR ARRAY TO BE
C SEARCHED
C LOWBFR = SUBSCRIPT WITHIN THE IBUFFR ARRAY OF THE
C FIRST (LEFTMOST) CHARACTER WHICH CAN BE
C SCANNED FOR NUMBERS. LOWBFR WILL BE RETURNED
C POINTING TO FIRST PRINTING CHARACTER WHICH
C CANNOT APPEAR IN A NUMBER, OR BEYOND THE END
C OF THE BUFFER IF THE BUFFER DOES NOT CONTAIN
C ANY PRINTING CHARACTERS.
C KIND = RETURNED DESCRIBING THE KIND OF ITEM LOCATED
C IN THE IBUFFR ARRAY.
C = 1, NOTHING WAS FOUND AT OR TO THE RIGHT OF
C LOWBFR. THE CALLING PROGRAM SHOULD READ A
C NEW LINE INTO IBUFFR.
C = 2, NUMBER WAS NOT FOUND, BUT A PRINTING
C CHARACTER WHICH CANNOT START A NUMBER WAS
C FOUND. LOWBFR IS RETURNED POINTING TO THIS
C PRINTING CHARACTER.
C = 3, A NUMBER WAS FOUND. LOWBFR IS RETURNED
C POINTING TO CHARACTER TO RIGHT OF NUMBER.
C ISHIFT = 0, RETURNED IF NONE OF CHARACTERS E, %, K OR
C M FOLLOW NUMBER
C = 1, PERCENT SIGN FOLLOWS NUMBER
C = 2, K FOLLOWS NUMBER
C = 3, M FOLLOWS NUMBER
C = LESS THAN ZERO, RETURNED IF E FOLLOWS
C NUMBER.
C = -1, E AND POSSIBLY SIGNED NUMBER FOLLOW
C NUMBER.
C = -2, E IS FOLLOWED BY PLUS SIGN NOT IN TURN
C FOLLOWED BY DIGITS.
C = -3, E IS FOLLOWED BY MINUS SIGN NOT IN TURN
C FOLLOWED BY DIGITS.
C = -4, E IS FOLLOWED BY NEITHER SIGN NOR DIGITS
C JSHIFT = EXPONENT INDICATED BY FOLLOWING PERCENT
C SIGN, K, M OR E FOLLOWED BY DIGITS. THIS
C WILL HAVE BEEN APPLIED TO RETURNED VALUE IF
C ITRAIL EQUALS EITHER -1 OR 1. 12.34K OR
C 12.34E3 WOULD GIVE JSHIFT OF 3. 12% OR
C 12E-2 WOULD GIVE JSHIFT -2.
C KSHIFT = EXPONENT WHICH WOULD BE NECESSARY TO OBTAIN
C DESIRED VALUE IF NUMBER HAD BEEN TYPED
C WITHOUT DECIMAL POINT. 12.34 STATED WITHOUT
C DECIMAL POINT WOULD BE 1234E-2 SO KSHIFT
C WOULD BE -2. 12.34K WOULD BE 1234E1 SO
C KSHIFT WOULD BE 1.
C LSHIFT = ZERO OR LESS, THE VALUE ZERO IS BEING
C RETURNED FOR EITHER VALUE OR IVALUE,
C WHICHEVER IS APPROPRIATE.
C = -4, NUMBER CONTAINED NEITHER VALUE DIGITS,
C NOR DECIMAL POINT, NOR LEADING PLUS SIGN,
C NOR LEADING MINUS SIGN. THIS VALUE OF
C LSHIFT IS ALWAYS RETURNED IF KIND IS
C RETURNED CONTAINING A VALUE OTHER THAN 3.
C IF KIND IS RETURNED CONTAINING THE VALUE 3,
C THEN ITRAIL MUST BE EITHER -3 OR 3, AND THE
C CONTENTS OF THE INPUT TEXT BUFFER MUST BEGIN
C WITH A REPRESENTATION OF AN EXPONENT.
C = -3, A LEADING MINUS SIGN BUT NO VALUE DIGITS
C WAS FOUND.
C = -2, A LEADING PLUS SIGN BUT NO VALUE DIGITS
C WAS FOUND.
C = -1, A LEADING PERIOD BUT NO VALUE DIGITS WAS
C FOUND.
C = 0, ONE OR MORE ZERO DIGITS WERE FOUND, BUT
C THE NUMBER CONTAINED NO DIGITS OTHER THAN
C ZERO. THE NUMBER REPRESENTATION MAY OR MAY
C NOT HAVE BEEN BEGUN BY A PLUS SIGN OR A
C MINUS SIGN AND MAY OR MAY NOT HAVE CONTAINED
C A DECIMAL POINT.
C = GREATER THAN ZERO, LSHIFT IS NUMBER OF
C DIGITS COUNTING LEFTMOST NON-ZERO DIGIT AND
C ALL WHICH WERE SPECIFIED TO ITS RIGHT. THIS
C IS INDEPENDENT OF ANY SHIFT IMPLIED BY A
C DECIMAL POINT OR EXPONENT
C IVALUE = RETURNED WITH VALUE IF NUMBER IS FOUND. THE
C ORIGINAL CONTENT OF IVALUE IS DESTROYED. IN
C PARTICULAR, IF KIND IS RETURNED CONTAINING
C EITHER 1 OR 2, THEN IVALUE WILL BE ZEROED.
C
DIMENSION IBUFFR(MAXBFR),IDIGIT(10),KAPLTR(3),
1LOWLTR(3),JPOWER(3)
C
C IDIGIT CONTAINS ALPHAMERIC FORM OF DIGITS 0 THRU 9
DATA IDIGIT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
C
C IBLANK CONTAINS SPACE CHARACTER AND ITAB CONTAINS
C TAB CHARACTER. IF TAB CHARACTER IS NOT AVAILABLE,
C ITAB SHOULD INSTEAD CONTAIN A SPACE ALSO.
DATA IPLUS,IMINUS,IDOT,IBLANK,ITAB/
11H+,1H-,1H.,1H ,1H /
C
C KAPLTR = LIST OF UPPER CASE LETTERS WHICH CAN FOLLOW
C A NUMBER TO INDICATE AN EXPONENT.
C LOWLTR = LIST OF LOWER CASE LETTERS CORRESPONDING TO
C UPPER CASE LETTERS IN KAPLTR ARRAY.
C JPOWER = VALUE OF THE EXPONENT ASSOCIATED WITH THE
C PARALLEL CHARACTERS IN THE KAPLTR AND LOWLTR
C ARRAYS. JPOWER CAN BE NEGATIVE, FOR EXAMPLE
C PERCENT SIGN WOULD CORRESPOND TO JPOWER=-2.
C MAXTST = NUMBER OF ITEMS IN EACH OF KAPLTR, LOWLTR
C AND JPOWER ARRAYS.
C KAPEXP = UPPER CASE LETTER E
C LOWEXP = LOWER CASE LETTER E
C
C UPPER CASE LETTERS CAN BE SUBSTITUTED FOR LOWER CASE
C IN FOLLOWING DATA STATEMENTS, IF COMPUTER UPON WHICH
C THIS ROUTINE IS USED DOES NOT SUPPORT LOWER CASE.
C
DATA KAPLTR/1H%,1HK,1HM/
DATA LOWLTR/1H%,1Hk,1Hm/
DATA JPOWER/-2,3,6/
DATA MAXTST/3/
DATA KAPEXP,LOWEXP/1HE,1He/
C
C INITIALIZE
ISIGN=0
IVALUE=0
ISHIFT=0
JSHIFT=0
KSHIFT=0
LSHIFT=-4
IRADIX=10
IF(KONTRL.LT.0)IRADIX=8
IADD=IRADIX-2
IPOWER=0
NUMKNT=-4
NMBEXP=-1
NUMPNT=-1
IDEFLT=0
IF(ITRAIL.LT.-5)IDEFLT=1
KTRAIL=ITRAIL
IF(KTRAIL.GT.5)KTRAIL=KTRAIL-10
IF(KTRAIL.LT.-5)KTRAIL=KTRAIL+10
LTRAIL=KTRAIL
IF(LTRAIL.LT.0)LTRAIL=-LTRAIL
GO TO 2
C
C *********************
C * SCAN FOR NUMBER *
C *********************
C
C LOOP LOOKING AT CHARACTERS IN IBUFFR ARRAY
1 LOWBFR=LOWBFR+1
2 IF(LOWBFR.GT.MAXBFR)GO TO 23
NOWLTR=IBUFFR(LOWBFR)
IF(NMBEXP.GE.0)GO TO 18
IF(ISIGN.NE.0)GO TO 4
C
C SCAN OVER LEADING SPACES AND/OR TABS
IF(NOWLTR.EQ.IBLANK)GO TO 1
IF(NOWLTR.EQ.ITAB)GO TO 1
C
C LOOK FOR INITIAL SIGNS + OR -
IF(KONTRL.LE.-2)GO TO 34
IF(LTRAIL.GE.3)GO TO 4
IF(NOWLTR.EQ.IPLUS)GO TO 3
IF(NOWLTR.NE.IMINUS)GO TO 4
ISIGN=-1
NUMKNT=-3
GO TO 1
3 ISIGN=1
NUMKNT=-2
GO TO 1
C
C LOOK FOR % K OR M FOLLOWING NUMBER
C LOCK OUT THESE AND ALSO E IF NO PART OF NUMBER FOUND
4 IF(LTRAIL.GE.2)GO TO 5
IF(ISIGN.EQ.0)GO TO 10
IF(KTRAIL.EQ.0)GO TO 10
5 IF(KTRAIL.LT.0)GO TO 8
I=0
6 I=I+1
IF(I.GT.MAXTST)GO TO 8
IF(NOWLTR.EQ.KAPLTR(I))GO TO 7
IF(NOWLTR.NE.LOWLTR(I))GO TO 6
7 IPOWER=JPOWER(I)
JSIGN=1
NMBEXP=1
ISHIFT=I
LOWBFR=LOWBFR+1
GO TO 24
C
C LOOK FOR LETTER E
8 IF(NOWLTR.EQ.KAPEXP)GO TO 9
IF(NOWLTR.NE.LOWEXP)GO TO 10
9 JSIGN=0
NMBEXP=0
ISHIFT=-4
GO TO 17
C
C LOOK FOR LEADING OR EMBEDDED PERIOD
10 IF(LTRAIL.GE.3)GO TO 22
IF(NUMPNT.GE.0)GO TO 11
IF(NOWLTR.NE.IDOT)GO TO 11
IF(ISIGN.EQ.0)NUMKNT=-1
GO TO 16
C
C LOOK FOR DIGIT OTHER THAN IN EXPONENT FIELD
11 DO 14 I=1,IRADIX
IF(NOWLTR.NE.IDIGIT(I))GO TO 14
IF(NUMKNT.GT.0)GO TO 12
NUMKNT=0
IF(I.EQ.1)GO TO 13
12 NUMKNT=NUMKNT+1
C FOLLOWING ALLOWS LARGEST NEGATIVE NUMBER FOR
C WHICH THERE IS NOT CORRESPONDING POSITIVE VALUE
13 IF(NUMKNT.EQ.1)IVALUE=I-2
IF(NUMKNT.GT.1)IVALUE=(IRADIX*IVALUE)+I+IADD
GO TO 15
14 CONTINUE
GO TO 22
C
C DIGIT, E OR . FOUND SO MARK AS BEING IN NUMBER
15 IF(NUMPNT.LT.0)GO TO 17
16 NUMPNT=NUMPNT+1
17 IF(ISIGN.EQ.0)ISIGN=1
GO TO 1
C
C LOOK FOR SIGN IN EXPONENT FIELD
18 IF(JSIGN.NE.0)GO TO 20
IF(NOWLTR.EQ.IPLUS)GO TO 19
IF(NOWLTR.NE.IMINUS)GO TO 20
JSIGN=-1
ISHIFT=-3
GO TO 1
19 JSIGN=1
ISHIFT=-2
GO TO 1
C
C LOOK FOR DIGITS IN EXPONENT FIELD
20 DO 21 I=1,10
IF(NOWLTR.NE.IDIGIT(I))GO TO 21
IPOWER=(10*IPOWER)+I-1
NMBEXP=1
ISHIFT=-1
IF(JSIGN.EQ.0)JSIGN=1
GO TO 1
21 CONTINUE
GO TO 24
C
C DECIDE WHAT TO DO IF NO MATCH FOUND
22 IF(ISIGN.NE.0)GO TO 24
GO TO 34
C
C *******************************
C * NUMBER HAS BEEN EVALUATED *
C *******************************
C
23 IF(ISIGN.EQ.0)GO TO 33
24 KIND=3
C
C ADJUST EXPONENT SIGN
IF(NMBEXP.LT.0)GO TO 25
IF(NMBEXP.EQ.0)IPOWER=IDEFLT
IF(JSIGN.LT.0)IPOWER=-IPOWER
C
C SHIFT AN INTEGER ACCORDING TO EXPONENT
25 JSHIFT=IPOWER
KSHIFT=IPOWER
IF(NUMPNT.GT.0)KSHIFT=KSHIFT-NUMPNT
LSHIFT=NUMKNT
IF(NUMPNT.GT.0)IPOWER=IPOWER-NUMPNT
IF(ITRAIL.GT.5)IPOWER=0
IPOWER=IPOWER+IEXTRA
IF(NUMKNT.LT.0)IVALUE=IDEFLT
IF(ISIGN.GE.0)GO TO 26
IVALUE=-IVALUE
C NOTE THAT NEGATIVE NUMBER AT THIS POINT HAS ABSOLUTE
C VALUE 1 TOO LOW TO ALLOW THE LARGEST NEGATIVE NUMBER
C WHICH HAS NO CORRESPONDING POSITIVE VALUE IN TWOS
C COMPLEMENT NOTATION
IF(NUMKNT.GT.0)IVALUE=IVALUE-1
GO TO 27
26 IF(NUMKNT.GT.0)IVALUE=IVALUE+1
27 IF(IPOWER.LE.0)GO TO 31
IPOWER=IPOWER-1
KVALUE=IVALUE
IVALUE=IRADIX*IVALUE
IF(ISIGN.GE.0)GO TO 28
IF(IVALUE.GE.KVALUE)GO TO 30
GO TO 29
28 IF(IVALUE.LE.KVALUE)GO TO 30
29 IF((IVALUE/IRADIX).EQ.KVALUE)GO TO 27
30 IVALUE=KVALUE
31 IF(IPOWER.GE.0)GO TO 35
IPOWER=IPOWER+1
KVALUE=IVALUE
IVALUE=IVALUE/IRADIX
IF(ISIGN.GE.0)GO TO 32
IF((IRADIX*IVALUE).LT.KVALUE)IVALUE=IVALUE+1
32 IF(IVALUE.NE.0)GO TO 31
GO TO 35
C
C IF DELIMITER AT END OF LINE, MARK VALUE AS MISSING
33 KIND=1
GO TO 35
34 KIND=2
C
C RETURN TO CALLING PROGRAM
35 RETURN
C
C IBLANK = THE BLANK OR SPACE CHARACTER
C JSIGN = 0, NEITHER SIGN NOR DIGITS AFTER E
C = 1, EITHER PLUS OR DIGITS AFTER E
C = -1, MINUS SIGN AFTER E
C ITAB = THE TAB CHARACTER
C ISIGN = 0, NO PART OF NUMBER ENCOUNTERED
C = -1, MINUS SIGN AT START OF NUMBER
C = 1, NUMBER DOES NOT START WITH MINUS SIGN
C NMBEXP = -1, NO EXPONENT FIELD YET FOUND
C = 0, EXPONENT FIELD FOUND BUT NUMBER NOT
C YET FOUND
C = 1, NUMBER FOUND IN EXPONENT FIELD
C NOWLTR = THE CHARACTER CURRENTLY BEING TESTED
C NUMKNT = NUMBER OF DIGITS IN VALUE FIELD
C = 0, LEFT HAND ZERO ONLY READ SO FAR
C = -1, NO DIGITS YET FOUND
C NUMPNT = -1, DECIMAL POINT NOT YET FOUND
C = 0, DECIMAL POINT ENCOUNTERED IN VALUE FIELD
C = .GT.0, VALUE IS NUMBER OF DIGITS ENCOUNTERED
C TO RIGHT OF DECIMAL POINT IN NUMBER.
C982714844451%kme
END