C **********************************************************************
C
C
C                    (R-INFINITY, N-HALF)  BENCHMARK
C
C
C PROGRAMMED BY ROGER HOCKNEY, MARCH 1985
C **********************************************************************
C
C
C     OPERATING INSTUCTIONS :
C
C          (1) INSERT LOCAL TIMER INTO LAST TWO SUBROUTINES
C
C                  SATIME - INITIALIZE TIMER, DUMMY IF NOT REQUIRED
C
C                  SACOND(T) - DELIVERS CPU TIME FOR THIS JOB IN T AT
C                            TIME OF CALL. USE MOST ACCURATE TIMER,
C                            PREFERABLY TICKING EVERY CPU CLOCK PERIOD
C
C             THE PROGRAM INCLUDES A CALL TO TODCLK WHICH IS AN
C             IBM 370 CPU TIMER. THE OBJECT CODE IS IN FILE TODCLK TEXT,
C             AND MAY BE USED IN YOUR CMS EXEC BY :  LOAD TODCLK TEXT
C
C          (2) SET PARAMETERS AT START OF MAIN PROGRAM :
C
C                  NTIMES - REPEAT NUMBER TO IMPROVE TIMING ACCURACY
C                         = 1.0E8*(CLOCK TICK)*(MFLOP/S)
C                         = 1000   IF TICK IS 1.0E-5 SEC
C                         = 100000 IF TICK IS 1.0E-3 SEC
C
C                  IOUT   - OUTPUT CHANNEL LOGICAL NUMBER FOR RESULTS
C
C                  NCASE  - NUMBER OF CASES (DEFAULT=13)
C
C                  NMAX   - MAXIMUM VECTOR LENGTH (DEFAULT=10000)
C
C          (3) ADD ANY NEW CASES YOU WANT AT END OF SUBROUTINE DOALL,
C              FOLLOWING THE PATTERN THEREIN.  THEN INCREASE NCASE
C              AT HEAD OF MAIN PROGRAM
C
C
C     OUTPUT :
C
C           PAGE  1  -  MEASUREMENT OF CLOCK TICK
C
C           PAGES 2 TO 13
C                    -  MEASUREMENT OF R-INFINITY AND N-HALF
C                       FOR CASES 1 TO 13
C                       VALUES AND ERRORS ARE UPDATED AS EACH NEW VECTOR
C                       LENGTH IS COMPUTED
C
C           PAGE 14  -  SUMMARY OF LAST VALUES AND WORST ERRORS
C
C           PAGE 15  -  TOTAL EXECUTION TIME FOR JOB
C
C
C      FILES :
C
C            THERE ARE FOUR FILES THAT MAY BE OF ASSISTANCE IN
C            RUNNING THIS BENCHMARK
C
C      RINF  FORTRAN  -  THE FORTRAN SOURCE OF THE BENCHMARK
C                        CONTAINING :
C
C                           MAIN PROGRAM
C                           SUBROUTINE LSTSQ - LEAST SQUARES FIT
C                           SUBROUTINE DOALL - VECTORIZABLE LOOPS
C                                              FOR THE 13 CASES
C                           SUBROUTINE SATIME - INITIALIZE TIMER
C                           SUBROUTINE SACOND - CPU TIME IN SECONDS
C
C                       NEEDED BY  RINF EXEC
C
C      TODCLK  TEXT   -  OBJECT DECK FOR 370 CPU TIMER WITH A TICK
C                        OF ABOUT 1.0E-05 SECONDS.
C                        THIS IS 1000 TIMES MORE ACCURATE THAN THE
C                        INTERVAL TIMER THAT IS USUALLY PROVIDED
C                        BY IBM INSTALLATION LIBRARIES.
C                        USED BY  FCLG EXEC
C
C      TODCLK ASSEMBLE-  ASSEMBLER SOURCE OF CPU TIMER, FOR THE CURIOUS
C                        AND SCEPTICAL
C
C      RINF  EXEC     -  IBM CMS EXEC USED ON THE AMDAHL V7A AT
C                        READING UNIVERSITY.
C
C                        THE CALL IS :
C
C                                  RINF RINF 3
C
C                        WHERE 3 IS THE OPTIMIZATION LEVEL, AND MAY
C                        BE REPLACED BY OTHER INTEGER VALUES
C
C
C                                GOOD LUCK
C
C                              ROGER HOCKNEY
C
C PLEASE RETURN THE RESULTS TO ME AT :
C
C  COMPUTER SCIENCE DEPT., READING UNIVERSITY, PO BOX 220, WHITEKNIGHTS,
C  READING RG6 2AX, U.K.
C
C THANK YOU
C
C
C
C ----------------------------------------------------------------------
C
C START MAIN PROGRAM
C
        COMMON // A(10000),B(10000),C(10000),D(10000),E(10000),F(10000)
     1          ,IA(10000),IB(10000)
        DIMENSION MATA(100,100),MATB(100,100),MATC(100,100)
        COMMON /PARM/ IOUT,NMAX,T0,NTIMES,NTIM,TOTIM
        COMMON /RESULT/ RLAST(50),XNLAST(50),PCTMIN(50),PCTMAX(50)
        COMMON /CHARS/ LABEL(50)
        CHARACTER*80 LABEL
        DIMENSION TK(10),DT(10)
        DIMENSION ITCLK(8)
C
C $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C
C                        SET  PARAMETERS  HERE
C                        ---------------------
C
        NTIMES=1000
        IOUT=6
        NCASE=13
        NMAX=10000
C
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
C
C   INITIALIZE TIMER
        CALL SATIME
        CALL SACOND(T10)
C
C  MEASURE CLOCK TICK
        WRITE(IOUT,4)
 4      FORMAT(1H1,//,5X,'MEASURE CLOCK TICK',/,
     1                5X,'------------------',//,
     2 2X,'TIME CHANGES BETWEEN SUCCESSIVE SAMPLES OF TIME BY SUBROUTINE
     3 SACOND',/)
C
        TICK= 1.0E6
        CALL SACOND(TK(1))
       DO 1 I=1,10000
        CALL SACOND(TK(2))
        CALL SACOND(TK(3))
        CALL SACOND(TK(4))
        CALL SACOND(TK(5))
        CALL SACOND(TK(6))
        CALL SACOND(TK(7))
C
       DO 6 J=2,7
        DT(J)=TK(J)-TK(J-1)
        IF(DT(J) .NE. 0) TICK=MIN(TICK,DT(J))
 6     CONTINUE
C
       TK(1)=TK(7)
C
       IF(I .LE. 50) WRITE(IOUT,3) (DT(J),J=2,7)
 3      FORMAT(2X,'TIME CHANGE=',1P6E15.6)
 1     CONTINUE
C
       WRITE(IOUT,2) TICK
 2     FORMAT(//,4X,'CLOCK TICK .LE. ',1PE15.6,' SECS')
C
C INITIALIZE ARRAYS :
        DO 30 I=1,NMAX
         A(I)=5.842*I
         B(I)=3.9675*I*I
         C(I)=4.5693/FLOAT(I)
         D(I)=9.8124*SQRT(FLOAT(I))
         E(I)=-48.15*I*I
         F(I)=-1.0067*SIN(FLOAT(I))
         I1=B(I)
C     NON REPEATING INDICES
         IB(I)=MOD(I1,NMAX)+1
C     REPEATING INDICES
         IA(I)=(MOD(IB(I),60)*NMAX)/60+1
  30    CONTINUE
C
        DO 200 ICASE=1,NCASE
C
C  INITIALIZE LABELS
          CALL DOALL(ICASE,0,TN)
C
C
        WRITE(IOUT,667) LABEL(ICASE),ICASE,NCASE,NMAX,NTIMES
 667    FORMAT(1H1,//,3X,A80,//,3X,'ICASE=',I4,3X,'NCASE=',I4,3X,
     1         'NMAX=',I6,3X,'NTIMES=',I10)
C
C INITIALIZE LEAST SQUARES
           CALL LSTSQ(0,N,TN,RINF,XN12,PERMIN,PERMAX)
C
        DO 20 NSEL=1,37
C
C SELECT VECTOR LENGTH
          IF (NSEL .LE. 10) N=NSEL
          IF (NSEL .GT. 10 .AND. NSEL .LE. 19) N=10*(NSEL-9)
          IF (NSEL .GT. 19 .AND. NSEL .LE. 28) N=100*(NSEL-18)
          IF (NSEL .GT.28) N=1000*(NSEL-27)
C
          IF (N .GT. NMAX) N=NMAX
C
C  TIME VECTOR OPERATION
C
           CALL DOALL(ICASE,N,TN)
C
C  ESCAPE IF VECTOR TOO LONG
         IF (N .EQ.0) GOTO 20
C
C  UPDATE LEAST SQUARES
          CALL LSTSQ(1,N,TN,RINF,XN12,PERMIN,PERMAX)
C
 20      CONTINUE
C
C   SAVE LAST VALUES
C
        RLAST(ICASE)=RINF
        XNLAST(ICASE)=XN12
        PCTMIN(ICASE)=PERMIN
        PCTMAX(ICASE)=PERMAX
C
 200     CONTINUE
C
C
C  PRINT LAST VALUES
C
        WRITE(IOUT,301)
 301    FORMAT(1H1,/,/,74X,'SUMMARY OF LAST VALUES',/,
     1                 74X,'----------------------',//,
     2                 20X,'CASE',28X,'R-INFINITY',10X,'N-HALF',
     3                 11X,'PERCENTAGE FIT: 100*RMSERR/VALUE',/,
     4                 54X,'MFLOP/S',12X,'FLOP',15X,'3-POINT',13X,'MAX')
C
        DO 300 ICASE=1,NCASE
 300    WRITE(IOUT,310) LABEL(ICASE),RLAST(ICASE),XNLAST(ICASE)
     1                 ,PCTMIN(ICASE),PCTMAX(ICASE)
 310    FORMAT(4X,A80,/,50X,F10.3,9X,F10.3,9X,F10.3,9X,F10.3,/)
C
        CALL SACOND(T11)
C
        TOTIME=T11-T10
        WRITE(IOUT,25) TOTIME
 25   FORMAT(1H1,//,5X,'TOTAL EXECUTION TIME IS ',1PE20.10,' SECONDS.')
         STOP
         END
C
C
C **********************************************************************
C
        SUBROUTINE LSTSQ(K,N,TN,RINF,XN12,PERMIN,PERMAX)
C
C **********************************************************************
C
C   FORMS LEAST SQUARES FIT OF STRAIGHT LINE TO DATA RECEIVED SO FAR.
C        INPUT DATA IN PAIRS (N,TN). GRAPH IS DRAWN OF TN (ORDINATE)
C        AGAINST N (ABSCISSA).  BEST STRAIGHT LINE FITTED DESCRIBED
C        BY THE OUTPUT PARAMETERS RINF AND XN12
C
C        K - =0 TO INITIALIZE, =1 TO FIT LINE
C        N - VECTOR LENGTH
C        TN - TIME PER VECTOR OPERATION OF ABOVE LENGTH
C        RINF - INVERSE SLOPE OF BEST LINE USING ALL DATA RECEIVED
C        XNI2 - NEGATIVE INTERCEPT OF BEST LINE ON N-AXIS
C        PERMIN - MINIMUM PERCENTAGE ERROR: 100*RMSERR/VALUE
C        PERMAX - MAXIMUM PERCENTAGE ERROR
C
C ----------------------------------------------------------------------
C
        COMMON /PARM/ IOUT,NMAX,T0,NTIMES,NTIM,TOTIM
        COMMON /FIT/ SI,STI,STI2,SNI,SNI2,STINI
        COMMON /RESULT/ RLAST(50),XNLAST(50),PCTMIN(50),PCTMAX(50)
        COMMON // A(10000),B(10000),C(10000),D(10000),E(10000),F(10000)
     1          ,IA(10000),IB(10000)
        DIMENSION MATA(100,100),MATB(100,100),MATC(100,100)
C
       DOUBLE PRECISION SI,STI,STI2,SNI,SNI2,STINI
       DOUBLE PRECISION TI,DRINF,DXN12,RMSE,DENOM,ARG
C
       IF (K .NE. 0) GOTO 10
        SI=0
        STI=0
        STI2=0
        SNI=0
        SNI2=0
        STINI=0
        PERMIN=1.0E10
        PERMAX=0.0
        PER=0.0
C
        WRITE(IOUT,668)
 668    FORMAT(//,4X,'SI',6X,'NI',10X,'TI',13X,'RINF',10X,
     1      'N1/2',8X,'RMS ERROR',6X,'REPEAT',7X,'TOTAL TIME',
     1    5X,'PERCENT ERROR',
     2     /,11X,'FLOP',8X,'SECS',11X,'MFLOP/S',8X,'FLOP',10X,'SECS',
     3       25X,'SECS')
C
       RETURN
C
 10    CONTINUE
C  TAKE NEW DATA AND UPDATE SUMS
         NI=N
         TI=TN
         SI=SI+1
         STI=STI+TI
         STI2=STI2+TI*TI
         SNI=SNI+NI
         SNI2=SNI2+NI*NI
         STINI=STINI+TI*NI
C
        IF (SI .GE. 2) GO TO 400
         DRINF=0
         DXN12=0
         RMSE=0
         GOTO 430
 400    CONTINUE
C
C   CALCULATE NEW RINF AND N1/2
         DENOM=SI*STINI-STI*SNI
         IF (DENOM .NE. 0) GOTO 410
         DRINF=0
         DXN12=0
         RMSE=0
         GOTO 430
 410        CONTINUE
C
         DRINF=(SI*SNI2-SNI*SNI)/DENOM
         DXN12=(STI*SNI2-STINI*SNI)/DENOM
C
         ARG=(STI2-(STINI+DXN12*STI)/DRINF)/SI
         IF(ARG .LT. 0) GOTO 420
         RMSE=DSQRT(ARG)
         GOTO 430
 420     RMSE=-DSQRT(-ARG)
 430     CONTINUE
C
C  UPDATE PERCENTAGE ERRORS
        IF(SI .LE. 2) GOTO 450
          PER=100.0*RMSE/TI
          IF(SI .EQ. 3) PERMIN=PER
          PERMAX=MAX(PERMAX,PER)
 450    CONTINUE
C
         NSI=SI
C  CONVERT TO MFLOP/S
         RINF=DRINF*1.0E-6
         XN12=DXN12
         WRITE(6,100) NSI,NI,TI,RINF,XN12,RMSE,NTIM,TOTIM,PER
 100    FORMAT(1X,I5,I10,1PE15.6,0PF15.6,F12.3,3X,1PE15.6,I10,3X,E15.6,
     1       0PF13.3)
C
         RETURN
          END
C
C
C
C **********************************************************************
C
       SUBROUTINE DOALL(ICASE,N,TN)
C
C **********************************************************************
C
C     ICASE - CASE NUMBER, INPUT PARAM
C     N     - VECTOR LENGTH
C     TN    - TIME PER VECTOR OPERATION, OUTPUT PARAM
C     FLOP  - INTERNAL VAR: NUMBER OF VECTOR OPS TIMED
C
C ----------------------------------------------------------------------
C
       COMMON // A(10000),B(10000),C(10000),D(10000),E(10000),F(10000)
     1          ,IA(10000),IB(10000)
       DIMENSION MATA(100,100),MATB(100,100),MATC(100,100)
       COMMON /PARM/ IOUT,NMAX,T0,NTIMES,NTIM,TOTIM
       COMMON /RESULT/ RLAST(50),XNLAST(50),PCTMIN(50),PCTMAX(50)
       COMMON /CHARS/ LABEL(50)
       CHARACTER*80 LABEL
C
C  SELECT REPEAT
       NTIM=1
      IF (N .EQ. 0) GO TO 50
       IF (N .NE. 0) NTIM=NTIMES/N
       IF(ICASE .EQ. 10) NTIM=NTIM/N
       IF(ICASE .GE. 11 .AND. ICASE .LE. 13) NTIM=NTIM/(N*N)
       IF(NTIM .EQ. 0) NTIM=1
       FNTIM=NTIM
C
C  TIME OVERHEAD OF CALLING TIMER, IN T0
         CALL SACOND(T1)
        DO 669 JT=1,NTIM
 669    CONTINUE
         CALL SACOND(T2)
         T0=T2-T1
C
 50     CONTINUE
C
C ----------------------------------------------------------------------
C
       IF (ICASE .NE. 1) GOTO 200
C CONTIGUOUS DYADS
        LABEL(1)='CONTIGUOUS DYADS:  A(I)=B(I)*C(I)'
        IF (N .EQ. 0) RETURN
C
        FLOP=1.0
        CALL SACOND(T1)
C
        DO 111 JT=1,NTIM
C THE VECTOR OPERATION
        DO 110 I=1,N
 110       A(I)=B(I)*C(I)
C
 111    CONTINUE
C
        CALL SACOND(T2)
C
C   GO TO FINAL SEQUENCE
        GOTO 10
C
C
C ----------------------------------------------------------------------
C
 200   IF (ICASE .NE. 2) GOTO 300
C NONCONTIGUOUS DYAD
        LABEL(2)='DYADS,  STRIDE=8:  A(I)=B(I)*C(I)'
        IF (N .EQ. 0) RETURN
C
        FLOP=1.0
        NL=1+8*(N-1)
        IF (NL .GT. NMAX) N=0
C N=0 IS SIGNAL VECTOR TOO LONG TO OUTSIDE
        IF (N .EQ. 0) RETURN
C
        CALL SACOND(T1)
C
        DO 211 JT=1,NTIM
C
        DO 210 I=1,NL,8
 210       A(I)=B(I)*C(I)
C
 211    CONTINUE
C
        CALL SACOND(T2)
C
C
C   GO TO FINAL SEQUENCE
        GOTO 10
C
C
C
C ----------------------------------------------------------------------
C
 300   IF (ICASE .NE. 3) GOTO 400
C CONTIGUOUS TRIAD
        LABEL(3)='CONTIGUOUS TRIADS:  A(I)=B(I)*C(I)+D(I)'
        IF (N .EQ. 0) RETURN
C
        FLOP=2.0
C
         CALL SACOND(T1)
        DO 311 JT=1, NTIM
C
        DO 310 I=1,N
 310       A(I)=B(I)*C(I)+D(I)
C
 311    CONTINUE
C
        CALL SACOND(T2)
C
C
C   GO TO FINAL SEQUENCE
        GOTO 10
C
C
C
C ----------------------------------------------------------------------
C
 400   IF (ICASE .NE. 4) GOTO 500
C NONCONTIGUOUS TRIADS
        LABEL(4)='TRIADS,  STRIDE=8:  A(I)=B(I)*C(I)+D(I)'
        IF (N .EQ. 0) RETURN
C
        FLOP=2.0
        NL=1+8*(N-1)
        IF (NL .GT. NMAX) N=0
        IF (N .EQ. 0) RETURN
C
        CALL SACOND(T1)
C
        DO 411 JT=1,NTIM
C
        DO 410 I=1,NL,8
 410       A(I)=B(I)*C(I)+D(I)
C
 411    CONTINUE
C
        CALL SACOND(T2)
C
C
C   GO TO FINAL SEQUENCE
        GOTO 10
C
C
C
C ----------------------------------------------------------------------
C
 500   IF (ICASE .NE. 5) GOTO 600
C RANDOM SCATTER/GATHER
        LABEL(5)='RANDOM SCATTER/GATHER:'
        IF (N .EQ. 0) RETURN
C
        FLOP=2.0
C
        CALL SACOND(T1)
C
        DO 511 JT=1,NTIM
C
C RANDOM GATHER
        DO 510 I=1,N
 510       A(I)=C(IB(I))
C
C RANDOM SCATTER
        DO 520 I=1,N
 520       A(IB(I))=C(I)
C
 511   CONTINUE
C
        CALL SACOND(T2)
C RECORD AVERAGE SCATTER/GATHER, DIVIDE BY 2
C
C
C   GO TO FINAL SEQUENCE
        GOTO 10
C
C
C
C ----------------------------------------------------------------------
C
 600   IF (ICASE .NE. 6) GOTO 700
C CONTIGUOUS 4-OPS
        LABEL(6)='CONTIGUOUS 4-OP:  A(I)=B(I)*C(I)+D(I)*E(I)+F(I)'
        IF (N .EQ. 0) RETURN
        FLOP=4.0
        CALL SACOND(T1)
C
        DO 611 JT=1,NTIM
C THE VECTOR OPERATION
        DO 610 I=1,N
 610       A(I)=B(I)*C(I)+D(I)*E(I)+F(I)
C
 611    CONTINUE
C
        CALL SACOND(T2)
C
C   GO TO FINAL SEQUENCE
        GOTO 10
C
C
 700    CONTINUE
C
C ----------------------------------------------------------------------
C
       IF (ICASE .NE. 7) GOTO 800
        LABEL(7)='INNER PRODUCT:  S=S+B(I)*C(I)'
        IF (N .EQ. 0) RETURN
        FLOP=2.0
        CALL SACOND(T1)
C
        DO 711 JT=1,NTIM
C THE VECTOR OPERATION
            SUM=0.0
        DO 710 I=1,N
 710       SUM=SUM+B(I)*C(I)
C
 711    CONTINUE
C
        CALL SACOND(T2)
C
C   GO TO FINAL SEQUENCE
        GOTO 10
C
 800    CONTINUE
C
C ----------------------------------------------------------------------
C
       IF (ICASE .NE. 8) GOTO 900
        LABEL(8)='FIRST ORDER RECURRENCE:  A(I)=B(I)*A(I-1)+D(I)'
        IF (N .EQ. 0) RETURN
        FLOP=2.0
        CALL SACOND(T1)
C
        DO 811 JT=1,NTIM
C THE VECTOR OPERATION
           A(1)=D(1)
        DO 810 I=2,N
 810       A(I)=F(I)*A(I-1)+D(I)
C
 811    CONTINUE
C
        CALL SACOND(T2)
C
C   GO TO FINAL SEQUENCE
        GOTO 10
C
 900    CONTINUE
C
C ----------------------------------------------------------------------
C
       IF (ICASE .NE. 9) GOTO 1000
        LABEL(9)='CHARGE ASSIGNMENT:  A(J(I))=A(J(I))+S'
        IF (N .EQ. 0) RETURN
        FLOP=1.0
        CALL SACOND(T1)
C
          CH=1.7349
        DO 911 JT=1,NTIM
C THE VECTOR OPERATION
        DO 910 I=1,N
 910      C(IA(I))=C(IA(I))+CH
C
 911    CONTINUE
C
        CALL SACOND(T2)
C
C   GO TO FINAL SEQUENCE
        GOTO 10
C
 1000    CONTINUE
C
C ----------------------------------------------------------------------
C
       IF (ICASE .NE. 10) GOTO 1100
       LABEL(10)='TRANSPOSITION:  A(I,J)=A(J,I)'
C
C  ESCAPE IF N TOO BIG
        IF (N .GT. 100) N=0
        IF (N .EQ. 0) RETURN
C
C
        FLOP=N
        CALL SACOND(T1)
C
        DO 1011 JT=1,NTIM
C THE VECTOR OPERATION
        DO 1010 I=1,N
        DO 1010 J=1,N
 1010      MATA(I,J)=MATA(J,I)
C
 1011    CONTINUE
C
        CALL SACOND(T2)
C
C   GO TO FINAL SEQUENCE
        GOTO 10
C
 1100    CONTINUE
C
C ----------------------------------------------------------------------
C
       IF (ICASE .NE. 11) GOTO 1200
       LABEL(11)='MATRIX MULT BY INNER PRODUCT'
C    EACH INNER PRODUCT ACCUMULATED IN SEQUENCE
C
C  ESCAPE IF N TOO BIG
        IF (N .GT. 100) N=0
        IF (N .EQ. 0) RETURN
C
C  CLEAR ARRAY BEFORE ACCUMULATING SUMS
        DO 1120 I=1,N
        DO 1120 J=1,N
 1120       MATA(I,J)=0.0
C
        FLOP=2*N*N
        CALL SACOND(T1)
C
        DO 1111 JT=1,NTIM
        DO 1110 J=1,N
        DO 1110 I=1,N
C   ACCUMULATE INNER PRODUCT
        DO 1110 K=1,N
 1110    MATA(I,J)=MATA(I,J)+MATB(I,K)*MATC(K,J)
C
 1111    CONTINUE
C
        CALL SACOND(T2)
C
C   GO TO FINAL SEQUENCE
        GOTO 10
C
 1200    CONTINUE
C
C ----------------------------------------------------------------------
C
       IF (ICASE .NE. 12) GOTO 1300
       LABEL(12)='MATRIX MULT BY MIDDLE PRODUCT'
C    A COLUMN OF INNER PRODUCTS ARE ACCUMULATED IN PARALLEL
C    2 N**2 VECTOR OPS OF LENGTH N
C
C  ESCAPE IF N TOO BIG
        IF (N .GT. 100) N=0
        IF (N .EQ. 0) RETURN
C
C  CLEAR ARRAY BEFORE ACCUMULATING SUMS
        DO 1220 I=1,N
        DO 1220 J=1,N
 1220       MATA(I,J)=0.0
C
        FLOP=2*N*N
        CALL SACOND(T1)
C
        DO 1211 JT=1,NTIM
        DO 1210 J=1,N
        DO 1210 K=1,N
C
C THE VECTOR OPERATION OF LENGTH N
        DO 1210 I=1,N
 1210    MATA(I,J)=MATA(I,J)+MATB(I,K)*MATC(K,J)
C
 1211    CONTINUE
C
        CALL SACOND(T2)
C
C   GO TO FINAL SEQUENCE
        GOTO 10
C
 1300    CONTINUE
C
C ----------------------------------------------------------------------
C
       IF (ICASE .NE. 13) GOTO 1400
       LABEL(13)='MATRIX MULT BY OUTER PRODUCT'
C   ACCUMULATE ALL N**2 INNER PRODUCTS IN PARALLEL
C   USES 2*N VECTOR OPS OF LENGTH N**2
C
C  ESCAPE IF N TOO BIG
        IF (N .GT. 100) N=0
        IF (N .EQ. 0) RETURN
C
        N2=N*N
C  CLEAR ARRAY BEFORE ACCUMULATING SUMS
        DO 1320 I=1,N2
 1320       A(I)=0.0
C
        FLOP=2*N
        CALL SACOND(T1)
C
        DO 1311 JT=1,NTIM
C
        DO 1314 K=1,N
C    LOAD 1D ARRAYS IN PREPARATION FOR VECTOR OP OF LENGTH N**2
        DO 1312 J=1,N
        DO 1312 I=1,N
          B(I+N*(J-1))=MATB(I,K)
          C(I+N*(J-1))=MATC(K,J)
 1312   CONTINUE
C
C   THE VECTOR OPERATION OF LENGTH N**2
        DO 1310 I=1,N2
 1310     A(I)=A(I)+B(I)*C(I)
C
 1314   CONTINUE
C
 1311    CONTINUE
C
        CALL SACOND(T2)
C
         N=N2
C
C   GO TO FINAL SEQUENCE
        GOTO 10
C
 1400  CONTINUE
C
C ----------------------------------------------------------------------
C
C               ADD NEW CASES HERE FOLLOWING ABOVE PATTERN
C
C ----------------------------------------------------------------------
C
        TOTIM=0.0
        TN=0.0
        RETURN
C
 10     TOTIM=T2-T1-T0
        TN=TOTIM/(FLOP*FNTIM)
C
        RETURN
        END
C
C **********************************************************************
C
        SUBROUTINE SATIME
C
C **********************************************************************
C
C  REPLACE THE NEXT INSTRUCTION WITH A CALL TO INITIALIZE YOUR TIMER
C  IF INITIALIZATION IS NOT NECESSARY, LEAVE DUMMY AS IS.
C
        RETURN
        END
C
C **********************************************************************
C
         SUBROUTINE SACOND(T)
C
C **********************************************************************
C
C   REPLACE NEXT INSTRUCTION WITH A CALL TO YOUR TIMER. USE THE MOST
C   ACCURATE AVAILABLE, PREFERABLY TICKING EVERY CPU CLOCK PERIOD.
C
C     T - CPU TIME FOR THIS JOB IN SECONDS WHEN SUBROUTINE IS CALLED
C
C   THE TIMER TODCLK CALLED BELOW USES THE IBM 370 TIME OF DAY CLOCK
C   IN THE CMS PSUEDO CLOCK TIMER.  ON AN AMDAHL V7A IT TICKS AT
C   LESS THAN 10 MICROSECONDS.  IT IS A THOUSAND TIMES MORE ACCURATE
C   THAN MOST TIMERS TO BE FOUND IN SYSTEM LIBRARIES. USUALLY THESE USE
C   THE INTERVAL TIMER WHICH HAS A TICK OF 3 MILLISECS OR WORSE.  IF
C   YOU WISH TO USE TODCLK, INCLUDE IN YOUR CMS EXEC:
C
C                          LOAD TODCLK TEXT
C
C   THE SOURCE IS IN FILE:   TODCLK  ASSEMBLE.
C
C   THE TICK OF YOUR CLOCK IS MEASURED, AND PRINTED ON THE FIRST PAGE
C   OF YOUR LISTING.  ADJUST NTIMES SUCH THAT:
C
C                   NTIMES=1.0E8*(CLOCK TICK)*(MFLOP/S)
C
C   AND RMS ERROR IS 1.0E-2 OF THE TIME FOR THE VECTOR OPERATION, TI.
C
        DIMENSION I(8)
        CALL TODCLK(I(1))
        T=1.0E-6*I(6)
C
C
         RETURN
         END


.