>>>>> On Tue, 9 Jan 2007 00:24:38 -0500 (EST),
>>>>> Alexander Shirokov <[EMAIL PROTECTED]> said:
> Hi Mario,
> thanks for your reply!
> It looks like I will probbaly have to try
> to do it on my own. I would be interested to see
> an example on how you wrapped an MPI_Bcast function
> and MPI_Send, Receive. Would it be difficult for you
> to show me an example?, - would be very nice to have one
> since i am a beginner in guile, and i will let you know
> how it goes. Thank you.
> Alex
Below is the basic wrapper (in C++). Note the call to MPI_Init() in
the main(). Also below is a simple Guile script using point to point
communication. For compiling it I used a target like this
mpiguile: mpiguile.o
gcc -g -o $@ $< `guile-config link` $(LDFLAGS)
Of course LDFLAGS should contain the mpi libraries. (Sorry I can't send
you more material right now, because I'm on vacation accessing my
office desktop from a cyber-caffe on the beach :-) ) Mario
===== MPIGUILE.CPP =========================================
#include <cassert>
#include <cstdio>
#include <cmath>
#include <libguile.h>
#if 0
#include "vector.h"
#include <petsc.h>
#include "./petscscm.h"
#include "./dvector.h"
#endif
#include <mpi.h>
#define N 5
typedef SCM(*scm_fun)();
//---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:
#undef __FUN__
#define __FUN__ "mpi-send"
static SCM
mpi_send(SCM s_val,SCM s_dest) {
SCM_ASSERT(scm_number_p(s_val),s_val,SCM_ARG1,__FUN__);
double val = scm_num2double(s_val,0,__FUN__);
double tval = round(val);
SCM_ASSERT(SCM_INUMP(s_dest),
s_dest,SCM_ARG2,__FUN__);
int dest = SCM_INUM(s_dest);
printf("mpi_send: sending %lg, error %lg\n",val,val-tval);
double v[N];
for (int j=0; j<N; j++) v[j] = val;
printf("mpi_send: sending %lg, error %lg\n",v[0],v[0]-tval);
MPI_Send(v,N,MPI_DOUBLE,dest,0,MPI_COMM_WORLD);
return SCM_UNSPECIFIED;
}
//---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:
#undef __FUN__
#define __FUN__ "mpi-recv"
static SCM
mpi_recv(SCM s_source) {
SCM_ASSERT(SCM_INUMP(s_source),
s_source,SCM_ARG1,__FUN__);
int source = SCM_INUM(s_source);
double v[N];
#if 0
for (int j=0; j<N; j++)
v[j] = 0.1234567890123456789;
for (int j=0; j<N; j++)
printf("%g ",v[j]);
printf(" xxx \n");
#endif
MPI_Status status;
MPI_Recv(v,N,MPI_DOUBLE,source,0,
MPI_COMM_WORLD,&status);
double val = v[0];
double tval = round(val);
printf("mpi_recv error: received ");
for (int j=0; j<N; j++)
printf("%g ",v[j]-tval);
printf("\n");
#if 0
for (int j=1; j<N; j++)
assert(v[j]==val);
#endif
return scm_make_real(val);
}
//---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:
#undef __FUN__
#define __FUN__ "mpi-rank"
static SCM
mpi_rank() {
int myrank;
MPI_Comm_rank(MPI_COMM_WORLD,&myrank);
return SCM_MAKINUM(myrank);
}
//---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:
#undef __FUN__
#define __FUN__ "mpi-size"
static SCM
mpi_size() {
int size;
MPI_Comm_size(MPI_COMM_WORLD,&size);
return SCM_MAKINUM(size);
}
//---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:
#undef __FUN__
#define __FUN__ "mpi-finalize"
static SCM
mpi_finalize() {
MPI_Finalize();
return SCM_UNSPECIFIED;
}
//---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:
extern "C" void
init_mpi (void) {
scm_c_define_gsubr("mpi-send",2,0,0,scm_fun(mpi_send));
scm_c_define_gsubr("mpi-recv",1,0,0,scm_fun(mpi_recv));
scm_c_define_gsubr("mpi-rank",0,0,0,scm_fun(mpi_rank));
scm_c_define_gsubr("mpi-size",0,0,0,scm_fun(mpi_size));
scm_c_define_gsubr("mpi-finalize",0,0,0,scm_fun(mpi_finalize));
}
//---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:
static void
inner_main (void *closure, int argc, char **argv) {
init_mpi();
scm_shell(argc, argv);
MPI_Finalize();
}
//---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:
int main (int argc, char **argv) {
MPI_Init(&argc,&argv);
scm_boot_guile (argc, argv, inner_main, 0);
return 0; // never reached
}
===== TRYMPI.SCM =========================================
(define my-rank (mpi-rank))
(define size (mpi-size))
(format #t "myrank ~A, size ~A\n" my-rank size)
(define val #f)
#!
(do ((j 0 (+ j 2))) ((= j 20))
(cond ((= my-rank 0)
(mpi-send j 1)
(set! val (mpi-recv 1)))
(#t
(set! val (mpi-recv 0))
(mpi-send (+ j 1) 0)))
(format #t "[~A] received ~A\n" my-rank val))
!#
(do ((j 0 (+ j 1))) ((= j 20))
(cond ((= my-rank 1)
(mpi-send 23 0))
(#t
(set! val (mpi-recv 1))
(format #t "in guile: received ~A\n" val))))
(mpi-finalize)
_______________________________________________
Guile-user mailing list
Guile-user@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-user
