Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0141/daloop.for
There are 2 other files named daloop.for in the archive. Click here to see a list.
SUBROUTINE DALOOP(IRAPID,LOWSUB,KNTSUB,INISUB,LMTSUB,
1 INCSUB,NXTSUB,INLOOP,NOWSUB)
C RENBR(/VARIABLY EMBEDDED DO LOOP SIMULATOR)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C ROUTINE TO PROVIDE CONTROL OF VARIABLY EMBEDDED
C LOOPS TO ANY DESIRED LEVEL. EACH LOOP HAS ITS OWN
C INITIAL AND FINAL VALUE, AND ITS OWN INCREMENT BY
C WHICH IT VARIES BETWEEN THESE. THE FINAL VALUE CAN
C BE EITHER LESS THAN, EQUAL TO OR GREATER THAN THE
C INITIAL VALUE.
C
C ***************************************************
C * CAUTION, DALOOP MUST BE CALLED INITIALLY TO *
C * DEFINE LOOP STRUCTURE, THEN AT EACH LOOP END. *
C * NONE OF THE CALLING ARGUMENTS CAN BE CHANGED *
C * BY CALLING PROGRAM UNTIL ALL LOOPS ARE DONE. *
C ***************************************************
C
C THE FOLLOWING ARGUMENTS ARE USED AS INPUT ONLY
C
C IRAPID = 0, THE INNERMOST LOOP (ONE DONE THE MOST
C RAPIDLY) IS THAT WITH THE SMALLEST VALUE
C IN THE NXTSUB ARRAY.
C = 1, THE INNERMOST LOOP IS THAT WITH THE
C LARGEST VALUE IN THE NXTSUB ARRAY.
C LOWSUB = THE INITIAL SUBSCRIPT OF THE ARRAYS WHICH
C ARE TO BE USED AS THE LOOP DESCRIPTORS.
C KNTSUB = THE FINAL SUBSCRIPT OF THE ARRAYS WHICH
C ARE TO BE USED AS THE LOOP DESCRIPTORS.
C KNTSUB MUST BE GREATER THAN OR EQUAL TO
C LOWSUB.
C INISUB = ARRAY CONTAINING THE STARTING VALUES OF THE
C INDIVIDUAL LOOP LIMITS.
C LMTSUB = ARRAY CONTAINING ENDING VALUES OF THE
C INDIVIDUAL LOOP LIMITS. AN INDIVIDUAL ITEM
C IN THE LMTSUB ARRAY CAN BE EITHER LESS THAN,
C EQUAL TO, OR GREATER THAN THE CORRESPONDING
C ITEM IN THE INISUB ARRAY.
C INCSUB = ARRAY CONTAINING THE INCREMENT BY WHICH THE
C NOWSUB ARRAY IS VARIED BETWEEN THE STARTING
C VALUES IN INISUB ARRAY, AND THE ENDING
C VALUES IN LMTSUB ARRAY. IF THE INCREMENT
C IS ZERO, IT IS CHANGED TO 1. IF THE
C INCREMENT HAS THE WRONG SIGN, ITS SIGN IS
C CHANGED.
C
C THE FOLLOWING ARGUMENT IS USED AS INPUT, THEN IS
C RETURNED CHANGED FOR USE BY SUBSEQUENT DALOOP CALLS
C
C NXTSUB = ARRAY SET BY THE CALLING PROGRAM BEFORE THE
C INITIAL CALL TO DALOOP TO CONTROL THE ORDER
C OF THE EMBEDDED LOOPS. DALOOP WILL RETURN
C NXTSUB AS AN ARRAY CONTAINING POINTERS FOR
C USE BY SUBSEQUENT CALLS TO DALOOP. THE
C ORIGINAL CONTENTS OF NXTSUB ARE USED TO
C ESTABLISH THE ORDER OF THE POINTERS, BUT
C THE ORIGINAL CONTENTS ARE DESTROYED AFTER
C BEING USED. THE RETURNED VALUES MUST NOT BE
C ALTERED BY CALLING PROGRAM. SEE DEFINITION
C OF IRAPID FOR DESCRIPTION OF INPUT NXTSUB
C VALUES. LOOPS WHICH HAVE IDENTICAL VALUES
C OF NXTSUB ARE PERFORMED AS A SINGLE UNIT, A
C SINGLE CALL TO DALOOP ADVANCING THE NOWSUB
C ARRAY VALUES FOR ALL MEMEBERS OF THE GROUP
C UNTIL NOWSUB ARRAY VALUE OF ANY MEMBER OF
C THE GROUP EXCEEDS ITS OWN CORRESPONDING
C LMTSUB ARRAY VALUE. WHEN DALOOP FINALLY
C SIGNALS THAT ALL LOOPS HAVE BEEN COMPLETED,
C BY RETURNING INLOOP=0, IT WILL ALSO ATTEMPT
C TO RESTORE THE ORIGINAL VALUES OF THE NXTSUB
C ARRAY, MAKING THE ASSUMPTION THAT SMALLEST
C VALUE IN RANGE NXTSUB(LOWSUB) THROUGH
C NXTSUB(KNTSUB) HAS THE VALUE LOWSUB, AND
C THAT THE VALUES ARE THEN INCREMENTED BY 1.
C THE RELATIVE ORDER WITHIN THE USED PORTION
C OF NXTSUB ARRAY WILL BE RETURNED CORRECT,
C BUT IF THE ASSUMPTIONS ARE NOT CORRECT, THE
C ORDER WILL BE INCORRECT RELATIVE TO THAT OF
C THE UNUSED PORTION, IF ANY, OF NXTSUB ARRAY.
C
C THE FOLLOWING ARGUMENT IS USED AS INPUT, THEN IS
C RETURNED CHANGED FOR USE BY BOTH THE CALLING PROGRAM
C AND BY SUBSEQUENT CALLS TO DALOOP
C
C INLOOP = MUST BE SET TO ZERO BEFORE INITIAL CALL TO
C DALOOP. THIS INITIAL CALL WILL SET INLOOP
C NONZERO, AND WILL COPY THE INISUB ARRAY
C INTO THE NOWSUB ARRAY FOR USE AS THE LOOP
C PARAMETERS. EACH SUBSEQUENT CALL TO DALOOP
C WILL EITHER LOAD THE PARAMETERS FOR THE
C NEXT SET OF LOOPS INTO THE NOWSUB ARRAY OR
C SET INLOOP TO ZERO IF THE LOOP STRUCTURE
C HAS BEEN COMPLETED.
C
C THE FOLLOWING ARGUMENT IS RETURNED CHANGED FOR USE
C BY BOTH THE CALLING PROGRAM AND SUBSEQUENT CALLS TO
C DALOOP. THE ORIGINAL CONTENTS ARE IGNORED.
C
C NOWSUB = ARRAY RETURNED CONTAINING THE LOOP CONTROL
C PARAMETERS FOR THE NEXT LOOP STRUCTURE.
C THE CONTENTS OF NOWSUB(LOWSUB) THROUGH
C NOWSUB(KNTSUB) ARE USED IN THE SAME MANNER
C AS THE INDEXES OF FORTRAN DO LOOPS.
C THE VALUES UPON INPUT TO THE INITIAL CALL
C TO DALOOP ARE IGNORED.
C
C AS AN EXAMPLE, WITH LOWSUB=5, KNTSUB=8, IRAPID=1 AND
C (NXTSUB(I),I=5,8)=1,2,3,4
C THE STATEMENTS
C
C INLOOP=0
C 1 CALL DALOOP(IRAPID,LOWSUB,KNTSUB,INISUB,LMTSUB,
C 1INCSUB,NXTSUB,INLOOP,NOWSUB)
C IF(INLOOP.EQ.0)GO TO 2
C *
C *
C TEXT TO BE EXECUTED WITHIN THE LOOP STRUCTURE
C *
C *
C GO TO 1
C 2 CONTINUE
C
C WOULD SIMULATE THE CORRESPONDING DO LOOP STRUCTURE
C
C DO 2 NOWSUB(5)=INISUB(5),LMTSUB(5),INCSUB(5)
C DO 2 NOWSUB(6)=INISUB(6),LMTSUB(6),INCSUB(6)
C DO 2 NOWSUB(7)=INISUB(7),LMTSUB(7),INCSUB(7)
C DO 2 NOWSUB(8)=INISUB(8),LMTSUB(8),INCSUB(8)
C *
C *
C TEXT TO BE EXECUTED WITHIN THE LOOP STRUCTURE
C *
C *
C 2 CONTINUE
C
C HOWEVER, MERELY BY CHANGING THE NXTSUB ARRAY TO
C (NXTSUB(I),I=5,8)=3,1,4,2
C THE ORDER OF THE SIMULATED DO LOOPS WOULD BECOME
C
C DO 2 NOWSUB(6)=INISUB(6),LMTSUB(6),INCSUB(6)
C DO 2 NOWSUB(8)=INISUB(8),LMTSUB(8),INCSUB(8)
C DO 2 NOWSUB(5)=INISUB(5),LMTSUB(5),INCSUB(5)
C DO 2 NOWSUB(7)=INISUB(7),LMTSUB(7),INCSUB(7)
C *
C *
C TEXT TO BE EXECUTED WITHIN THE LOOP STRUCTURE
C *
C *
C 2 CONTINUE
C
C THE FIRST CALL TO DALOOP CONVERTS THE NXTSUB ARRAY
C FROM AN ORDER ARRAY TO A POINTER ARRAY SO AS TO
C PREVENT UNNECESSARY SEARCHES BY SUCCEEDING CALLS.
C THE FIRST LOCATION IN THE USED PORTION OF THE NXTSUB
C ARRAY AFTER ITS CONVERSION TO A POINTER ARRAY
C CONTAINS THE SUBSCRIPT OF THE INDEX WHICH IS BEING
C VARIED THE MOST RAPIDLY. IF ADDITIONAL INDEXES ARE
C BEING VARIED AT THE SAME RATE, THEN THE SECOND
C LOCATION IN THE POINTER ARRAY WILL CONTAIN THE SUM OF
C THE SUBSCRIPT OF THE INDEX BEING VARIED AT THE SAME
C RATE AND THE TOTAL NUMBER OF INDEXES SO THAT THE SUM
C IS GREATER THAN THE MAXIMUM POSSIBLE SUBSCRIPT.
C SCANNING FROM LEFT TO RIGHT, THE NEXT LOCATION IN THE
C POINTER ARRAY WHICH CONTAINS A VALUE LESS THAN OR
C EQUAL TO THE MAXIMUM SUBSCRIPT OF AN INDEX WILL POINT
C TO THE INDEX BEING VARIED THE NEXT MOST RAPIDLY. FOR
C EXAMPLE, IF THE INITIAL CONTENTS OF THE NXTSUB ARRAY
C IS
C
C 1, 2, 3, 2, 3, 4, 3, 4, 5
C
C MEANING (IF SMALLEST NUMBER INDICATES INNERMOST LOOP)
C THAT THE FIRST INDEX IS VARIED MOST RAPIDLY, THE
C SECOND AND FOURTH ARE VARIED NEXT MOST RAPIDLY, AND
C SO ON THROUGH THE NINTH WHICH IS VARIED THE LEAST
C RAPIDLY, THEN, AFTER CONVERSION TO A POINTER ARRAY,
C THE CONTENTS OF THE NXTSUB ARRAY ARE
C
C 1, 2, (4+9)=13, 3, (5+9)=14, (7+9)=16, 6, (8+9)=17, 9
C
DIMENSION NOWSUB(KNTSUB),NXTSUB(KNTSUB),
1INISUB(KNTSUB),LMTSUB(KNTSUB),INCSUB(KNTSUB)
IF(INLOOP.GT.0)GO TO 11
C
C CHANGE ORDER ARRAY INTO A POINTER ARRAY
INLOOP=KNTSUB-LOWSUB+1
IF(INLOOP.LE.0)GO TO 24
DO 1 I=LOWSUB,KNTSUB
1 NOWSUB(I)=I
I=LOWSUB
L=LOWSUB
2 IF(I.GT.KNTSUB)GO TO 25
N=NXTSUB(I)
M=I
IF(I.EQ.KNTSUB)GO TO 6
L=L+1
DO 5 K=L,KNTSUB
IF(IRAPID.LE.0)GO TO 3
IF(NXTSUB(K).LE.N)GO TO 5
GO TO 4
3 IF(NXTSUB(K).GE.N)GO TO 5
4 M=K
N=NXTSUB(K)
5 CONTINUE
NXTSUB(M)=NXTSUB(I)
6 J=NOWSUB(M)
NOWSUB(M)=NOWSUB(I)
IF(I.EQ.LOWSUB)GO TO 7
IF(LAST.EQ.N)J=J+INLOOP
7 NXTSUB(I)=J
LAST=N
NOWSUB(I)=INISUB(I)
IF(INCSUB(I).EQ.0)INCSUB(I)=1
IF(INISUB(I).GT.LMTSUB(I))GO TO 8
IF(INCSUB(I).GE.0)GO TO 10
GO TO 9
8 IF(INCSUB(I).LE.0)GO TO 10
9 INCSUB(I)=-INCSUB(I)
10 I=I+1
GO TO 2
C
C IF ALREADY INITIALIZED, FIND NEXT VALUES
11 I=LOWSUB
12 J=I
K=NXTSUB(J)
13 NOWSUB(K)=NOWSUB(K)+INCSUB(K)
IF(INISUB(K).GT.LMTSUB(K))GO TO 14
IF(NOWSUB(K).GT.LMTSUB(K))GO TO 16
GO TO 15
14 IF(NOWSUB(K).LT.LMTSUB(K))GO TO 16
15 J=J+1
IF(J.GT.KNTSUB)GO TO 25
K=NXTSUB(J)
IF(K.LE.KNTSUB)GO TO 25
K=K-INLOOP
GO TO 13
16 J=NXTSUB(I)
17 NOWSUB(J)=INISUB(J)
I=I+1
IF(I.GT.KNTSUB)GO TO 18
IF(NXTSUB(I).LE.KNTSUB)GO TO 12
J=NXTSUB(I)-INLOOP
GO TO 17
C
C ALL DONE WITH LOOPS, TRY TO RESTORE NXTSUB ARRAY
18 I=LOWSUB
K=-1
GO TO 21
19 K=K+1
20 NOWSUB(J)=K
I=I+1
21 IF(I.GT.KNTSUB)GO TO 22
J=NXTSUB(I)
IF(J.LE.KNTSUB)GO TO 19
J=J-INLOOP
GO TO 20
22 DO 23 I=LOWSUB,KNTSUB
IF(IRAPID.GT.0)NOWSUB(I)=K-NOWSUB(I)
23 NXTSUB(I)=LOWSUB+NOWSUB(I)
C
C ALL DONE
24 INLOOP=0
25 RETURN
C485603982534
END