Actual source code: mpi.c

petsc-3.13.1 2020-05-02
Report Typos and Errors
  1: /*
  2:       This provides a few of the MPI-uni functions that cannot be implemented
  3:     with C macros
  4: */
  5:  #include <petscsys.h>
  6: #if !defined(MPIUNI_H)
  7: #error "Wrong mpi.h included! require mpi.h from MPIUNI"
  8: #endif

 10: #define MPI_SUCCESS 0
 11: #define MPI_FAILURE 1

 13: void *MPIUNI_TMP = NULL;

 15: /*
 16:        With MPI Uni there are exactly four distinct communicators:
 17:     MPI_COMM_SELF, MPI_COMM_WORLD, and a MPI_Comm_dup() of each of these (duplicates of duplicates return the same communictor)

 19:     MPI_COMM_SELF and MPI_COMM_WORLD are MPI_Comm_free() in MPI_Finalize() but in general with PETSc,
 20:      the other communicators are freed once the last PETSc object is freed (before MPI_Finalize()).

 22: */
 23: #define MAX_ATTR 256
 24: #define MAX_COMM 128

 26: static int MaxComm = 2;

 28: typedef struct {
 29:   void *attribute_val;
 30:   int  active;
 31: } MPI_Attr;

 33: typedef struct {
 34:   void                *extra_state;
 35:   MPI_Delete_function *del;
 36: } MPI_Attr_keyval;

 38: static MPI_Attr_keyval attr_keyval[MAX_ATTR];
 39: static MPI_Attr        attr[MAX_COMM][MAX_ATTR];
 40: static int             comm_active[MAX_COMM];
 41: static int             num_attr = 1,mpi_tag_ub = 100000000;
 42: static void*           MPIUNIF_mpi_in_place = 0;

 44: #if defined(__cplusplus)
 45: extern "C" {
 46: #endif

 48: /*
 49:    To avoid problems with prototypes to the system memcpy() it is duplicated here
 50: */
 51: int MPIUNI_Memcpy(void *a,const void *b,int n)
 52: {
 53:   int  i;
 54:   char *aa= (char*)a;
 55:   char *bb= (char*)b;

 57:   if (a == MPI_IN_PLACE || a == MPIUNIF_mpi_in_place) return MPI_SUCCESS;
 58:   if (b == MPI_IN_PLACE || b == MPIUNIF_mpi_in_place) return MPI_SUCCESS;
 59:   for (i=0; i<n; i++) aa[i] = bb[i];
 60:   return MPI_SUCCESS;
 61: }

 63: static int classcnt = 0;
 64: static int codecnt = 0;

 66: int MPI_Add_error_class(int *cl)
 67: {
 68:   *cl = classcnt++;
 69:   return MPI_SUCCESS;
 70: }

 72: int MPI_Add_error_code(int cl,int *co)
 73: {
 74:   if (cl >= classcnt) return MPI_FAILURE;
 75:   *co = codecnt++;
 76:   return MPI_SUCCESS;
 77: }

 79: int MPI_Type_get_envelope(MPI_Datatype datatype,int *num_integers,int *num_addresses,int *num_datatypes,int *combiner)
 80: {
 81:   int comb = datatype >> 28;
 82:   switch (comb) {
 83:   case MPI_COMBINER_NAMED:
 84:     *num_integers = 0;
 85:     *num_addresses = 0;
 86:     *num_datatypes = 0;
 87:     *combiner = comb;
 88:     break;
 89:   case MPI_COMBINER_DUP:
 90:     *num_integers = 0;
 91:     *num_addresses = 0;
 92:     *num_datatypes = 1;
 93:     *combiner = comb;
 94:     break;
 95:   case MPI_COMBINER_CONTIGUOUS:
 96:     *num_integers = 1;
 97:     *num_addresses = 0;
 98:     *num_datatypes = 1;
 99:     *combiner = comb;
100:     break;
101:   default:
102:     return MPIUni_Abort(MPI_COMM_SELF,1);
103:   }
104:   return MPI_SUCCESS;
105: }

107: int MPI_Type_get_contents(MPI_Datatype datatype,int max_integers,int max_addresses,int max_datatypes,int *array_of_integers,MPI_Aint *array_of_addresses,MPI_Datatype *array_of_datatypes)
108: {
109:   int comb = datatype >> 28;
110:   switch (comb) {
111:   case MPI_COMBINER_NAMED:
112:     return MPIUni_Abort(MPI_COMM_SELF,1);
113:     break;
114:   case MPI_COMBINER_DUP:
115:     if (max_datatypes < 1) return MPIUni_Abort(MPI_COMM_SELF,1);
116:     array_of_datatypes[0] = datatype & 0x0fffffff;
117:     break;
118:   case MPI_COMBINER_CONTIGUOUS:
119:     if (max_integers < 1 || max_datatypes < 1) return MPIUni_Abort(MPI_COMM_SELF,1);
120:     array_of_integers[0] = (datatype >> 8) & 0xfff; /* count */
121:     array_of_datatypes[0] = (datatype & 0x0ff000ff) | 0x100;  /* basic named type (count=1) from which the contiguous type is derived */
122:     break;
123:   default:
124:     return MPIUni_Abort(MPI_COMM_SELF,1);
125:   }
126:   return MPI_SUCCESS;
127: }

129: /*
130:    Used to set the built-in MPI_TAG_UB attribute
131: */
132: static int Keyval_setup(void)
133: {
134:   attr[MPI_COMM_WORLD-1][0].active        = 1;
135:   attr[MPI_COMM_WORLD-1][0].attribute_val = &mpi_tag_ub;
136:   attr[MPI_COMM_SELF-1][0].active         = 1;
137:   attr[MPI_COMM_SELF-1][0].attribute_val  = &mpi_tag_ub;
138:   return MPI_SUCCESS;
139: }

141: int MPI_Comm_create_keyval(MPI_Copy_function *copy_fn,MPI_Delete_function *delete_fn,int *keyval,void *extra_state)
142: {
143:   if (num_attr >= MAX_ATTR) return MPIUni_Abort(MPI_COMM_WORLD,1);

145:   attr_keyval[num_attr].extra_state = extra_state;
146:   attr_keyval[num_attr].del         = delete_fn;
147:   *keyval                           = num_attr++;
148:   return MPI_SUCCESS;
149: }

151: int MPI_Comm_free_keyval(int *keyval)
152: {
153:   attr_keyval[*keyval].extra_state = 0;
154:   attr_keyval[*keyval].del         = 0;

156:   *keyval = 0;
157:   return MPI_SUCCESS;
158: }

160: int MPI_Comm_set_attr(MPI_Comm comm,int keyval,void *attribute_val)
161: {
162:   if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE;
163:   attr[comm-1][keyval].active        = 1;
164:   attr[comm-1][keyval].attribute_val = attribute_val;
165:   return MPI_SUCCESS;
166: }

168: int MPI_Comm_delete_attr(MPI_Comm comm,int keyval)
169: {
170:   if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE;
171:   if (attr[comm-1][keyval].active && attr_keyval[keyval].del) {
172:     void *save_attribute_val = attr[comm-1][keyval].attribute_val;
173:     attr[comm-1][keyval].active        = 0;
174:     attr[comm-1][keyval].attribute_val = 0;
175:     (*(attr_keyval[keyval].del))(comm,keyval,save_attribute_val,attr_keyval[keyval].extra_state);
176:   }
177:   return MPI_SUCCESS;
178: }

180: int MPI_Comm_get_attr(MPI_Comm comm,int keyval,void *attribute_val,int *flag)
181: {
182:   if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE;
183:   if (!keyval) Keyval_setup();
184:   *flag                  = attr[comm-1][keyval].active;
185:   *(void**)attribute_val = attr[comm-1][keyval].attribute_val;
186:   return MPI_SUCCESS;
187: }

189: int MPI_Comm_create(MPI_Comm comm,MPI_Group group,MPI_Comm *newcomm)
190: {
191:   int j;
192:   if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE;
193:   for (j=3; j<MaxComm; j++) {
194:     if (!comm_active[j-1]) {
195:       comm_active[j-1] = 1;
196:       *newcomm = j;
197:       return MPI_SUCCESS;
198:     }
199:   }
200:   if (MaxComm > MAX_COMM) return MPI_FAILURE;
201:   *newcomm =  MaxComm++;
202:   comm_active[*newcomm-1] = 1;
203:   return MPI_SUCCESS;
204: }

206: int MPI_Comm_dup(MPI_Comm comm,MPI_Comm *out)
207: {
208:   int j;
209:   if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE;
210:   for (j=3; j<MaxComm; j++) {
211:     if (!comm_active[j-1]) {
212:       comm_active[j-1] = 1;
213:       *out = j;
214:       return MPI_SUCCESS;
215:     }
216:   }
217:   if (MaxComm > MAX_COMM) return MPI_FAILURE;
218:   *out = MaxComm++;
219:   comm_active[*out-1] = 1;
220:   return MPI_SUCCESS;
221: }

223: int MPI_Comm_free(MPI_Comm *comm)
224: {
225:   int i;

227:   if (*comm-1 < 0 || *comm-1 > MaxComm) return MPI_FAILURE;
228:   for (i=0; i<num_attr; i++) {
229:     if (attr[*comm-1][i].active && attr_keyval[i].del) (*attr_keyval[i].del)(*comm,i,attr[*comm-1][i].attribute_val,attr_keyval[i].extra_state);
230:     attr[*comm-1][i].active        = 0;
231:     attr[*comm-1][i].attribute_val = 0;
232:   }
233:   if (*comm >= 3) comm_active[*comm-1] = 0;
234:   *comm = 0;
235:   return MPI_SUCCESS;
236: }

238: int MPI_Comm_size(MPI_Comm comm, int *size)
239: {
240:   if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE;
241:   *size=1;
242:   return MPI_SUCCESS;
243: }

245: int MPI_Comm_rank(MPI_Comm comm, int *rank)
246: {
247:   if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE;
248:   *rank=0;
249:   return MPI_SUCCESS;
250: }

252: int MPIUni_Abort(MPI_Comm comm,int errorcode)
253: {
254:   printf("MPI operation not supported by PETSc's sequential MPI wrappers\n");
255:   return MPI_FAILURE;
256: }

258: int MPI_Abort(MPI_Comm comm,int errorcode)
259: {
260:   abort();
261:   return MPI_SUCCESS;
262: }

264: /* --------------------------------------------------------------------------*/

266: static int MPI_was_initialized = 0;
267: static int MPI_was_finalized   = 0;

269: int MPI_Init(int *argc, char ***argv)
270: {
271:   if (MPI_was_initialized) return MPI_FAILURE;
272:   if (MPI_was_finalized) return MPI_FAILURE;
273:   MPI_was_initialized = 1;
274:   return MPI_SUCCESS;
275: }

277: int MPI_Finalize(void)
278: {
279:   MPI_Comm comm;
280:   if (MPI_was_finalized) return MPI_FAILURE;
281:   if (!MPI_was_initialized) return MPI_FAILURE;
282:   comm = MPI_COMM_WORLD;
283:   MPI_Comm_free(&comm);
284:   comm = MPI_COMM_SELF;
285:   MPI_Comm_free(&comm);
286:   MPI_was_finalized = 1;
287:   return MPI_SUCCESS;
288: }

290: int MPI_Initialized(int *flag)
291: {
292:   *flag = MPI_was_initialized;
293:   return MPI_SUCCESS;
294: }

296: int MPI_Finalized(int *flag)
297: {
298:   *flag = MPI_was_finalized;
299:   return MPI_SUCCESS;
300: }

302: /* -------------------     Fortran versions of several routines ------------------ */

304: #if defined(PETSC_HAVE_FORTRAN_CAPS)
305: #define mpiunisetmoduleblock_          MPIUNISETMODULEBLOCK
306: #define mpiunisetfortranbasepointers_  MPIUNISETFORTRANBASEPOINTERS
307: #define petsc_mpi_init_                PETSC_MPI_INIT
308: #define petsc_mpi_finalize_            PETSC_MPI_FINALIZE
309: #define petsc_mpi_comm_size_           PETSC_MPI_COMM_SIZE
310: #define petsc_mpi_comm_rank_           PETSC_MPI_COMM_RANK
311: #define petsc_mpi_abort_               PETSC_MPI_ABORT
312: #define petsc_mpi_reduce_              PETSC_MPI_REDUCE
313: #define petsc_mpi_allreduce_           PETSC_MPI_ALLREDUCE
314: #define petsc_mpi_barrier_             PETSC_MPI_BARRIER
315: #define petsc_mpi_bcast_               PETSC_MPI_BCAST
316: #define petsc_mpi_gather_              PETSC_MPI_GATHER
317: #define petsc_mpi_allgather_           PETSC_MPI_ALLGATHER
318: #define petsc_mpi_comm_split_          PETSC_MPI_COMM_SPLIT
319: #define petsc_mpi_scan_                PETSC_MPI_SCAN
320: #define petsc_mpi_send_                PETSC_MPI_SEND
321: #define petsc_mpi_recv_                PETSC_MPI_RECV
322: #define petsc_mpi_reduce_scatter_      PETSC_MPI_REDUCE_SCATTER
323: #define petsc_mpi_irecv_               PETSC_MPI_IRECV
324: #define petsc_mpi_isend_               PETSC_MPI_ISEND
325: #define petsc_mpi_sendrecv_            PETSC_MPI_SENDRECV
326: #define petsc_mpi_test_                PETSC_MPI_TEST
327: #define petsc_mpi_waitall_             PETSC_MPI_WAITALL
328: #define petsc_mpi_waitany_             PETSC_MPI_WAITANY
329: #define petsc_mpi_allgatherv_          PETSC_MPI_ALLGATHERV
330: #define petsc_mpi_alltoallv_           PETSC_MPI_ALLTOALLV
331: #define petsc_mpi_comm_create_         PETSC_MPI_COMM_CREATE
332: #define petsc_mpi_address_             PETSC_MPI_ADDRESS
333: #define petsc_mpi_pack_                PETSC_MPI_PACK
334: #define petsc_mpi_unpack_              PETSC_MPI_UNPACK
335: #define petsc_mpi_pack_size_           PETSC_MPI_PACK_SIZE
336: #define petsc_mpi_type_struct_         PETSC_MPI_TYPE_STRUCT
337: #define petsc_mpi_type_commit_         PETSC_MPI_TYPE_COMMIT
338: #define petsc_mpi_wtime_               PETSC_MPI_WTIME
339: #define petsc_mpi_cancel_              PETSC_MPI_CANCEL
340: #define petsc_mpi_comm_dup_            PETSC_MPI_COMM_DUP
341: #define petsc_mpi_comm_free_           PETSC_MPI_COMM_FREE
342: #define petsc_mpi_get_count_           PETSC_MPI_GET_COUNT
343: #define petsc_mpi_get_processor_name_  PETSC_MPI_GET_PROCESSOR_NAME
344: #define petsc_mpi_initialized_         PETSC_MPI_INITIALIZED
345: #define petsc_mpi_iprobe_              PETSC_MPI_IPROBE
346: #define petsc_mpi_probe_               PETSC_MPI_PROBE
347: #define petsc_mpi_request_free_        PETSC_MPI_REQUEST_FREE
348: #define petsc_mpi_ssend_               PETSC_MPI_SSEND
349: #define petsc_mpi_wait_                PETSC_MPI_WAIT
350: #define petsc_mpi_comm_group_          PETSC_MPI_COMM_GROUP
351: #define petsc_mpi_exscan_              PETSC_MPI_EXSCAN
352: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
353: #define mpiunisetmoduleblock_          mpiunisetmoduleblock
354: #define mpiunisetfortranbasepointers_  mpiunisetfortranbasepointers
355: #define petsc_mpi_init_                petsc_mpi_init
356: #define petsc_mpi_finalize_            petsc_mpi_finalize
357: #define petsc_mpi_comm_size_           petsc_mpi_comm_size
358: #define petsc_mpi_comm_rank_           petsc_mpi_comm_rank
359: #define petsc_mpi_abort_               petsc_mpi_abort
360: #define petsc_mpi_reduce_              petsc_mpi_reduce
361: #define petsc_mpi_allreduce_           petsc_mpi_allreduce
362: #define petsc_mpi_barrier_             petsc_mpi_barrier
363: #define petsc_mpi_bcast_               petsc_mpi_bcast
364: #define petsc_mpi_gather_              petsc_mpi_gather
365: #define petsc_mpi_allgather_           petsc_mpi_allgather
366: #define petsc_mpi_comm_split_          petsc_mpi_comm_split
367: #define petsc_mpi_scan_                petsc_mpi_scan
368: #define petsc_mpi_send_                petsc_mpi_send
369: #define petsc_mpi_recv_                petsc_mpi_recv
370: #define petsc_mpi_reduce_scatter_      petsc_mpi_reduce_scatter
371: #define petsc_mpi_irecv_               petsc_mpi_irecv
372: #define petsc_mpi_isend_               petsc_mpi_isend
373: #define petsc_mpi_sendrecv_            petsc_mpi_sendrecv
374: #define petsc_mpi_test_                petsc_mpi_test
375: #define petsc_mpi_waitall_             petsc_mpi_waitall
376: #define petsc_mpi_waitany_             petsc_mpi_waitany
377: #define petsc_mpi_allgatherv_          petsc_mpi_allgatherv
378: #define petsc_mpi_alltoallv_           petsc_mpi_alltoallv
379: #define petsc_mpi_comm_create_         petsc_mpi_comm_create
380: #define petsc_mpi_address_             petsc_mpi_address
381: #define petsc_mpi_pack_                petsc_mpi_pack
382: #define petsc_mpi_unpack_              petsc_mpi_unpack
383: #define petsc_mpi_pack_size_           petsc_mpi_pack_size
384: #define petsc_mpi_type_struct_         petsc_mpi_type_struct
385: #define petsc_mpi_type_commit_         petsc_mpi_type_commit
386: #define petsc_mpi_wtime_               petsc_mpi_wtime
387: #define petsc_mpi_cancel_              petsc_mpi_cancel
388: #define petsc_mpi_comm_dup_            petsc_mpi_comm_dup
389: #define petsc_mpi_comm_free_           petsc_mpi_comm_free
390: #define petsc_mpi_get_count_           petsc_mpi_get_count
391: #define petsc_mpi_get_processor_name_  petsc_mpi_get_processor_name
392: #define petsc_mpi_initialized_         petsc_mpi_initialized
393: #define petsc_mpi_iprobe_              petsc_mpi_iprobe
394: #define petsc_mpi_probe_               petsc_mpi_probe
395: #define petsc_mpi_request_free_        petsc_mpi_request_free
396: #define petsc_mpi_ssend_               petsc_mpi_ssend
397: #define petsc_mpi_wait_                petsc_mpi_wait
398: #define petsc_mpi_comm_group_          petsc_mpi_comm_group
399: #define petsc_mpi_exscan_              petsc_mpi_exscan
400: #endif

402: #if defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE)
403: #define petsc_mpi_init_                petsc_mpi_init__
404: #define petsc_mpi_finalize_            petsc_mpi_finalize__
405: #define petsc_mpi_comm_size_           petsc_mpi_comm_size__
406: #define petsc_mpi_comm_rank_           petsc_mpi_comm_rank__
407: #define petsc_mpi_abort_               petsc_mpi_abort__
408: #define petsc_mpi_reduce_              petsc_mpi_reduce__
409: #define petsc_mpi_allreduce_           petsc_mpi_allreduce__
410: #define petsc_mpi_barrier_             petsc_mpi_barrier__
411: #define petsc_mpi_bcast_               petsc_mpi_bcast__
412: #define petsc_mpi_gather_              petsc_mpi_gather__
413: #define petsc_mpi_allgather_           petsc_mpi_allgather__
414: #define petsc_mpi_comm_split_          petsc_mpi_comm_split__
415: #define petsc_mpi_scan_                petsc_mpi_scan__
416: #define petsc_mpi_send_                petsc_mpi_send__
417: #define petsc_mpi_recv_                petsc_mpi_recv__
418: #define petsc_mpi_reduce_scatter_      petsc_mpi_reduce_scatter__
419: #define petsc_mpi_irecv_               petsc_mpi_irecv__
420: #define petsc_mpi_isend_               petsc_mpi_isend__
421: #define petsc_mpi_sendrecv_            petsc_mpi_sendrecv__
422: #define petsc_mpi_test_                petsc_mpi_test__
423: #define petsc_mpi_waitall_             petsc_mpi_waitall__
424: #define petsc_mpi_waitany_             petsc_mpi_waitany__
425: #define petsc_mpi_allgatherv_          petsc_mpi_allgatherv__
426: #define petsc_mpi_alltoallv_           petsc_mpi_alltoallv__
427: #define petsc_mpi_comm_create_         petsc_mpi_comm_create__
428: #define petsc_mpi_address_             petsc_mpi_address__
429: #define petsc_mpi_pack_                petsc_mpi_pack__
430: #define petsc_mpi_unpack_              petsc_mpi_unpack__
431: #define petsc_mpi_pack_size_           petsc_mpi_pack_size__
432: #define petsc_mpi_type_struct_         petsc_mpi_type_struct__
433: #define petsc_mpi_type_commit_         petsc_mpi_type_commit__
434: #define petsc_mpi_wtime_               petsc_mpi_wtime__
435: #define petsc_mpi_cancel_              petsc_mpi_cancel__
436: #define petsc_mpi_comm_dup_            petsc_mpi_comm_dup__
437: #define petsc_mpi_comm_free_           petsc_mpi_comm_free__
438: #define petsc_mpi_get_count_           petsc_mpi_get_count__
439: #define petsc_mpi_get_processor_name_  petsc_mpi_get_processor_name__
440: #define petsc_mpi_initialized_         petsc_mpi_initialized__
441: #define petsc_mpi_iprobe_              petsc_mpi_iprobe__
442: #define petsc_mpi_probe_               petsc_mpi_probe__
443: #define petsc_mpi_request_free_        petsc_mpi_request_free__
444: #define petsc_mpi_ssend_               petsc_mpi_ssend__
445: #define petsc_mpi_wait_                petsc_mpi_wait__
446: #define petsc_mpi_comm_group_          petsc_mpi_comm_group__
447: #define petsc_mpi_exscan_              petsc_mpi_exscan__
448: #endif

450: /* Do not build fortran interface if MPI namespace colision is to be avoided */
451: #if defined(PETSC_HAVE_FORTRAN)

453: PETSC_EXTERN void mpiunisetmoduleblock_(void);

455: PETSC_EXTERN void mpiunisetfortranbasepointers_(void *f_mpi_in_place)
456: {
457:   MPIUNIF_mpi_in_place   = f_mpi_in_place;
458: }

460: PETSC_EXTERN void petsc_mpi_init_(int *ierr)
461: {
462:   mpiunisetmoduleblock_();
463:   *MPI_Init((int*)0, (char***)0);
464: }

466: PETSC_EXTERN void petsc_mpi_finalize_(int *ierr)
467: {
468:   *MPI_Finalize();
469: }

471: PETSC_EXTERN void petsc_mpi_comm_size_(MPI_Comm *comm,int *size,int *ierr)
472: {
473:   *size = 1;
474:   *0;
475: }

477: PETSC_EXTERN void petsc_mpi_comm_rank_(MPI_Comm *comm,int *rank,int *ierr)
478: {
479:   *rank = 0;
480:   *MPI_SUCCESS;
481: }

483: PETSC_EXTERN void petsc_mpi_comm_split_(MPI_Comm *comm,int *color,int *key, MPI_Comm *newcomm, int *ierr)
484: {
485:   *newcomm = *comm;
486:   *MPI_SUCCESS;
487: }

489: PETSC_EXTERN void petsc_mpi_abort_(MPI_Comm *comm,int *errorcode,int *ierr)
490: {
491:   abort();
492:   *MPI_SUCCESS;
493: }

495: PETSC_EXTERN void petsc_mpi_reduce_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *root,int *comm,int *ierr)
496: {
497:   *MPI_Reduce(sendbuf,recvbuf,*count,*datatype,*op,*root,*comm);
498: }

500: PETSC_EXTERN void petsc_mpi_allreduce_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
501: {
502:   *MPI_Allreduce(sendbuf,recvbuf,*count,*datatype,*op,*comm);
503: }

505: PETSC_EXTERN void petsc_mpi_barrier_(MPI_Comm *comm,int *ierr)
506: {
507:   *MPI_SUCCESS;
508: }

510: PETSC_EXTERN void petsc_mpi_bcast_(void *buf,int *count,int *datatype,int *root,int *comm,int *ierr)
511: {
512:   *MPI_SUCCESS;
513: }

515: PETSC_EXTERN void petsc_mpi_gather_(void *sendbuf,int *scount,int *sdatatype, void *recvbuf, int *rcount, int *rdatatype, int *root,int *comm,int *ierr)
516: {
517:   *MPI_Gather(sendbuf,*scount,*sdatatype,recvbuf,rcount,rdatatype,*root,*comm);
518: }

520: PETSC_EXTERN void petsc_mpi_allgather_(void *sendbuf,int *scount,int *sdatatype, void *recvbuf, int *rcount, int *rdatatype,int *comm,int *ierr)
521: {
522:   *MPI_Allgather(sendbuf,*scount,*sdatatype,recvbuf,rcount,rdatatype,*comm);
523: }

525: PETSC_EXTERN void petsc_mpi_scan_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
526: {
527:   *MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPI_sizeof(*datatype));
528: }

530: PETSC_EXTERN void petsc_mpi_send_(void *buf,int *count,int *datatype,int *dest,int *tag,int *comm,int *ierr)
531: {
532:   *MPIUni_Abort(MPI_COMM_WORLD,0);
533: }

535: PETSC_EXTERN void petsc_mpi_recv_(void *buf,int *count,int *datatype,int *source,int *tag,int *comm,int status,int *ierr)
536: {
537:   *MPIUni_Abort(MPI_COMM_WORLD,0);
538: }

540: PETSC_EXTERN void petsc_mpi_reduce_scatter_(void *sendbuf,void *recvbuf,int *recvcounts,int *datatype,int *op,int *comm,int *ierr)
541: {
542:   *MPIUni_Abort(MPI_COMM_WORLD,0);
543: }

545: PETSC_EXTERN void petsc_mpi_irecv_(void *buf,int *count, int *datatype, int *source, int *tag, int *comm, int *request, int *ierr)
546: {
547:   *MPIUni_Abort(MPI_COMM_WORLD,0);
548: }

550: PETSC_EXTERN void petsc_mpi_isend_(void *buf,int *count,int *datatype,int *dest,int *tag,int *comm,int *request, int *ierr)
551: {
552:   *MPIUni_Abort(MPI_COMM_WORLD,0);
553: }

555: PETSC_EXTERN void petsc_mpi_sendrecv_(void *sendbuf,int *sendcount,int *sendtype,int *dest,int *sendtag,void *recvbuf,int *recvcount,int *recvtype,int *source,int *recvtag,int *comm,int *status,int *ierr)
556: {
557:   *MPIUNI_Memcpy(recvbuf,sendbuf,(*sendcount)*MPI_sizeof(*sendtype));
558: }

560: PETSC_EXTERN void petsc_mpi_test_(int *request,int *flag,int *status,int *ierr)
561: {
562:   *MPIUni_Abort(MPI_COMM_WORLD,0);
563: }

565: PETSC_EXTERN void petsc_mpi_waitall_(int *count,int *array_of_requests,int *array_of_statuses,int *ierr)
566: {
567:   *MPI_SUCCESS;
568: }

570: PETSC_EXTERN void petsc_mpi_waitany_(int *count,int *array_of_requests,int * index, int *status,int *ierr)
571: {
572:   *MPI_SUCCESS;
573: }

575: PETSC_EXTERN void petsc_mpi_allgatherv_(void *sendbuf,int *sendcount,int *sendtype,void *recvbuf,int *recvcounts,int *displs,int *recvtype,int *comm,int *ierr)
576: {
577:   *MPI_Allgatherv(sendbuf,*sendcount,*sendtype,recvbuf,recvcounts,displs,*recvtype,*comm);
578: }

580: PETSC_EXTERN void petsc_mpi_alltoallv_(void *sendbuf,int *sendcounts,int *sdispls,int *sendtype,void *recvbuf,int *recvcounts,int *rdispls,int *recvtype,int *comm,int *ierr)
581: {
582:   *MPI_Alltoallv(sendbuf,sendcounts,sdispls,*sendtype,recvbuf,recvcounts,rdispls,*recvtype,*comm);
583: }

585: PETSC_EXTERN void petsc_mpi_comm_create_(int *comm,int *group,int *newcomm,int *ierr)
586: {
587:   *newcomm =  *comm;
588:   *MPI_SUCCESS;
589: }

591: PETSC_EXTERN void petsc_mpi_address_(void *location,MPI_Aint *address,int *ierr)
592: {
593:   *address =  (MPI_Aint) ((char *)location);
594:   *MPI_SUCCESS;
595: }

597: PETSC_EXTERN void petsc_mpi_pack_(void *inbuf,int *incount,int *datatype,void *outbuf,int *outsize,int *position,int *comm,int *ierr)
598: {
599:   *MPIUni_Abort(MPI_COMM_WORLD,0);
600: }

602: PETSC_EXTERN void petsc_mpi_unpack_(void *inbuf,int *insize,int *position,void *outbuf,int *outcount,int *datatype,int *comm,int *ierr)
603: {
604:   *MPIUni_Abort(MPI_COMM_WORLD,0);
605: }

607: PETSC_EXTERN void petsc_mpi_pack_size_(int *incount,int *datatype,int *comm,int *size,int *ierr)
608: {
609:   *MPIUni_Abort(MPI_COMM_WORLD,0);
610: }

612: PETSC_EXTERN void petsc_mpi_type_struct_(int *count,int *array_of_blocklengths,int * array_of_displaments,int *array_of_types,int *newtype,int *ierr)
613: {
614:   *MPIUni_Abort(MPI_COMM_WORLD,0);
615: }

617: PETSC_EXTERN void petsc_mpi_type_commit_(int *datatype,int *ierr)
618: {
619:   *MPI_SUCCESS;
620: }

622: double petsc_mpi_wtime_(void)
623: {
624:   return 0.0;
625: }

627: PETSC_EXTERN void petsc_mpi_cancel_(int *request,int *ierr)
628: {
629:   *MPI_SUCCESS;
630: }

632: PETSC_EXTERN void petsc_mpi_comm_dup_(int *comm,int *out,int *ierr)
633: {
634:   *out  = *comm;
635:   *MPI_SUCCESS;
636: }

638: PETSC_EXTERN void petsc_mpi_comm_free_(int *comm,int *ierr)
639: {
640:   *MPI_SUCCESS;
641: }

643: PETSC_EXTERN void petsc_mpi_get_count_(int *status,int *datatype,int *count,int *ierr)
644: {
645:   *MPIUni_Abort(MPI_COMM_WORLD,0);
646: }

648: PETSC_EXTERN void petsc_mpi_get_processor_name_(char *name,int *result_len,int *ierr,PETSC_FORTRAN_CHARLEN_T len)
649: {
650:   MPIUNI_Memcpy(name,"localhost",9*sizeof(char));
651:   *result_len = 9;
652:   *MPI_SUCCESS;
653: }

655: PETSC_EXTERN void petsc_mpi_initialized_(int *flag,int *ierr)
656: {
657:   *flag = MPI_was_initialized;
658:   *MPI_SUCCESS;
659: }

661: PETSC_EXTERN void petsc_mpi_iprobe_(int *source,int *tag,int *comm,int *glag,int *status,int *ierr)
662: {
663:   *MPI_SUCCESS;
664: }

666: PETSC_EXTERN void petsc_mpi_probe_(int *source,int *tag,int *comm,int *flag,int *status,int *ierr)
667: {
668:   *MPI_SUCCESS;
669: }

671: PETSC_EXTERN void petsc_mpi_request_free_(int *request,int *ierr)
672: {
673:   *MPI_SUCCESS;
674: }

676: PETSC_EXTERN void petsc_mpi_ssend_(void *buf,int *count,int *datatype,int *dest,int *tag,int *comm,int *ierr)
677: {
678:   *MPIUni_Abort(MPI_COMM_WORLD,0);
679: }

681: PETSC_EXTERN void petsc_mpi_wait_(int *request,int *status,int *ierr)
682: {
683:   *MPI_SUCCESS;
684: }

686: PETSC_EXTERN void petsc_mpi_comm_group_(int *comm,int *group,int *ierr)
687: {
688:   *MPI_SUCCESS;
689: }

691: PETSC_EXTERN void petsc_mpi_exscan_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
692: {
693:   *MPI_SUCCESS;
694: }

696: #endif /* PETSC_HAVE_FORTRAN */

698: #if defined(__cplusplus)
699: }
700: #endif