Trailing-Edge
-
PDP-10 Archives
-
decuslib10-08
-
43,50476/daroll.for
There are 2 other files named daroll.for in the archive. Click here to see a list.
SUBROUTINE DAROLL(IRAPID,LOWSUB,KNTSUB,INISUB,LMTSUB,
1 INCSUB,INLOOP,NOWSUB)
C RENBR(/OBTAIN NEXT LOOP DESCRIPTION)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C ROUTINE TO VARY A SET OF LOOP CONTROL PARAMETERS
C BETWEEN A SET OF LOWER AND UPPER BOUNDS.
C
C ***************************************************
C * CAUTION, DAROLL 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
C SUBSCRIPT.
C = 1, THE INNERMOST LOOP IS THAT WITH THE
C LARGEST SUBSCRIPT.
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 BOTH THE CALLING PROGRAM
C AND BY SUBSEQUENT CALLS TO DAROLL
C
C INLOOP = MUST BE SET TO ZERO BEFORE INITIAL CALL TO
C DAROLL. 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 DAROLL
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 DAROLL. 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 DAROLL ARE IGNORED.
C
DIMENSION NOWSUB(KNTSUB),INISUB(KNTSUB),
1LMTSUB(KNTSUB),INCSUB(KNTSUB)
IF(INLOOP.GT.0)GO TO 5
C
C OBTAIN STARTING VALUES
IF(LOWSUB.GT.KNTSUB)GO TO 14
INLOOP=1
INDEX=LOWSUB
1 IF(INDEX.GT.KNTSUB)GO TO 15
NOWSUB(INDEX)=INISUB(INDEX)
IF(INCSUB(INDEX).EQ.0)INCSUB(INDEX)=1
IF(INISUB(INDEX).GT.LMTSUB(INDEX))GO TO 2
IF(INCSUB(INDEX).GE.0)GO TO 4
GO TO 3
2 IF(INCSUB(INDEX).LE.0)GO TO 4
3 INCSUB(INDEX)=-INCSUB(INDEX)
4 INDEX=INDEX+1
GO TO 1
C
C IF ALREADY INITIALIZED, FIND NEXT VALUES
5 IF(IRAPID.LE.0)GO TO 6
INDEX=KNTSUB
GO TO 8
6 INDEX=LOWSUB
GO TO 10
7 IF(IRAPID.LE.0)GO TO 9
INDEX=INDEX-1
8 IF(INDEX.LT.LOWSUB)GO TO 14
GO TO 11
9 INDEX=INDEX+1
10 IF(INDEX.GT.KNTSUB)GO TO 14
11 NOWSUB(INDEX)=NOWSUB(INDEX)+INCSUB(INDEX)
IF(INISUB(INDEX).GT.LMTSUB(INDEX))GO TO 12
IF(NOWSUB(INDEX).LE.LMTSUB(INDEX))GO TO 15
GO TO 13
12 IF(NOWSUB(INDEX).GE.LMTSUB(INDEX))GO TO 15
13 NOWSUB(INDEX)=INISUB(INDEX)
GO TO 7
C
C ALL DONE
14 INLOOP=0
15 RETURN
C340913287832
END