C PURPOSE: PARTION SIZE N DATA EVENLY AMONG NPROC PROCESSORS SUBROUTINE SETPART(N, PSIZE, NBASE) IMPLICIT NONE INTEGER N,NLOC, NREM, IPROC, IERR, NPROCS INTEGER PSIZE(*), NBASE(*) INTEGER MYPID, COMM #ifdef USE_MPI INCLUDE 'mpif.h' COMM = MPI_COMM_WORLD CALL MPI_COMM_SIZE(COMM, NPROCS, IERR) NLOC = N / NPROCS NREM = N - NLOC*NPROCS DO IPROC = 1, NPROCS PSIZE(IPROC) = NLOC IF (IPROC .LE. NREM) PSIZE(IPROC) = PSIZE(IPROC) + 1 ENDDO NBASE(1) = 0 DO IPROC = 2, NPROCS NBASE(IPROC) = NBASE(IPROC-1) + PSIZE(IPROC-1) ENDDO #endif RETURN END C----------------------------------------------------------------------- #ifdef USE_MPI C INCLUDE BLAS HERE C subroutine scopy(n,sx,incx,sy,incy) c c copies a vector, x, to a vector, y. c uses unrolled loops for increments equal to 1. c jack dongarra, linpack, 3/11/78. c real sx(1),sy(1) integer i,incx,incy,ix,iy,m,mp1,n c if(n.le.0)return if(incx.eq.1.and.incy.eq.1)go to 20 c c code for unequal increments or equal increments c not equal to 1 c ix = 1 iy = 1 if(incx.lt.0)ix = (-n+1)*incx + 1 if(incy.lt.0)iy = (-n+1)*incy + 1 do 10 i = 1,n sy(iy) = sx(ix) ix = ix + incx iy = iy + incy 10 continue return c c code for both increments equal to 1 c c c clean-up loop c 20 m = mod(n,7) if( m .eq. 0 ) go to 40 do 30 i = 1,m sy(i) = sx(i) 30 continue if( n .lt. 7 ) return 40 mp1 = m + 1 do 50 i = mp1,n,7 sy(i) = sx(i) sy(i + 1) = sx(i + 1) sy(i + 2) = sx(i + 2) sy(i + 3) = sx(i + 3) sy(i + 4) = sx(i + 4) sy(i + 5) = sx(i + 5) sy(i + 6) = sx(i + 6) 50 continue return end #endif