Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-08 - 43,50476/dasite.for
There are 2 other files named dasite.for in the archive. Click here to see a list.
      SUBROUTINE DASITE(IRAPID,KOUNT ,LOWSUB,KNTSUB,NOWSUB,
     1    IEXTRA,LRGNUM,NUMUSD,NUMSTR,LSTKNT,NUMINI,INITAL,
     2    LOCATN)
C     RENBR(/GET BUFFER SUBSCRIPT FROM NAME + SUBSCRIPTS)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     DASITE  RETURNS  THE   POSITION   WITHIN   A   SINGLY
C     SUBSCRIPTED  BUFFER  OF  A  SINGLE ITEM OF A POSSIBLY
C     MULTIPLY  SUBSCRIPTED  ARRAY  EQUIVALENCED  WITH   OR
C     OTHERWISE  LOADED  INTO  PART  OR  ALL  OF THE SINGLY
C     SUBSCRIPTED  BUFFER  (AS  DEFINED  PERHAPS   BY   THE
C     DICTIONARY CONSTRUCTED BY THE DALOAD ROUTINE).  THERE
C     IS NO UPPER LIMIT TO THE NUMBER OF SUBSCRIPTS OF  THE
C     ARRAYS  SIMULATED  IN  THE  BUFFER  (OTHER  THAN  THE
C     OBVIOUS RESTRICTIONS IMPOSED BY THE  LENGTHS  OF  THE
C     NOWSUB  AND  NUMSTR  ARRAYS  AND BY THE LENGTH OF THE
C     BUFFER ITSELF).  THE RANGE OF VALUES OF ANY SUBSCRIPT
C     CAN  START  AT ANY VALUE AND CAN BE EITHER INCREASING
C     OR DECREASING.  THIS CONVERSION IS  THE  OPPOSITE  OF
C     THAT PERFORMED BY DANAME.
C
C     THE FOLLOWING ARGUMENTS ARE USED AS INPUT
C
C     IRAPID = 0, SELECTED ARRAY, IF MULTIPLY  SUBSCRIPTED,
C              HAS  LEFT  SUBSCRIPT  VARYING  MOST RAPIDLY.
C              THIS IS THE NORMAL  FORTRAN  CONVENTION  FOR
C              READS  OR  WRITES  IN WHICH NAME OF ARRAY IS
C              USED WITHOUT ANY SUBSCRIPTS.
C            = 1, SELECTED ARRAY, IF MULTIPLY  SUBSCRIPTED,
C              HAS RIGHT SUBSCRIPT VARYING MOST RAPIDLY.
C     KOUNT  = SEQUENCE NUMBER  OF THE DESIRED  ARRAY AMONG
C              ALL ARRAYS IN BUFFER.  1ST ARRAY IS SELECTED
C              BY KOUNT=1, 2ND BY KOUNT=2 AND SO ON.
C     LOWSUB = SUBSCRIPT OF NOWSUB ARRAY  CONTAINING  FIRST
C              SIMULATED   SUBSCRIPT   OF  THE  ITEM  BEING
C              LOCATED.
C     KNTSUB = SUBSCRIPT OF NOWSUB ARRAY  CONTAINING  FINAL
C              SIMULATED   SUBSCRIPT   OF  THE  ITEM  BEING
C              LOCATED.  IF THE LOWER PORTION OF THE NOWSUB
C              ARRAY  IS  USED,  THEN  LOWSUB WILL HAVE THE
C              VALUE 1 AND KNTSUB WILL  BE  THE  NUMBER  OF
C              SUBSCRIPTS OF THE SIMULATED ARRAY.
C     NOWSUB = ARRAY CONTAINING THE SIMULATED SUBSCRIPTS OF
C              THE   ITEM  BEING  LOCATED.   NOWSUB(LOWSUB)
C              THROUGH NOWSUB(KNTSUB) CONTAIN VALUES OF THE
C              SUBSCRIPTS  OF  THE  SIMULATED  ARRAY  WHICH
C              SELECT A PARTICULAR WORD  WITHIN  THE  TOTAL
C              BUFFER.
C     IEXTRA = 0, FOR  EACH  SIMULATED  ARRAY,  THE  NUMSTR
C              ARRAY CONTAINS ONLY THE NUMBER OF SUBSCRIPTS
C              AND THE SUBSCRIPT LIMITS.
C            = GREATER THAN ZERO,  NUMSTR(LRGNUM)  CONTAINS
C              FIRST OF  IEXTRA  WORDS WHICH  APPEAR BEFORE
C              THE FIRST SUBSCRIPT DESCRIPTION. THEREAFTER,
C              IEXTRA EXTRA WORDS ARE TO BE IGNORED BETWEEN
C              DESCRIPTIONS OF CONSECUTIVE SIMULATED ARRAYS
C            = -1, EACH  SUBSCRIPT DESCRIPTION  IS PRECEDED
C              BY A VARIABLE NUMBER OF WORDS TO BE IGNORED.
C              EACH  SECTION  TO BE  IGNORED STARTS  WITH A
C              WORD CONTAINING NUMBER OF WORDS EXCLUSIVE OF
C              ITSELF WHICH  ARE TO BE IGNORED  BEFORE NEXT
C              SUBSCRIPT  COUNT IS FOUND.    NUMSTR(LRGNUM)
C              CONTAINS NUMBER OF WORDS EXCLUSIVE OF ITSELF
C              TO BE  IGNORED  BEFORE THE  FIRST  SUBSCRIPT
C              DESCRIPTION.
C            = -2,  DICTIONARY  WAS  CONSTRUCTED  BY DALOAD
C              ROUTINE.   LRGNUM CAN POINT  TO EITHER START
C              OF THE  DESCRIPTION OF THE  LOGICAL GROUP OR
C              TO THE START OF THE DESCRIPTION OF THE FIRST
C              ARRAY IN THE LOGICAL GROUP.
C     LRGNUM = SUBSCRIPT OF THE NUMSTR ARRAY CONTAINING THE
C              START   OF  THE  DESCRIPTION  OF  THE  FIRST
C              SIMULATED ARRAY IN WHICH A  PARTICULAR  WORD
C              CAN BE LOCATED.
C     NUMUSD = SUBSCRIPT OF THE NUMSTR ARRAY CONTAINING THE
C              END   OF   THE   DESCRIPTION  OF  THE  FINAL
C              SIMULATED ARRAY IN WHICH A  PARTICULAR  WORD
C              CAN BE LOCATED.  IF ERRORS ARE NOT EXPECTED,
C              THEN NUMUSD CAN JUST BE THE DIMENSION OF THE
C              NUMSTR  ARRAY  REGARDLESS  OF WHETHER ALL OF
C              THE NUMSTR ARRAY IS USED.
C     NUMSTR = ARRAY DESCRIBING THE SUBSCRIPT LIMITS OF THE
C              ARRAYS  SIMULATED  IN THE SINGLY SUBSCRIPTED
C              BUFFER.  THE CONTENTS OF  THE  NUMSTR  ARRAY
C              ARE, FOR EACH ARRAY SIMULATED IN THE BUFFER,
C              THE NUMBER OF SUBSCRIPTS  OF  THE  SIMULATED
C              ARRAY  FOLLOWED  BY  LEFT AND RIGHT LIMITING
C              VALUES OF THESE SUBSCRIPTS (VALUES WHICH THE
C              SUBSCRIPTS   WOULD   HAVE   IF   THE  ARRAYS
C              SIMULATED  IN  THE  BUFFER   WERE   ACTUALLY
C              INCLUDED  IN  DIMENSION STATEMENTS).  IF THE
C              ITEM IN THE BUFFER WOULD BE  DIMENSIONED  AT
C              1, OR WOULD NOT DIMENSIONED, THEN A SINGLE 0
C              CAN BE USED IN PLACE OF THE SEQUENCE  1,1,1.
C              IT  SHOULD BE NOTED THAT THE RIGHT LIMIT CAN
C              BE EITHER GREATER THAN OR LESS THAN THE LEFT
C              LIMIT.
C
C     FOLLOWING ARGUMENTS ARE USED AS BOTH INPUT AND OUTPUT
C
C     LSTKNT = SHOULD BE SET TO ZERO BY THE CALLING PROGRAM
C              BEFORE DASITE  IS FIRST CALLED  AND WHENEVER
C              THE DICTIONARY  CORRESPONDING  TO THE BUFFER
C              CHANGES.
C            = RETURNED CONTAINING INPUT VALUE OF KOUNT.
C     NUMINI = INPUT VALUE IS IGNORED  IF LSTKNT IS ZERO OR
C              IF LSTKNT IS GREATER THAN KOUNT.   NUMINI IS
C              SET BY EACH CALL TO  DASITE AND SHOULD NEVER
C              BE SET BY THE CALLING PROGRAM.
C            = INPUT VALUE IS LOCATION IN NUMSTR ARRAY  (AS
C              SUBSCRIPT  OF THE NUMSTR ARRAY) OF THE START
C              OF THE DESCRIPTION OF  THE  SELECTED  ARRAY.
C              IF IEXTRA=0,  THEN  NUMSTR(NUMINI)  CONTAINS
C              SUBSCRIPT COUNT AT START OF THE DESCRIPTION.
C            = RETURNED CONTAINING LOCATION IN NUMSTR ARRAY
C              OF  THE  START  OF  DESCRIPTION  OF SELECTED
C              ARRAY.
C     INITAL = INPUT VALUE IS IGNORED  IF LSTKNT IS ZERO OR
C              IF LSTKNT IS GREATER THAN KOUNT.   INITAL IS
C              SET BY EACH CALL TO  DASITE AND SHOULD NEVER
C              BE SET BY THE CALLING PROGRAM.
C            = INPUT VALUE IS LOCATION IN  BUFFER  (AS  THE
C              WORD  COUNT  WITHIN  BUFFER) OF THE START OF
C              SELECTED ARRAY.
C            = RETURNED CONTAINING LOCATION  IN  BUFFER  OF
C              START OF SELECTED ARRAY.
C
C     THE FOLLOWING ARGUMENT IS RETURNED AS OUTPUT
C
C     LOCATN = IF RETURNED GREATER THAN ZERO, LOCATN IS THE
C              POSITION   OF   THE  SELECTED  WORD  OF  THE
C              SELECTED ARRAY FROM THE START OF THE BUFFER.
C            = 0 RETURNED IF  SUBSCRIPTS  ARE  NOT  IN  THE
C              RANGE PREDICTED BY NUMSTR ARRAY.
C            = -1  RETURNED  IF   NOWSUB   ARRAY   CONTAINS
C              DIFFERENT  NUMBER  OF SUBSCRIPTS THAN NUMSTR
C              ARRAY.
C            = -2 RETURNED IF SEQUENCE NUMBER INDICATED  BY
C              KOUNT IS NOT IN THE NUMSTR ARRAY.
C
C     FOR EXAMPLE, IF BUFFER CONTAINS VALUES OF  ARRAYS  A,
C     B, E DIMENSIONED A(1/3,1/5), B(1/5,1/6), E(1/10,1/10)
C     (THIS SPECIFICATION MEANS THAT THE LEFT SUBSCRIPT  OF
C     ARRAY  A  CAN  RANGE  FROM  1  THROUGH 3 AND THAT THE
C     SECOND SUBSCRIPT CAN RANGE  FROM  1  THROUGH  5)  AND
C     CONTAINS NONDIMENSIONED ITEMS C AND D IN ORDER
C
C              A,B,C,D,E
C
C     THEN THE CONTENTS OF THE NUMSTR ARRAY WOULD BE
C
C              2,1,3,1,5,2,1,5,1,6,0,0,2,1,10,1,10
C
C     OR
C
C              2,1,3,1,5,2,1,5,1,6,1,1,1,1,1,1,2,1,10,1,10
C
C     IF KOUNT  HAS THE VALUE 2 AND  IF  THE  NOWSUB  ARRAY
C     CONTAINS  THE  VALUES 4 AND 3 SELECTING B(4,3) AND IF
C     IRAPID HAD VALUE 0, SO THAT ALL OF  ARRAY  A,  B(1,1)
C     THROUGH  B(5,1),  B(1,2)  THROUGH  B(5,2), AND B(1,3)
C     THROUGH B(3,3) WOULD  BE  BELOW  B(4,3)  THEN  LOCATN
C     WOULD BE RETURNED AS 15+5+5+3+1=29
C
C     IF IRAPID=0, ORDER OF A ARRAY IN BUFFER WOULD BE
C     (READING ACROSS EACH LINE FROM LEFT TO RIGHT)
C     A(1,1),A(2,1),A(3,1),A(1,2),A(2,2),A(3,2),
C     A(1,3),A(2,3),A(3,3),A(1,4),A(2,4),A(3,4),
C     A(1,5),A(2,5),A(3,5)
C
C     IF IRAPID=1, ORDER OF A ARRAY IN BUFFER WOULD BE
C     A(1,1),A(1,2),A(1,3),A(1,4),A(1,5)
C     A(2,1),A(2,2),A(2,3),A(2,4),A(2,5)
C     A(3,1),A(3,2),A(3,3),A(3,4),A(3,5)
C
C     IF Z ARRAY IS EFFECTIVELY DIMENSIONED Z(4/3,-1/1)
C     THEN ITS REPRESENTATION IN NUMSTR ARRAY WOULD BE
C              2,4,3,-1,1
C     AND IF IRAPID=0, ITS ORDER IN BUFFER WOULD BE
C     Z(4,-1),Z(3,-1),Z(4,0),Z(3,0),Z(4,1),Z(3,1)
C     IF INSTEAD IRAPID=1, ITS ORDER IN BUFFER WOULD BE
C     Z(4,-1),Z(4,0),Z(4,1),Z(3,-1),Z(3,0),Z(3,1)
C
      DIMENSION NOWSUB(KNTSUB),NUMSTR(NUMUSD)
C
C     FIND NUMBER OF WORDS BELOW SELECTED ARRAY
      IFORMT=IEXTRA+1
      JEXTRA=2
      IF(IFORMT.GT.0)JEXTRA=IEXTRA
      IF(LSTKNT.LE.0)GO TO 1
      IF(KOUNT.GE.LSTKNT)GO TO 2
    1 LSTKNT=1
      INITAL=1
      NUMINI=LRGNUM
      IF(IFORMT.GE.0)GO TO 2
      IF(NUMINI.GT.NUMUSD)GO TO 13
      IF(NUMSTR(NUMINI).GT.0)GO TO 2
      IF(NUMSTR(NUMINI+2).LT.0)GO TO 13
      NUMINI=NUMINI+3+(2*NUMSTR(NUMINI+2))
    2 IF(NUMINI.GT.NUMUSD)GO TO 13
      IF(IFORMT.GT.0)GO TO 4
      IF(IFORMT.EQ.0)GO TO 3
      IF(NUMSTR(NUMINI).GT.0)GO TO 4
      GO TO 13
    3 JEXTRA=NUMSTR(NUMINI)+1
      IF(JEXTRA.LE.0)GO TO 13
    4 NEXT=NUMINI+JEXTRA
      KNTLMT=NUMSTR(NEXT)
      IF(KOUNT.LE.LSTKNT)GO TO 7
      NUMINI=NEXT+1
      NEXT=NEXT+KNTLMT+KNTLMT
      LOCAL=1
    5 IF(NUMINI.GE.NEXT)GO TO 6
      ISIZE=NUMSTR(NUMINI+1)-NUMSTR(NUMINI)+1
      IF(ISIZE.LE.0)ISIZE=2-ISIZE
      LOCAL=LOCAL*ISIZE
      NUMINI=NUMINI+2
      GO TO 5
    6 INITAL=INITAL+LOCAL
      LSTKNT=LSTKNT+1
      GO TO 2
C
C     FIND LOCATION WITHIN SELECTED ARRAY
    7 LOCAL=0
      IF(KNTLMT.GT.0)GO TO 8
      IF(KNTSUB.LT.LOWSUB)GO TO 16
      IF(KNTSUB.NE.LOWSUB)GO TO 14
      IF(NOWSUB(LOWSUB).NE.1)GO TO 15
      GO TO 16
    8 IF((KNTSUB-LOWSUB).NE.(KNTLMT-1))GO TO 14
      IF(IRAPID.GT.0)GO TO 9
      INDEX=KNTLMT+LOWSUB-1
      LMTPNT=NEXT+KNTLMT+KNTLMT
      GO TO 10
    9 INDEX=LOWSUB
      LMTPNT=NEXT+2
   10 ILOWER=NOWSUB(INDEX)-NUMSTR(LMTPNT-1)
      ISIZE=NUMSTR(LMTPNT)-NUMSTR(LMTPNT-1)+1
      IF(ISIZE.GT.0)GO TO 11
      ILOWER=-ILOWER
      ISIZE=2-ISIZE
   11 IF(ILOWER.LT.0)GO TO 15
      IF(ILOWER.GE.ISIZE)GO TO 15
      LOCAL=(LOCAL*ISIZE)+ILOWER
      KNTLMT=KNTLMT-1
      IF(KNTLMT.LE.0)GO TO 16
      IF(IRAPID.GT.0)GO TO 12
      INDEX=INDEX-1
      LMTPNT=LMTPNT-2
      GO TO 10
   12 INDEX=INDEX+1
      LMTPNT=LMTPNT+2
      GO TO 10
C
C     ARRAY SEQUENCE NUMBER TOO LARGE
   13 LOCATN=-2
      GO TO 17
C
C     INCORRECT NUMBER OF SUBSCRIPTS
   14 LOCATN=-1
      GO TO 17
C
C     SUBSCRIPT OUTSIDE INDICATED LIMIT
   15 LOCATN=0
      GO TO 17
C
C     ADD OFFSET TO START OF AND OFFSET WITHIN ARRAY
   16 LOCATN=INITAL+LOCAL
   17 RETURN
C575207010056
      END