Trailing-Edge
-
PDP-10 Archives
-
decuslib20-05
-
decus/20-0141/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