Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0141/dairnk.for
There are 2 other files named dairnk.for in the archive. Click here to see a list.
SUBROUTINE DAIRNK(INCRES,IFTEST,MINMUM,MAXMUM,MINSTR,
1 MAXSTR,IBUFFR,MAXBFR,LOWBFR,KIND ,MAXUSD,ISTORE)
C RENBR(/RETURNS SORTED INTEGERS)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C DAIRNK RETURNS A GROUP OF INTEGERS SORTED INTO EITHER
C INCREASING OR DECREASING ORDER. DUPLICATES ARE NOT
C RETURNED.
C
C INCRES = 1, RETURN VALUES IN ISTORE SORTED INTO
C DECREASING ORDER. IF MORE VALUES ARE FOUND
C THAN CAN BE RETURNED IN ISTORE ARRAY, THEN
C SMALLER VALUES ARE DISCARDED.
C = 2, RETURN VALUES IN ISTORE SORTED INTO
C DECREASING ORDER. IF MORE VALUES ARE FOUND
C THAN CAN BE RETURNED IN ISTORE ARRAY, THEN
C LARGER VALUES ARE DISCARDED.
C = 3, RETURN VALUES IN ISTORE SORTED INTO
C INCREASING ORDER. IF MORE VALUES ARE FOUND
C THAN CAN BE RETURNED IN ISTORE ARRAY, THEN
C SMALLER VALUES ARE DISCARDED.
C = 4, RETURN VALUES IN ISTORE SORTED INTO
C INCREASING ORDER. IF MORE VALUES ARE FOUND
C THAN CAN BE RETURNED IN ISTORE ARRAY, THEN
C LARGER VALUES ARE DISCARDED.
C IFTEST = -2 OR 2, THERE ARE NO MINIMUM AND MAXIMUM
C LIMITS TO RANGE OF LEGAL VALUES.
C = -1, REJECT VALUES LESS THAN MINMUM.
C = 0, REJECT VALUES LESS THAN MINMUM OR GREATER
C THAN MAXMUM.
C = 1, REJECT VALUES GREATER THAN MAXMUM.
C MINMUM = LOWER LIMIT OF ALLOWED VALUES IF IFTEST IS
C -1 OR 0. VALUES LESS THAN MINMUM ARE NOT
C RETURNED IN ISTORE IF IFTEST IS -1 OR 0.
C MAXMUM = UPPER LIMIT OF ALLOWED VALUES IF IFTEST IS 0
C OR 1. VALUES GREATER THAN MAXMUM ARE NOT
C RETURNED IN ISTORE IF IFTEST IS 0 OR 1.
C MINSTR = SUBSCRIPT OF LOWEST LOCATION IN ISTORE ARRAY
C INTO WHICH VALUE CAN BE PLACED.
C MAXSTR = SUBSCRIPT OF HIGHEST LOCATION IN ISTORE
C ARRAY INTO WHICH VALUE CAN BE PLACED.
C IBUFFR = INPUT TEXT BUFFER CONTAINING 1 CHARACTER PER
C ARRAY LOCATION AS READ BY MULTIPLE OF A1
C FORMAT.
C MAXBFR = MAXIMUM SUBSCRIPT OF IBUFFR ARRAY LOCATION
C TO BE SEARCHED FOR CHARACTERS.
C LOWBFR = INPUT CONTAINING SUBSCRIPT OF IBUFFR ARRAY
C LOCATION CONTAINING FIRST CHARACTER TO BE
C TESTED. LOWBFR IS RETURNED CONTAINING
C SUBSCRIPT OF IBUFFR ARRAY LOCATION
C CONTAINING NEXT CHARACTER NOT YET EVALUATED.
C KIND = SHOULD BE INPUT CONTAINING ZERO (OR ONE)
C WHENEVER THIS ROUTINE IS CALLED TO GENERATE
C NEW GROUP OF SORTED NUMBERS. KIND IS
C RETURNED DESCRIBING REASON FOR RETURN TO
C CALLING PROGRAM. IF KIND IS RETURNED
C CONTAINING VALUE OF 3 OR GREATER, AND IS
C SENT TO SUBSEQUENT CALL UNCHANGED, THEN
C MAXUSD IS NOT RESET TO MINSTR-1, AND NEW
C VALUES ARE APPENDED TO OLD CONTENTS, IF ANY,
C OF ISTORE.
C = 1, RETURNED EITHER IF NO PRINTING CHARACTERS
C ARE FOUND BEYOND NUMBERS, OR IF EXCLAMATION
C POINT IS NEXT CHARACTER BEYOND NUMBERS.
C LOWBFR IS RETURNED POINTING BEYOND END OF
C BUFFER.
C = 2, RETURNED IF SEMICOLON WAS FOUND AS NEXT
C PRINTING CHARACTER BEYOND NUMBERS. LOWBFR
C IS RETURNED POINTING TO NEXT CHARACTER
C BEYOND SEMICOLON.
C = 3, RETURNED IF AMPERSAND WAS FOUND AS NEXT
C PRINTING CHARACTER BEYOND NUMBERS. LOWBFR
C IS RETURNED POINTING BEYOND END OF BUFFER.
C = 4, RETURNED IF UNKNOWN CHARACTER WAS FOUND
C AS NEXT PRINTING CHARACTER BEYOND NUMBERS.
C LOWBFR IS RETURNED POINTING TO THIS UNKNOWN
C CHARACTER. LOWBFR MUST BE INCREMENTED BY
C CALLING PROGRAM BEFORE THIS ROUTINE IS NEXT
C CALLED.
C MAXUSD = RETURNED CONTAINING SUBSCRIPT OF HIGHEST
C LOCATION IN ISTORE USED TO RETURN SORTED
C VALUES.
C ISTORE = ARRAY USED TO RETURN SORTED VALUES IN
C ISTORE(MINSTR) THROUGH AND INCLUDING
C ISTORE(MAXUSD).
C
DIMENSION IBUFFR(MAXBFR),ISTORE(MAXSTR)
JNCRES=INCRES-2
MANY=0
MINTST=IFTEST
IF(MINTST.LT.-1)MINTST=1
MAXTST=IFTEST
IF(MAXTST.GT.1)MAXTST=-1
IF(KIND.LT.3)MAXUSD=MINSTR-1
1 CALL DAMISS(0,1,0,IBUFFR,MAXBFR,
1LOWBFR,KIND,ISHIFT,JSHIFT,KSHIFT,LSHIFT,NEWVAL,
2VALUE,MANY,LCNBFR,LCNERR)
GO TO(23,22,2,2,20,21,1),KIND
C
C TEST IF NEW VALUE IS IN REGION BEING DISCARDED
2 IF(MINTST.GT.0)GO TO 3
IF(NEWVAL.LT.MINMUM)GO TO 1
3 IF(MAXTST.LT.0)GO TO 4
IF(NEWVAL.GT.MAXMUM)GO TO 1
C
C TEST IF NEW VALUE IS ALREADY KNOWN
4 MIDDLE=MINSTR-1
IF(MAXUSD.LT.MINSTR)GO TO 11
IUPPER=MAXUSD
5 ILOWER=MIDDLE+1
GO TO 7
6 IUPPER=MIDDLE-1
7 IHALF=(IUPPER-ILOWER)/2
MIDDLE=IUPPER-IHALF
IF(NEWVAL.EQ.ISTORE(MIDDLE))GO TO 1
IF(JNCRES.GT.0)GO TO 8
IF(NEWVAL.LT.ISTORE(MIDDLE))GO TO 10
GO TO 9
8 IF(NEWVAL.GT.ISTORE(MIDDLE))GO TO 10
9 IF(IHALF.GT.0)GO TO 6
IF(IUPPER.LE.ILOWER)GO TO 12
IUPPER=ILOWER
GO TO 7
10 IF(IHALF.GT.0)GO TO 5
C
C SHIFT REST OF ARRAY AND INSERT NEW VALUE
11 MIDDLE=MIDDLE+1
12 IF(MAXUSD.LT.MAXSTR)GO TO 14
GO TO(13,17,17,13),INCRES
13 IF(MIDDLE.GT.MAXSTR)GO TO 1
GO TO 15
14 MAXUSD=MAXUSD+1
15 I=MAXUSD
16 IF(I.LE.MIDDLE)GO TO 19
ISTORE(I)=ISTORE(I-1)
I=I-1
GO TO 16
17 IF(MIDDLE.LE.MINSTR)GO TO 1
MIDDLE=MIDDLE-1
I=MINSTR
18 IF(I.GE.MIDDLE)GO TO 19
ISTORE(I)=ISTORE(I+1)
I=I+1
GO TO 18
19 ISTORE(MIDDLE)=NEWVAL
GO TO 1
20 KIND=2
GO TO 23
21 KIND=3
GO TO 23
22 KIND=4
23 RETURN
C445263597068
END