Charm++: Charm Source Code Documentation

00001 /* -*- Mode: C; c-basic-offset:4 ; -*- */
00002 /* 
00003  *   $Id$    
00004  *
00005  *   Copyright (C) 1997 University of Chicago. 
00006  *   See COPYRIGHT notice in top-level directory.
00007  */
00008 
00009 #include "mpioimpl.h"
00010 
00011 #ifdef HAVE_WEAK_SYMBOLS
00012 
00013 #if defined(HAVE_PRAGMA_WEAK)
00014 #pragma weak MPI_Type_create_darray = PMPI_Type_create_darray
00015 #elif defined(HAVE_PRAGMA_HP_SEC_DEF)
00016 #pragma _HP_SECONDARY_DEF PMPI_Type_create_darray MPI_Type_create_darray
00017 #elif defined(HAVE_PRAGMA_CRI_DUP)
00018 #pragma _CRI duplicate MPI_Type_create_darray as PMPI_Type_create_darray
00019 /* end of weak pragmas */
00020 #endif
00021 
00022 /* Include mapping from MPI->PMPI */
00023 #define MPIO_BUILD_PROFILING
00024 #include "mpioprof.h"
00025 #undef MPIO_BUILD_PROFILING
00026 #endif
00027 
00028 void MPIOI_Type_block(int *array_of_gsizes, int dim, int ndims, int nprocs,
00029                       int rank, int darg, int order, MPI_Aint orig_extent,
00030                       MPI_Datatype type_old, MPI_Datatype *type_new,
00031                       MPI_Aint *st_offset);
00032 void MPIOI_Type_cyclic(int *array_of_gsizes, int dim, int ndims, int nprocs,
00033                       int rank, int darg, int order, MPI_Aint orig_extent,
00034                       MPI_Datatype type_old, MPI_Datatype *type_new,
00035                       MPI_Aint *st_offset);
00036 
00037 
00038 /*@
00039 MPI_Type_create_darray - Creates a datatype corresponding to a distributed, multidimensional array
00040 
00041 Input Parameters:
00042 . size - size of process group (positive integer)
00043 . rank - rank in process group (nonnegative integer)
00044 . ndims - number of array dimensions as well as process grid dimensions (positive integer)
00045 . array_of_gsizes - number of elements of type oldtype in each dimension of global array (array of positive integers)
00046 . array_of_distribs - distribution of array in each dimension (array of state)
00047 . array_of_dargs - distribution argument in each dimension (array of positive integers)
00048 . array_of_psizes - size of process grid in each dimension (array of positive integers)
00049 . order - array storage order flag (state)
00050 . oldtype - old datatype (handle)
00051 
00052 Output Parameters:
00053 . newtype - new datatype (handle)
00054 
00055 .N fortran
00056 @*/
00057 int MPI_Type_create_darray(int size, int rank, int ndims, 
00058                            int *array_of_gsizes, int *array_of_distribs, 
00059                            int *array_of_dargs, int *array_of_psizes, 
00060                            int order, MPI_Datatype oldtype, 
00061                            MPI_Datatype *newtype) 
00062 {
00063     MPI_Datatype type_old, type_new, types[3];
00064     int procs, tmp_rank, i, tmp_size, blklens[3], *coords;
00065     MPI_Aint *st_offsets, orig_extent, disps[3], size_with_aint;
00066     MPI_Offset size_with_offset;
00067 
00068     if (size <= 0) {
00069         FPRINTF(stderr, "MPI_Type_create_darray: Invalid size argument\n");
00070         MPI_Abort(MPI_COMM_WORLD, 1);
00071     }
00072     if (rank < 0) {
00073         FPRINTF(stderr, "MPI_Type_create_darray: Invalid rank argument\n");
00074         MPI_Abort(MPI_COMM_WORLD, 1);
00075     }
00076     if (ndims <= 0) {
00077         FPRINTF(stderr, "MPI_Type_create_darray: Invalid ndims argument\n");
00078         MPI_Abort(MPI_COMM_WORLD, 1);
00079     }
00080     if (array_of_gsizes <= (int *) 0) {
00081         FPRINTF(stderr, "MPI_Type_create_darray: array_of_gsizes is an invalid address\n");
00082         MPI_Abort(MPI_COMM_WORLD, 1);
00083     }
00084     if (array_of_distribs <= (int *) 0) {
00085         FPRINTF(stderr, "MPI_Type_create_darray: array_of_distribs is an invalid address\n");
00086         MPI_Abort(MPI_COMM_WORLD, 1);
00087     }
00088     if (array_of_dargs <= (int *) 0) {
00089         FPRINTF(stderr, "MPI_Type_create_darray: array_of_dargs is an invalid address\n");
00090         MPI_Abort(MPI_COMM_WORLD, 1);
00091     }
00092     if (array_of_psizes <= (int *) 0) {
00093         FPRINTF(stderr, "MPI_Type_create_darray: array_of_psizes is an invalid address\n");
00094         MPI_Abort(MPI_COMM_WORLD, 1);
00095     }
00096 
00097     for (i=0; i<ndims; i++) {
00098         if (array_of_gsizes[i] <= 0) {
00099             FPRINTF(stderr, "MPI_Type_create_darray: Invalid value in array_of_gsizes\n");
00100             MPI_Abort(MPI_COMM_WORLD, 1);
00101         }
00102 
00103         /* array_of_distribs checked below */
00104 
00105         if ((array_of_dargs[i] != MPI_DISTRIBUTE_DFLT_DARG) && 
00106                          (array_of_dargs[i] <= 0)) {
00107             FPRINTF(stderr, "MPI_Type_create_darray: Invalid value in array_of_dargs\n");
00108             MPI_Abort(MPI_COMM_WORLD, 1);
00109         }
00110 
00111         if (array_of_psizes[i] <= 0) {
00112             FPRINTF(stderr, "MPI_Type_create_darray: Invalid value in array_of_psizes\n");
00113             MPI_Abort(MPI_COMM_WORLD, 1);
00114         }
00115     }
00116 
00117     /* order argument checked below */
00118 
00119     if (oldtype == MPI_DATATYPE_NULL) {
00120         FPRINTF(stderr, "MPI_Type_create_darray: oldtype is an invalid datatype\n");
00121         MPI_Abort(MPI_COMM_WORLD, 1);
00122     }
00123 
00124     MPI_Type_extent(oldtype, &orig_extent);
00125 
00126 /* check if MPI_Aint is large enough for size of global array. 
00127    if not, complain. */
00128 
00129     size_with_aint = orig_extent;
00130     for (i=0; i<ndims; i++) size_with_aint *= array_of_gsizes[i];
00131     size_with_offset = orig_extent;
00132     for (i=0; i<ndims; i++) size_with_offset *= array_of_gsizes[i];
00133     if (size_with_aint != size_with_offset) {
00134         FPRINTF(stderr, "MPI_Type_create_darray: Can't use an array of this size unless the MPI implementation defines a 64-bit MPI_Aint\n");
00135         MPI_Abort(MPI_COMM_WORLD, 1);
00136     }
00137 
00138 /* calculate position in Cartesian grid as MPI would (row-major
00139    ordering) */
00140     coords = (int *) ADIOI_Malloc(ndims*sizeof(int));
00141     procs = size;
00142     tmp_rank = rank;
00143     for (i=0; i<ndims; i++) {
00144         procs = procs/array_of_psizes[i];
00145         coords[i] = tmp_rank/procs;
00146         tmp_rank = tmp_rank % procs;
00147     }
00148 
00149     st_offsets = (MPI_Aint *) ADIOI_Malloc(ndims*sizeof(MPI_Aint));
00150     type_old = oldtype;
00151 
00152     if (order == MPI_ORDER_FORTRAN) {
00153       /* dimension 0 changes fastest */
00154         for (i=0; i<ndims; i++) {
00155             switch(array_of_distribs[i]) {
00156             case MPI_DISTRIBUTE_BLOCK:
00157                 MPIOI_Type_block(array_of_gsizes, i, ndims, array_of_psizes[i],
00158                          coords[i], array_of_dargs[i], order, orig_extent, 
00159                               type_old, &type_new, st_offsets+i); 
00160                 break;
00161             case MPI_DISTRIBUTE_CYCLIC:
00162                 MPIOI_Type_cyclic(array_of_gsizes, i, ndims, 
00163                    array_of_psizes[i], coords[i], array_of_dargs[i], order,
00164                         orig_extent, type_old, &type_new, st_offsets+i);
00165                 break;
00166             case MPI_DISTRIBUTE_NONE:
00167                 if (array_of_psizes[i] != 1) {
00168                     FPRINTF(stderr, "MPI_Type_create_darray: For MPI_DISTRIBUTE_NONE, the number of processes in that dimension of the grid must be 1\n");
00169                     MPI_Abort(MPI_COMM_WORLD, 1);
00170                 }
00171                 /* treat it as a block distribution on 1 process */
00172                 MPIOI_Type_block(array_of_gsizes, i, ndims, 1, 0, 
00173                       MPI_DISTRIBUTE_DFLT_DARG, order, orig_extent, 
00174                            type_old, &type_new, st_offsets+i); 
00175                 break;
00176             default:
00177                 FPRINTF(stderr, "MPI_Type_create_darray: Invalid value in array_of_distribs\n");
00178                 MPI_Abort(MPI_COMM_WORLD, 1);
00179             }
00180             if (i) MPI_Type_free(&type_old);
00181             type_old = type_new;
00182         }
00183 
00184         /* add displacement and UB */
00185         disps[1] = st_offsets[0];
00186         tmp_size = 1;
00187         for (i=1; i<ndims; i++) {
00188             tmp_size *= array_of_gsizes[i-1];
00189             disps[1] += tmp_size*st_offsets[i];
00190         }
00191         /* rest done below for both Fortran and C order */
00192     }
00193 
00194     else if (order == MPI_ORDER_C) {
00195         /* dimension ndims-1 changes fastest */
00196         for (i=ndims-1; i>=0; i--) {
00197             switch(array_of_distribs[i]) {
00198             case MPI_DISTRIBUTE_BLOCK:
00199                 MPIOI_Type_block(array_of_gsizes, i, ndims, array_of_psizes[i],
00200                       coords[i], array_of_dargs[i], order, orig_extent, 
00201                            type_old, &type_new, st_offsets+i); 
00202                 break;
00203             case MPI_DISTRIBUTE_CYCLIC:
00204                 MPIOI_Type_cyclic(array_of_gsizes, i, ndims, 
00205                       array_of_psizes[i], coords[i], array_of_dargs[i], order, 
00206                           orig_extent, type_old, &type_new, st_offsets+i);
00207                 break;
00208             case MPI_DISTRIBUTE_NONE:
00209                 if (array_of_psizes[i] != 1) {
00210                     FPRINTF(stderr, "MPI_Type_create_darray: For MPI_DISTRIBUTE_NONE, the number of processes in that dimension of the grid must be 1\n");
00211                     MPI_Abort(MPI_COMM_WORLD, 1);
00212                 }
00213                 /* treat it as a block distribution on 1 process */
00214                 MPIOI_Type_block(array_of_gsizes, i, ndims, array_of_psizes[i],
00215                       coords[i], MPI_DISTRIBUTE_DFLT_DARG, order, orig_extent, 
00216                            type_old, &type_new, st_offsets+i); 
00217                 break;
00218             default:
00219                 FPRINTF(stderr, "MPI_Type_create_darray: Invalid value in array_of_distribs\n");
00220                 MPI_Abort(MPI_COMM_WORLD, 1);
00221             }
00222             if (i != ndims-1) MPI_Type_free(&type_old);
00223             type_old = type_new;
00224         }
00225 
00226         /* add displacement and UB */
00227         disps[1] = st_offsets[ndims-1];
00228         tmp_size = 1;
00229         for (i=ndims-2; i>=0; i--) {
00230             tmp_size *= array_of_gsizes[i+1];
00231             disps[1] += tmp_size*st_offsets[i];
00232         }
00233     }
00234     else {
00235         FPRINTF(stderr, "MPI_Type_create_darray: Invalid order argument\n");
00236         MPI_Abort(MPI_COMM_WORLD, 1);
00237     }
00238 
00239     disps[1] *= orig_extent;
00240 
00241     disps[2] = orig_extent;
00242     for (i=0; i<ndims; i++) disps[2] *= array_of_gsizes[i];
00243         
00244     disps[0] = 0;
00245     blklens[0] = blklens[1] = blklens[2] = 1;
00246     types[0] = MPI_LB;
00247     types[1] = type_new;
00248     types[2] = MPI_UB;
00249     
00250     MPI_Type_struct(3, blklens, disps, types, newtype);
00251 
00252     MPI_Type_free(&type_new);
00253     ADIOI_Free(st_offsets);
00254     ADIOI_Free(coords);
00255     return MPI_SUCCESS;
00256 }
00257 
00258 
00259 #ifndef MPIO_BUILD_PROFILING
00260 void MPIOI_Type_block(int *array_of_gsizes, int dim, int ndims, int nprocs,
00261                       int rank, int darg, int order, MPI_Aint orig_extent,
00262                       MPI_Datatype type_old, MPI_Datatype *type_new,
00263                       MPI_Aint *st_offset) 
00264 {
00265 /* nprocs = no. of processes in dimension dim of grid
00266    rank = coordinate of this process in dimension dim */
00267 
00268     int blksize, global_size, mysize, i, j;
00269     MPI_Aint stride;
00270     
00271     global_size = array_of_gsizes[dim];
00272 
00273     if (darg == MPI_DISTRIBUTE_DFLT_DARG)
00274         blksize = (global_size + nprocs - 1)/nprocs;
00275     else {
00276         blksize = darg;
00277         if (blksize <= 0) {
00278            FPRINTF(stderr, "MPI_Type_create_darray: m <= 0 is not valid for a block(m) distribution\n");
00279            MPI_Abort(MPI_COMM_WORLD, 1);
00280         }
00281         if (blksize * nprocs < global_size) {
00282             FPRINTF(stderr, "MPI_Type_create_darray: m * nprocs < array_size is not valid for a block(m) distribution\n");
00283             MPI_Abort(MPI_COMM_WORLD, 1);
00284         }
00285     }
00286 
00287     j = global_size - blksize*rank;
00288     mysize = ADIOI_MIN(blksize, j);
00289     if (mysize < 0) mysize = 0;
00290 
00291     stride = orig_extent;
00292     if (order == MPI_ORDER_FORTRAN) {
00293         if (dim == 0) 
00294             MPI_Type_contiguous(mysize, type_old, type_new);
00295         else {
00296             for (i=0; i<dim; i++) stride *= array_of_gsizes[i];
00297             MPI_Type_hvector(mysize, 1, stride, type_old, type_new);
00298         }
00299     }
00300     else {
00301         if (dim == ndims-1) 
00302             MPI_Type_contiguous(mysize, type_old, type_new);
00303         else {
00304             for (i=ndims-1; i>dim; i--) stride *= array_of_gsizes[i];
00305             MPI_Type_hvector(mysize, 1, stride, type_old, type_new);
00306         }
00307 
00308     }
00309 
00310     *st_offset = blksize * rank;
00311      /* in terms of no. of elements of type oldtype in this dimension */
00312     if (mysize == 0) *st_offset = 0;
00313 }
00314 
00315 
00316 void MPIOI_Type_cyclic(int *array_of_gsizes, int dim, int ndims, int nprocs,
00317                       int rank, int darg, int order, MPI_Aint orig_extent,
00318                       MPI_Datatype type_old, MPI_Datatype *type_new,
00319                       MPI_Aint *st_offset) 
00320 {
00321 /* nprocs = no. of processes in dimension dim of grid
00322    rank = coordinate of this process in dimension dim */
00323 
00324     int blksize, i, blklens[2], st_index, end_index, local_size, rem, count;
00325     MPI_Aint stride, disps[2];
00326     MPI_Datatype type_tmp, types[2];
00327 
00328     if (darg == MPI_DISTRIBUTE_DFLT_DARG) blksize = 1;
00329     else blksize = darg;
00330 
00331     if (blksize <= 0) {
00332         FPRINTF(stderr, "MPI_Type_create_darray: m <= 0 is not valid for a cyclic(m) distribution\n");
00333         MPI_Abort(MPI_COMM_WORLD, 1);
00334     }
00335     
00336     st_index = rank*blksize;
00337     end_index = array_of_gsizes[dim] - 1;
00338 
00339     if (end_index < st_index) local_size = 0;
00340     else {
00341         local_size = ((end_index - st_index + 1)/(nprocs*blksize))*blksize;
00342         rem = (end_index - st_index + 1) % (nprocs*blksize);
00343         local_size += ADIOI_MIN(rem, blksize);
00344     }
00345 
00346     count = local_size/blksize;
00347     rem = local_size % blksize;
00348     
00349     stride = nprocs*blksize*orig_extent;
00350     if (order == MPI_ORDER_FORTRAN)
00351         for (i=0; i<dim; i++) stride *= array_of_gsizes[i];
00352     else for (i=ndims-1; i>dim; i--) stride *= array_of_gsizes[i];
00353 
00354     MPI_Type_hvector(count, blksize, stride, type_old, type_new);
00355 
00356     if (rem) {
00357         /* if the last block is of size less than blksize, include
00358            it separately using MPI_Type_struct */
00359 
00360         types[0] = *type_new;
00361         types[1] = type_old;
00362         disps[0] = 0;
00363         disps[1] = count*stride;
00364         blklens[0] = 1;
00365         blklens[1] = rem;
00366 
00367         MPI_Type_struct(2, blklens, disps, types, &type_tmp);
00368 
00369         MPI_Type_free(type_new);
00370         *type_new = type_tmp;
00371     }
00372 
00373     /* need to set the UB for block-cyclic to work */
00374     types[0] = *type_new;
00375     types[1] = MPI_UB;
00376     disps[0] = 0;
00377     disps[1] = orig_extent;
00378     if (order == MPI_ORDER_FORTRAN)
00379         for (i=0; i<=dim; i++) disps[1] *= array_of_gsizes[i];
00380     else for (i=ndims-1; i>=dim; i--) disps[1] *= array_of_gsizes[i];
00381     blklens[0] = blklens[1] = 1;
00382     MPI_Type_struct(2, blklens, disps, types, &type_tmp);
00383     MPI_Type_free(type_new);
00384     *type_new = type_tmp;
00385 
00386     *st_offset = rank * blksize; 
00387      /* in terms of no. of elements of type oldtype in this dimension */
00388     if (local_size == 0) *st_offset = 0;
00389 }
00390 #endif
libs/ck-libs/ampi/romio/mpi2-other/array/darray.c
