Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - 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