SUBROUTINE R11 ( C, MODULUS, N, Q, M, NUMSIZE, ERR, * CSET, WSET, CRUN, WRUN, CCHECK, WCHECK ) c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c CVS Info c $Date: 2005/01/10 21:56:21 $ c $Revision: 1.2 $ c $RCSfile: r11.F,v $ c $Name: rel_5 $ c c This is the output routine for Benchmark 11. c c This will need to be modified to contain the particular c configuration information requested. c c Parameters: c Provided by calling routine: c C = Product matrix c MODULUS = Modulus for the arithmetic c N = Size of matrices c M = Size of sub-matrices on each PE c Q = Size of grid of Q x Q PEs c NUMSIZE = Number of words used to hold an MP integer c ERR = Error flag c CSET = CPU time required to generate the data c WSET = Wallclock time required to generate the data c CRUN = CPU time required to do the benchmark c WRUN = Wallclock time required to do the benchmark c CCHECK = CPU time required to check the results c WCHECK = Wallclock time required to check the results c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c IMPLICIT NONE #include "bench11.h" #include C--CVS variable declaration TYPE CVS sequence character( 160 ) string integer stringend END TYPE CVS C--CVS initilaize variables TYPE( CVS ),save :: CVS_INFO = $ CVS("BMARKGRP $Date: 2005/01/10 21:56:21 $ $Revision: 1.2 $" // $ "$RCSfile: r11.F,v $ $Name: rel_5 $", 0) C c c Variables holding the times. c MY_DOUBLE CSET, WSET, CRUN, WRUN, CCHECK, WCHECK, * MAXCSET, MAXWSET, MAXCRUN, MAXWRUN, MAXCCHECK, MAXWCHECK, * AVGCSET, AVGWSET, AVGCRUN, AVGWRUN, AVGCCHECK, AVGWCHECK MY_DOUBLE MINCRUN c c Other variables c INTEGER I, J, K, N, Q, M, NUMSIZE, ERR INTEGER PEROW, PECOL, LOCALI, LOCALJ, CRANK, TAG, WORLD, IER c c Arrays to hold the product matrix and modulus c These are allocated in main M11 at max size, we resize here c MPLONG C ( NUMSIZE, M, M ) MPLONG MODULUS ( NUMSIZE ) c MPLONG TEMPC ( MAXNUMSIZE ) c #ifndef CRAY CHARACTER*24 FDATE EXTERNAL FDATE #endif c INTEGER STATUS(MPI_STATUS_SIZE) CHARACTER*256 ERR_STRING INTEGER MPI_DOUBLE WORLD = MPI_COMM_WORLD MPI_DOUBLE = MPI_DOUBLE_PRECISION c c Collect-add run times in AVGCRUN, max in MAXCRUN on PE0 c CALL MPI_REDUCE(CRUN, MAXCRUN, 1,MPI_DOUBLE, MPI_MAX, 0,WORLD,IER) CALL MPI_REDUCE(CRUN, MINCRUN, 1,MPI_DOUBLE, MPI_MIN, 0,WORLD,IER) CALL MPI_REDUCE(CRUN, AVGCRUN, 1,MPI_DOUBLE, MPI_SUM, 0,WORLD,IER) IF (MYPE .EQ. 0) AVGCRUN = AVGCRUN / NPES c c PE0 prints out header and times c IF (MYPE .EQ. 0) THEN c PRINT '(///,"Benchmark #11 -- Multiprecision Arithmetic",/)' c #ifdef CRAY PRINT 7, DATE() 7 FORMAT("Date: ", A15, /) #else /* Requires /usr/lib/libU77.a. Works on CONVEX and DEC Alpha. */ PRINT 7, FDATE() 7 FORMAT("Date: ", A24, /) #endif c PRINT 14,Q*Q 14 FORMAT( "Number of processors = ", I11) c PRINT 15,N 15 FORMAT( "Size of matrices = ", I11) c PRINT '("Modulus:")' CALL MPWRITE(MODULUS) PRINT* c PRINT 25, CSET, WSET 25 FORMAT("Time for set up: ", /, * " CPU = ", F12.4, " seconds", /, * " Wall Clock = ", F12.4, " seconds", /) c cccc if Q > 1 !!!!! PRINT 30, CRUN, MAXCRUN, MINCRUN, AVGCRUN, WRUN 30 FORMAT("Time to run: ", /, * " CPU PE0 = ", F12.4, " seconds", /, * " CPU MAX = ", F12.4, " seconds", /, * " CPU MIN = ", F12.4, " seconds", /, * " CPU AVG = ", F12.4, " seconds", /, * " Wall Clock = ", F12.4, " seconds", /) c PRINT 35, CCHECK, WCHECK 35 FORMAT("Time to check results: ", /, * " CPU = ", F12.4, " seconds", /, * " Wall Clock = ", F12.4, " seconds", /) c c No errors c IF (ERR .EQ. 0) THEN PRINT '("NO ERRORS FOUND")' ENDIF c c Results for given input parameters are unknown c IF (ERR .LT. 0) THEN PRINT '("The results for given input parameters are unknown.", * /, "No checking is possible.")' ENDIF c IF(ERR .EQ. 1) THEN PRINT '("ERROR: Results do not agree with previous results.")' ENDIF c IF(ERR .EQ. 2) THEN PRINT '("ERROR: MPI_GATHER failed, unable to check results.")' ENDIF c ENDIF ! IF (MYPE .EQ. 0) print out header and times c c PE0 finished first half of output c #ifdef PrintAll c c Print out selected results - can turn it on/off in makefile c c Several PEs must cooperate to get the data to PE0 c DO 50, I = 1, N, N/3 DO 60, J = 1, N, N/4 c c figure where C(I,J) is and get it to PE0 and print c PEROW = (I-1) / M PECOL = (J-1) / M LOCALI = 1 + MOD(I-1,M) LOCALJ = 1 + MOD(J-1,M) CRANK = Q * PEROW + PECOL TAG = CRANK c IF (CRANK .NE. 0) THEN c c get C(I,J) from other PE to TEMPC on PE0 c IF (MYPE .EQ. 0) THEN CALL MPI_RECV ( TEMPC, NUMSIZE, MY_INTEGER, * CRANK, TAG, WORLD, STATUS, IER ) ENDIF IF (MYPE .EQ. CRANK) THEN CALL MPI_SEND ( C(1,LOCALI,LOCALJ), NUMSIZE, * MY_INTEGER, 0, TAG, WORLD, IER ) ENDIF c ELSE c c it`s on PE0, just move it from C(I,J) to TEMPC c DO K = 1, NUMSIZE TEMPC(K) = C(K,I,J) END DO c ENDIF c IF (MYPE .EQ. 0) THEN # ifdef GMP TEMPC(MPPTR) = LOC ( TEMPC(MPDATA) ) # endif PRINT 40, I, J 40 FORMAT( /, "C(", I4, ",", I4, " ) = :" ) CALL MPWRITE(TEMPC) ENDIF c 60 CONTINUE 50 CONTINUE c c get C(N,N) c CRANK = Q*((N-1)/M) + (N-1)/M c IF (NPES .GT. 1 .AND. CRANK .NE. 0) THEN c c get C(N,N) from last PE into TEMPC on PE0 c LOCALI = 1 + MOD(N-1, M) LOCALJ = 1 + MOD(N-1, M) TAG = CRANK IF (MYPE .EQ. 0) THEN CALL MPI_RECV ( TEMPC, NUMSIZE, MY_INTEGER, * CRANK, TAG, WORLD, STATUS, IER ) ENDIF IF (MYPE .EQ. CRANK) THEN CALL MPI_SEND ( C(1,LOCALI,LOCALJ), NUMSIZE, * MY_INTEGER, 0, TAG, WORLD, IER ) ENDIF c ELSE c c NPES = 1 (or we`re wasting space), just move C(N,N) into TEMPC c DO K = 1, NUMSIZE TEMPC(K) = C(K,N,N) END DO c ENDIF c IF (MYPE .EQ. 0) THEN # ifdef GMP TEMPC(MPPTR) = LOC ( TEMPC(MPDATA) ) # endif PRINT 40, N,N CALL MPWRITE(TEMPC) PRINT* ENDIF c #endif c RETURN END