Google
 

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