VECFEM3 Reference Manual: vempeak.html

          PROGRAM PEAK
    C**********************************************************************
    C**                                                                 ***
    C**   Before you install VECFEM on your computer you have to adapt  ***
    C**   the include data sets to your machine. This program creates   ***
    C**   the include file archi.h.                                      ***
    C**                                                                 ***
    C**   The program uses the include file norec.h which has to be     ***
    C**   adapted before the run. Additionally the routine VEMSCD which ***
    C**   is also used by VECFEM has to be adapted to your FORTRAN      ***
    C**   compiler. The value DT in this program specify the accuracy   ***
    C**   of the SECOND routine in seconds (e.g. DT=1.). The value      ***
    C**   NMAX has to be selected to a vector length where the          ***
    C**   peak performance of the general triad is nearly reached       ***
    C**   (e.g. NMAX=10 000). It could happen that you have to repeat   ***
    C**   the measurement with a new NMAX.                              ***
    C**                                                                 ***
    C**********************************************************************
    C**                                                                 ***
          IMPLICIT NONE
    C**                                                                 ***
    C**-----------------------------------------------------------------***
    C**                                                                 ***
    C**      PARAMETERS :                                               ***
    C**      ------------                                               ***
    C**                                                                 ***
    C**                    >                                            ***
          DOUBLE PRECISION  DT
          INTEGER           NMAX

          PARAMETER  (NMAX=70 000)
          PARAMETER  (DT=1.)
    C**                                                                 ***
    C**-----------------------------------------------------------------***
    C**                                                                 ***
    C**      VARIABLES AND ARRAYS :                                     ***
    C**      ----------------------                                     ***
    C**                                                                 ***
          DOUBLE PRECISION  X(NMAX),Y(NMAX),Z(NMAX)
          INTEGER           INDEX1(NMAX),INDEX2(NMAX)
    C**
          EXTERNAL          DIA,PDIA,ROW,COL,SKY,PROW,PCOL,FROW,FCOL
    C**
          INTEGER           I,ERR
          CHARACTER*10      NLOOP

          OPEN(99,FILE='peaks.h',STATUS='UNKNOWN')
    C
    C**** SET INDEX VECTOR :
    C     ------------------
    C
          DO 10 I=1,2*NMAX
            X(I)=0
            Y(I)=0
    10      Z(I)=0
    C
    C**** START :
    C     -------
    C
          NLOOP='DIA '
          CALL MEASUR(NMAX,INDEX2,INDEX1,X,Y,Z,DT,DIA,NLOOP,ERR)
          IF (ERR.NE.0) GOTO 9999

          NLOOP='PDIA'
          CALL MEASUR(NMAX,INDEX2,INDEX1,X,Y,Z,DT,PDIA,NLOOP,ERR)
          IF (ERR.NE.0) GOTO 9999

          NLOOP='SKY '
          CALL MEASUR(NMAX,INDEX2,INDEX1,X,Y,Z,DT,SKY,NLOOP,ERR)
          IF (ERR.NE.0) GOTO 9999

          NLOOP='ROW '
          CALL MEASUR(NMAX,INDEX2,INDEX1,X,Y,Z,DT,ROW,NLOOP,ERR)
          IF (ERR.NE.0) GOTO 9999

          NLOOP='COL '
          CALL MEASUR(NMAX,INDEX1,INDEX2,X,Y,Z,DT,COL,NLOOP,ERR)
          IF (ERR.NE.0) GOTO 9999

          NLOOP='PCOL '
          CALL MEASUR(NMAX,INDEX1,INDEX2,X,Y,Z,DT,PCOL,NLOOP,ERR)
          IF (ERR.NE.0) GOTO 9999

          NLOOP='PROW '
          CALL MEASUR(NMAX,INDEX1,INDEX2,X,Y,Z,DT,PROW,NLOOP,ERR)
          IF (ERR.NE.0) GOTO 9999

          NLOOP='FCOL '
          CALL MEASUR(NMAX,INDEX1,INDEX2,X,Y,Z,DT,FCOL,NLOOP,ERR)
          IF (ERR.NE.0) GOTO 9999

          NLOOP='FROW '
          CALL MEASUR(NMAX,INDEX1,INDEX2,X,Y,Z,DT,FROW,NLOOP,ERR)
          IF (ERR.NE.0) GOTO 9999
    9999  CONTINUE
          E    N    D
    C:::::      ,,,,,MEASUR...
    C
    C
    C
    C**********************************************************************
    C        1         2         3         4         5         6         7*
    C**********************************************************************
    C**                                                                 ***
    C**                                                                 ***
          SUBROUTINE MEASUR(NMAX,INDEX1,INDEX2,X,Y,Z,DT,LOOP,NLOOP,ERR)
    C**                                                                 ***
    C**                                                                 ***
    C**********************************************************************
    C**                                                                 ***
    C**      MEASUR    MEASUREMENT MVM BASE LOOP                        ***
    C**                                                                 ***
    C**********************************************************************
    C**                                                                 ***
          IMPLICIT NONE
    C**                                                                 ***
    C**-----------------------------------------------------------------***
    C**                                                                 ***
    C**                                                                 ***
    C**                    >                                            ***
          INTEGER           NMAX,ERR
          DOUBLE PRECISION  X(NMAX),Y(NMAX),Z(NMAX),DT
          INTEGER           INDEX1(NMAX),INDEX2(NMAX)
          EXTERNAL          LOOP
          CHARACTER*10      NLOOP
    C**                                                                 ***
          DOUBLE PRECISION  RPEAK,R2,SIGMA,NH,NHS
          DOUBLE PRECISION  TIME1,CPU
          INTEGER           REPEAT,N,K,N0,CHECK,NHH,REP2
    C
    C**** START OF CALCULATION :
    C     ---------------------
    C
          ERR=0
    C
    C**** first the number of repeats is estimated :
    C     ----------------------------------------
    C
          REPEAT=5
          PRINT*,' '
    2000  TIME1=CPU(REPEAT,1,NMAX,INDEX1,INDEX2,X,Y,Z,LOOP)
          PRINT*,'test : repeat =',REPEAT,'  time =',TIME1*REPEAT
          IF (TIME1*REPEAT.LT.DT) THEN
    	 REPEAT=REPEAT*1.5
    	 GOTO 2000
          ENDIF
          REPEAT=DT/TIME1
          PRINT*,'selected repeat =',REPEAT
    C
    C**** now the peak performance is computed :
    C     -------------------------------------
    C
          PRINT*,' '
          PRINT*,'peak performance :',NLOOP
          N=NMAX/2
          TIME1=CPU(REPEAT,2,N,INDEX1,INDEX2,X,Y,Z,LOOP)
          RPEAK=FLOAT(N)/TIME1*2
          PRINT*,' 1. vector length :',N
          PRINT*,'    performance [Mflops]:',RPEAK*1.D-6
    C
    C**** peak performance o.k. ?
    C     -------------------------------------
    C
          N=NMAX/4
          TIME1=CPU(REPEAT,4,N,INDEX1,INDEX2,X,Y,Z,LOOP)
          R2=FLOAT(N)/TIME1*2
          PRINT*,' 2. vector length :',N
          PRINT*,'    performance [Mflops]:',R2*1.d-6
          IF (ABS(RPEAK-R2).GT.RPEAK*.1) THEN
             WRITE(6,*) '>>increase NMAX and start again !'
             WRITE(6,*) '  abend !'
             ERR=1
             RETURN
          ENDIF
          PRINT*,'accepted !'
          RPEAK=(RPEAK+R2)/2
    C
    C**** n 1/2 :
    C     -------------------------------------
    C
          PRINT*,'n 1/2 :'
          CHECK=10
          NH=0
          NHS=0
          DO 9999 N0=11,10+CHECK
            N=N0
            K=NMAX/N
    	rep2=max((1*nmax*repeat)/(K*N),1)
            TIME1=CPU(REP2,K,N,INDEX1,INDEX2,X,Y,Z,LOOP)
            NHH=TIME1*RPEAK/2-N+.5
    	NH=NH+NHH
    	NHS=NHS+NHH**2
    	PRINT*,'    vl =',N,'   n 1/2 = ',NHH
    9999  CONTINUE
          NH=NH/FLOAT(CHECK)
          SIGMA=SQRT((NHS-CHECK*NH**2)/(CHECK-1))/NH*100.
          PRINT*,'mean value ',INT(NH+.5)
          PRINT*,'varianz %',SIGMA
    C
          WRITE(99,1040) NLOOP,NLOOP,NLOOP,RPEAK*1.D-6,NLOOP,INT(NH+.5)
    C
    C**** END OF CALCULATION
    C     ------------------
    C
    1040  FORMAT( '       DOUBLE PRECISION   R',A4,',NH',A4
         &    /'       PARAMETER (R',A4,'=',G15.4,',NH',A4,'=',I10,')')
          R E T U R N
    C-----END OF SECOND----------------------------------------------------
          E    N    D

          DOUBLE PRECISION FUNCTION CPU(REPEAT,K,N,INDEX1,
         &                              INDEX2,X,Y,Z,LOOP)
    C**                                                                 ***
    C**-----------------------------------------------------------------***
    C**                                                                 ***
          IMPLICIT NONE
    C**                                                                 ***
    C**-----------------------------------------------------------------***
    C**                                                                 ***
    C**                    >                                            ***
          INTEGER           N,K,REPEAT
          DOUBLE PRECISION  X(N,K),Y(N,K),Z(N,K)
          INTEGER           INDEX1(N,K),INDEX2(N,K)
          EXTERNAL          LOOP
    C**                                                                 ***
          DOUBLE PRECISION  TIME,VEMSCD
          INTEGER           I,J

          DO 32 I=1,K
            DO 31 J=1,N
    	  INDEX1(J,I)=J
    	  INDEX2(J,I)=J
    31      CONTINUE
    32    CONTINUE

          TIME=VEMSCD()
          DO 30 J=1,REPEAT
            DO 30 I=1,K
    30        CALL LOOP(N,INDEX1(1,I),INDEX2(1,I),X(1,I),Y(1,I),Z(1,I))
          CPU=(VEMSCD()-TIME)/FLOAT(REPEAT*K)
          R E T U R N
    C-----END OF CPU----------------------------------------------------
          E    N    D

          SUBROUTINE DIA(N,INDEX1,INDEX2,X,Y,Z)
          INTEGER           INDEX1(N),INDEX2(N),N,I
          DOUBLE PRECISION    X(N),Y(N),Z(N)
          DO 10 I=1,N
    10     X(I)=X(I)+Y(I)*Z(I)
          R E T U R N
          E    N    D

          SUBROUTINE PDIA(N,INDEX1,INDEX2,X,Y,Z)
          DOUBLE PRECISION    X(N),Y(N),Z(N)
          INTEGER           INDEX1(N),INDEX2(N),N,I
          include"norec.h"
          DO 10 I=1,N
    10     X(INDEX1(I))=X(INDEX1(I))+Y(I)*Z(INDEX1(I))
          R E T U R N
          E    N    D

          SUBROUTINE ROW(N,INDEX1,INDEX2,X,Y,Z)
          DOUBLE PRECISION    X(N),Y(N),Z(N)
          INTEGER           INDEX1(N),INDEX2(N),N,I
          DO 10 I=1,N
    10     X(I)=X(I)+Y(I)*Z(INDEX1(I))
          R E T U R N
          E    N    D

          SUBROUTINE COL(N,INDEX1,INDEX2,X,Y,Z)
          DOUBLE PRECISION    X(N),Y(N),Z(N)
          INTEGER           INDEX1(N),INDEX2(N),N,I
          include"norec.h"
          DO 10 I=1,N
    10     X(INDEX2(I))=X(INDEX2(I))+Y(I)*Z(I)
          R E T U R N
          E    N    D

          SUBROUTINE PROW(N,INDEX1,INDEX2,X,Y,Z)
          DOUBLE PRECISION    X(N),Y(N),Z(N)
          INTEGER           INDEX1(N),INDEX2(N),N,I
          include"norec.h"
          DO 10 I=1,N
    10     X(1)=X(1)+Y(I)*Z(INDEX2(I))
          R E T U R N
          E    N    D

          SUBROUTINE FROW(N,INDEX1,INDEX2,X,Y,Z)
          DOUBLE PRECISION    X(N),Y(N),Z(N)
          INTEGER           INDEX1(N),INDEX2(N),N,I
          include"norec.h"
          DO 10 I=1,N
    10     X(1)=X(1)+Y(I)*Z(I)
          R E T U R N
          E    N    D

          SUBROUTINE FCOL(N,INDEX1,INDEX2,X,Y,Z)
          DOUBLE PRECISION    X(N),Y(N),Z(N)
          INTEGER           INDEX1(N),INDEX2(N),N,I
          include"norec.h"
          DO 10 I=1,N
    10     X(I)=X(I)+Y(I)*Z(1)
          R E T U R N
          E    N    D

          SUBROUTINE PCOL(N,INDEX1,INDEX2,X,Y,Z)
          DOUBLE PRECISION    X(N),Y(N),Z(N)
          INTEGER           INDEX1(N),INDEX2(N),N,I
          include"norec.h"
          DO 10 I=1,N
    10     X(INDEX1(I))=X(INDEX1(I))+Y(I)*Z(1)
          R E T U R N
          E    N    D

          SUBROUTINE SKY(N,INDEX1,INDEX2,X,Y,Z)
          DOUBLE PRECISION    X(N),Y(N),Z(N)
          INTEGER           INDEX1(N),INDEX2(N),N,I
          include"norec.h"
          DO 10 I=1,N
    10     X(INDEX2(I))=X(INDEX2(I))+Y(I)*Z(INDEX1(I))
          R E T U R N
          E    N    D