Google
 

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