昔学んだテキストが出てきたので、f90 で書き直してみたりしなかったりします。
http://h50146.www5.hp.com/solutions/hpc/stc/soft/mpi.html
MPIプログラミング入門
http://h50146.www5.hp.com/solutions/hpc/stc/soft/pdfs/mpi_training.pdf (PDF直リン)
C:\program files\MPICH2\bin\mpiexec.exe -localonly 2 $(TargetPath) ****.exe
スレッド数は適宜調整のこと。
- 例題 3-4d
PROGRAM mpi_3 USE mpi IMPLICIT NONE INTEGER, PARAMETER :: nprocs = 3, nmax = 12 / nprocs INTEGER :: mstatus(MPI_STATUS_SIZE) INTEGER :: n(0:nmax + 1), na(0:nmax + 1) INTEGER :: i, isize, irank, ierr, iLF, iRT, ireq1, ireq2 CALL MPI_INIT(ierr) CALL MPI_COMM_SIZE(MPI_COMM_WORLD, isize, ierr) CALL MPI_COMM_RANK(MPI_COMM_WORLD, irank, ierr) IF (isize /= nprocs) THEN CALL MPI_FINALIZE(ierr) STOP END IF DO i = 1, nmax n(i) = irank * nmax + i END DO iLF = irank - 1 IF (irank == 0) iLF = MPI_PROC_NULL iRT = irank + 1 IF (irank == isize - 1) iRT = MPI_PROC_NULL CALL MPI_SENDRECV(n(nmax), 1, MPI_INTEGER, iRT, 1, & n(0) , 1, MPI_INTEGER, iLF, 1, & MPI_COMM_WORLD, mstatus, ierr) CALL MPI_SENDRECV(n(1) , 1, MPI_INTEGER, iLF, 1, & n(nmax + 1), 1, MPI_INTEGER, iRT, 1, & MPI_COMM_WORLD, mstatus, ierr) DO i = 1, nmax na(i) = n(i - 1) + n(i) + n(i + 1) END DO PRINT *, 'rank[', irank, '] : ', (na(i), i = 1, nmax) IF (irank == 0) PAUSE CALL MPI_FINALIZE(ierr) STOP END PROGRAM mpi_3
- 例題 4-3a
PROGRAM test USE mpi IMPLICIT NONE INTEGER :: mstatus(MPI_STATUS_SIZE) INTEGER :: n(12) = 0 INTEGER :: i, isize, irank, ierr, inewvec CALL MPI_INIT(ierr) CALL MPI_COMM_RANK(MPI_COMM_WORLD, irank, ierr) CALL MPI_COMM_SIZE(MPI_COMM_WORLD, isize, ierr) IF (irank == 0) n = [ (i, i = 1, 12) ] CALL MPI_TYPE_VECTOR(3, 2, 3, MPI_INTEGER, inewvec, ierr) CALL MPI_TYPE_COMMIT(inewvec, ierr) SELECT CASE(irank) CASE(0) CALL MPI_SEND(n(1), 1, inewvec, 1, 1, MPI_COMM_WORLD, ierr) CASE(1) CALL MPI_RECV(n(2), 1, inewvec, 0, 1, MPI_COMM_WORLD, mstatus, ierr) CASE DEFAULT STOP 'error' END SELECT PRINT '(a, i2, 2x, 12i3)', 'rank:', irank, n(:) CALL MPI_TYPE_FREE(inewvec, ierr) IF (irank == 0) PAUSE CALL MPI_FINALIZE(ierr) STOP !------------------------------------ END PROGRAM test
- 例題 4-3b
PROGRAM mpi4 USE mpi IMPLICIT NONE INTEGER, PARAMETER :: imax = 8, jmax = 8 INTEGER :: mstatus(MPI_STATUS_SIZE) INTEGER :: i, j, ilen, jlen, n(imax, jmax) = 0 INTEGER :: isize, irank, ierr, isubmtx CALL MPI_INIT(ierr) CALL MPI_COMM_RANK(MPI_COMM_WORLD, irank, ierr) CALL MPI_COMM_SIZE(MPI_COMM_WORLD, isize, ierr) IF (irank == 0) THEN DO i = 1, imax DO j = 1, jmax n(i, j) = 100 * i + j END DO END DO END IF ilen = 4 jlen = 4 CALL MPI_TYPE_VECTOR(jlen, ilen, imax, MPI_INTEGER, isubmtx, ierr) CALL MPI_TYPE_COMMIT(isubmtx, ierr) SELECT CASE(irank) CASE(0) CALL MPI_SEND(n(1, 5), 1, isubmtx, 1, 1, MPI_COMM_WORLD, ierr) CASE(1) CALL MPI_RECV(n(5, 1), 1, isubmtx, 0, 1, MPI_COMM_WORLD, mstatus, ierr) CASE DEFAULT STOP 'error' END SELECT PRINT '(a, i2)', 'rank:', irank PRINT '(8i4)', ((n(i, j), j = 1, 8), i = 1, 8) CALL MPI_TYPE_FREE(isubmtx, ierr) IF (irank == 0) PAUSE CALL MPI_FINALIZE(ierr) STOP END PROGRAM mpi4
- 4-4
PROGRAM mpi4 USE mpi IMPLICIT NONE INTEGER, PARAMETER :: mmax = 16, nmax = 16, mm = mmax / 4 INTEGER :: mstatus(MPI_STATUS_SIZE) INTEGER :: i, j, ilen, jlen, n(0:mm + 1, 0:nmax + 1), m(0:mm + 1, 0:nmax + 1) INTEGER :: iup, idw, isize, irank, ierr, inewvec CALL MPI_INIT(ierr) CALL MPI_COMM_RANK(MPI_COMM_WORLD, irank, ierr) CALL MPI_COMM_SIZE(MPI_COMM_WORLD, isize, ierr) DO i = 1, nmax DO j = 1, mm n(j, i) = i + 100 * j !+ 1000 * irank END DO END DO CALL MPI_TYPE_VECTOR(nmax, 1, mm + 2, MPI_INTEGER, inewvec, ierr) CALL MPI_TYPE_COMMIT(inewvec, ierr) iup = irank - 1 IF (irank == 0) iup = 3 idw = irank + 1 IF (irank == isize - 1) idw = 0 CALL MPI_SENDRECV(n(mm, 1), 1, inewvec, idw, 1, n(0 , 1), 1, inewvec, iup, 1, MPI_COMM_WORLD, mstatus, ierr) CALL MPI_SENDRECV(n( 1, 1), 1, inewvec, iup, 1, n(mm + 1, 1), 1, inewvec, idw, 1, MPI_COMM_WORLD, mstatus, ierr) DO i = 1, mm n(i, 0 ) = n(i, nmax) n(i, nmax + 1) = n(i, i) END DO DO j = 1, nmax DO i = 1, mm m(i, j) = n(i - 1, j) + n(i, j - 1) + n(i, j + 1) + n(i + 1, j) END DO END DO IF (irank == 2) THEN PRINT '(a, i2)', 'irank:', irank PRINT '(18i5)' , ((m(i, j), j = 0, nmax + 1), i = 0, mm + 1) END IF CALL MPI_TYPE_FREE(inewvec, ierr) IF (irank == 0) PAUSE CALL MPI_FINALIZE(ierr) STOP !------------------------------------ END PROGRAM mpi4
PROGRAM mpi4 USE mpi IMPLICIT NONE LOGICAL :: period(2) INTEGER :: idivid(2), iud(2), ilr(2), idisp(2), narg, nainfo(3) INTEGER :: i, isize, irank, ierr, iptbl CHARACTER(16) :: argv CALL MPI_INIT(ierr) CALL MPI_COMM_RANK(MPI_COMM_WORLD, irank, ierr) CALL MPI_COMM_SIZE(MPI_COMM_WORLD, isize, ierr) narg = COMMAND_ARGUMENT_COUNT() IF (narg == 3) THEN DO i = 1, narg CALL GET_COMMAND_ARGUMENT(i, argv) READ(argv, '(i)') nainfo(i) END DO ELSE PRINT *, 'input error: COMMAND rank i j' STOP END IF idivid(1) = 4 idivid(2) = 4 period(1) = .FALSE. period(2) = .FALSE. CALL MPI_CART_CREATE(MPI_COMM_WORLD, 2, idivid, period, .FALSE., iptbl, ierr) idisp(1) = nainfo(2) idisp(2) = nainfo(3) CALL MPI_CART_SHIFT(iptbl, 0, idisp(1), iud(1), iud(2), ierr) CALL MPI_CART_SHIFT(iptbl, 1, idisp(2), ilr(1), ilr(2), ierr) IF ( irank == nainfo(1) ) THEN PRINT '(3x, i3)', iud(1) PRINT '(3i3)', ilr(1), irank, ilr(2) PRINT '(3x, i3)', iud(2) END IF CALL MPI_COMM_FREE(iptbl, ierr) IF (irank == 0) PAUSE CALL MPI_FINALIZE(ierr) STOP END PROGRAM mpi4
PROGRAM mpi4 USE mpi IMPLICIT NONE INTEGER, PARAMETER :: mdiv = 3, ndiv = 4 INTEGER, PARAMETER :: mm = 12, nn = 16 INTEGER, PARAMETER :: mmax = mm / 3, nmax = nn / 4 LOGICAL :: period(2) INTEGER :: mstatus(MPI_STATUS_SIZE) INTEGER :: idivid(2), iup, idw, ilf, irt INTEGER :: ia(0:mmax + 1, 0:nmax + 1), ib(0:mmax + 1, 0:nmax + 1) INTEGER :: i, j, isize, irank, ierr, inewvec, iptbl CALL MPI_INIT(ierr) CALL MPI_COMM_RANK(MPI_COMM_WORLD, irank, ierr) CALL MPI_COMM_SIZE(MPI_COMM_WORLD, isize, ierr) idivid(1) = mdiv idivid(2) = ndiv period(1) = .TRUE. period(2) = .TRUE. CALL MPI_CART_CREATE(MPI_COMM_WORLD, 2, idivid, period, .FALSE., iptbl, ierr) CALL MPI_CART_SHIFT(iptbl, 0, 1, iup, idw, ierr) CALL MPI_CART_SHIFT(iptbl, 1, 1, ilf, irt, ierr) CALL MPI_TYPE_VECTOR(nmax, 1, nmax + 2, MPI_INTEGER, inewvec, ierr) CALL MPI_TYPE_COMMIT(inewvec, ierr) DO j = 1, nmax DO i = 1, mmax ia(i, j) = i + j * 100 END DO END DO CALL MPI_SENDRECV(ia(nmax, 1), 1, inewvec, idw, 1, ia(0 , 1), 1, inewvec, iup, 1, MPI_COMM_WORLD, mstatus, ierr) CALL MPI_SENDRECV(ia( 1, 1), 1, inewvec, iup, 1, ia(nmax + 1, 1), 1, inewvec, idw, 1, MPI_COMM_WORLD, mstatus, ierr) CALL MPI_SENDRECV(ia( 1, nmax), mmax, MPI_INTEGER, irt, 1, ia(1 , 0), mmax, MPI_INTEGER, ilf, 1, MPI_COMM_WORLD, mstatus, ierr) CALL MPI_SENDRECV(ia( 1, 1), mmax, MPI_INTEGER, ilf, 1, ia(1, nmax + 1), mmax, MPI_INTEGER, irt, 1, MPI_COMM_WORLD, mstatus, ierr) DO j = 1, nmax DO i = 1, mmax ib(i, j) = ia(i - 1, j) + ia(i, j - 1) + ia(i, j + 1) + ia(i + 1, j) END DO END DO !IF ( irank == 0 ) THEN ! PRINT '(6i4)', TRANSPOSE(ia) !END IF IF ( irank == 0 ) THEN PRINT '(6i4)', TRANSPOSE(ib) END IF CALL MPI_COMM_FREE(iptbl, ierr) CALL MPI_TYPE_FREE(inewvec, ierr) IF (irank == 0) PAUSE CALL MPI_FINALIZE(ierr) STOP END PROGRAM mpi4