-:    0:Source:/home/MPI/testing/mpich2/mpich2/src/mpid/common/datatype/dataloop/darray_support.c
        -:    0:Graph:darray_support.gcno
        -:    0:Data:darray_support.gcda
        -:    0:Runs:4381
        -:    0:Programs:1376
        -:    1:/* -*- Mode: C; c-basic-offset:4 ; -*- */
        -:    2:/*
        -:    3: *
        -:    4: *   Copyright (C) 1997 University of Chicago.
        -:    5: *   See COPYRIGHT notice in top-level directory.
        -:    6: *
        -:    7: * Note: This code originally appeared in ROMIO.
        -:    8: */
        -:    9:
        -:   10:#include "dataloop.h"
        -:   11:
        -:   12:static int MPIOI_Type_block(int *array_of_gsizes, int dim, int ndims,
        -:   13:			    int nprocs, int rank, int darg, int order, MPI_Aint orig_extent,
        -:   14:			    MPI_Datatype type_old, MPI_Datatype *type_new,
        -:   15:			    MPI_Aint *st_offset);
        -:   16:static int MPIOI_Type_cyclic(int *array_of_gsizes, int dim, int ndims, int nprocs,
        -:   17:		      int rank, int darg, int order, MPI_Aint orig_extent,
        -:   18:		      MPI_Datatype type_old, MPI_Datatype *type_new,
        -:   19:		      MPI_Aint *st_offset);
        -:   20:
        -:   21:
        -:   22:int PREPEND_PREFIX(Type_convert_darray)(int size,
        -:   23:					int rank,
        -:   24:					int ndims,
        -:   25:					int *array_of_gsizes,
        -:   26:					int *array_of_distribs,
        -:   27:					int *array_of_dargs,
        -:   28:					int *array_of_psizes,
        -:   29:					int order,
        -:   30:					MPI_Datatype oldtype,
        -:   31:					MPI_Datatype *newtype)
      588:   32:{
      588:   33:    MPI_Datatype type_old, type_new=MPI_DATATYPE_NULL, types[3];
        -:   34:    int procs, tmp_rank, i, tmp_size, blklens[3], *coords;
        -:   35:    MPI_Aint *st_offsets, orig_extent, disps[3];
        -:   36:
      588:   37:    NMPI_Type_extent(oldtype, &orig_extent);
        -:   38:
        -:   39:/* calculate position in Cartesian grid as MPI would (row-major
        -:   40:   ordering) */
      588:   41:    coords = (int *) DLOOP_Malloc(ndims*sizeof(int));
      588:   42:    procs = size;
      588:   43:    tmp_rank = rank;
     2468:   44:    for (i=0; i<ndims; i++) {
     1880:   45:	procs = procs/array_of_psizes[i];
     1880:   46:	coords[i] = tmp_rank/procs;
     1880:   47:	tmp_rank = tmp_rank % procs;
        -:   48:    }
        -:   49:
      588:   50:    st_offsets = (MPI_Aint *) DLOOP_Malloc(ndims*sizeof(MPI_Aint));
      588:   51:    type_old = oldtype;
        -:   52:
      588:   53:    if (order == MPI_ORDER_FORTRAN) {
        -:   54:      /* dimension 0 changes fastest */
    #####:   55:	for (i=0; i<ndims; i++) {
    #####:   56:	    switch(array_of_distribs[i]) {
        -:   57:	    case MPI_DISTRIBUTE_BLOCK:
    #####:   58:		MPIOI_Type_block(array_of_gsizes, i, ndims,
        -:   59:				 array_of_psizes[i],
        -:   60:				 coords[i], array_of_dargs[i],
        -:   61:				 order, orig_extent,
        -:   62:				 type_old, &type_new,
        -:   63:				 st_offsets+i);
    #####:   64:		break;
        -:   65:	    case MPI_DISTRIBUTE_CYCLIC:
    #####:   66:		MPIOI_Type_cyclic(array_of_gsizes, i, ndims,
        -:   67:				  array_of_psizes[i], coords[i],
        -:   68:				  array_of_dargs[i], order,
        -:   69:				  orig_extent, type_old,
        -:   70:				  &type_new, st_offsets+i);
    #####:   71:		break;
        -:   72:	    case MPI_DISTRIBUTE_NONE:
        -:   73:		/* treat it as a block distribution on 1 process */
    #####:   74:		MPIOI_Type_block(array_of_gsizes, i, ndims, 1, 0,
        -:   75:				 MPI_DISTRIBUTE_DFLT_DARG, order,
        -:   76:				 orig_extent,
        -:   77:				 type_old, &type_new,
        -:   78:				 st_offsets+i);
        -:   79:		break;
        -:   80:	    }
    #####:   81:	    if (i) NMPI_Type_free(&type_old);
    #####:   82:	    type_old = type_new;
        -:   83:	}
        -:   84:
        -:   85:	/* add displacement and UB */
    #####:   86:	disps[1] = st_offsets[0];
    #####:   87:	tmp_size = 1;
    #####:   88:	for (i=1; i<ndims; i++) {
    #####:   89:	    tmp_size *= array_of_gsizes[i-1];
    #####:   90:	    disps[1] += ((MPI_Aint) tmp_size) * st_offsets[i];
        -:   91:	}
        -:   92:        /* rest done below for both Fortran and C order */
        -:   93:    }
        -:   94:
        -:   95:    else /* order == MPI_ORDER_C */ {
        -:   96:        /* dimension ndims-1 changes fastest */
     2468:   97:	for (i=ndims-1; i>=0; i--) {
     1880:   98:	    switch(array_of_distribs[i]) {
        -:   99:	    case MPI_DISTRIBUTE_BLOCK:
     1160:  100:		MPIOI_Type_block(array_of_gsizes, i, ndims, array_of_psizes[i],
        -:  101:				 coords[i], array_of_dargs[i], order,
        -:  102:				 orig_extent, type_old, &type_new,
        -:  103:				 st_offsets+i);
     1160:  104:		break;
        -:  105:	    case MPI_DISTRIBUTE_CYCLIC:
    #####:  106:		MPIOI_Type_cyclic(array_of_gsizes, i, ndims,
        -:  107:				  array_of_psizes[i], coords[i],
        -:  108:				  array_of_dargs[i], order,
        -:  109:				  orig_extent, type_old, &type_new,
        -:  110:				  st_offsets+i);
    #####:  111:		break;
        -:  112:	    case MPI_DISTRIBUTE_NONE:
        -:  113:		/* treat it as a block distribution on 1 process */
      720:  114:		MPIOI_Type_block(array_of_gsizes, i, ndims, array_of_psizes[i],
        -:  115:		      coords[i], MPI_DISTRIBUTE_DFLT_DARG, order, orig_extent,
        -:  116:                           type_old, &type_new, st_offsets+i);
        -:  117:		break;
        -:  118:	    }
     1880:  119:	    if (i != ndims-1) NMPI_Type_free(&type_old);
     1880:  120:	    type_old = type_new;
        -:  121:	}
        -:  122:
        -:  123:	/* add displacement and UB */
      588:  124:	disps[1] = st_offsets[ndims-1];
      588:  125:	tmp_size = 1;
     1880:  126:	for (i=ndims-2; i>=0; i--) {
     1292:  127:	    tmp_size *= array_of_gsizes[i+1];
     1292:  128:	    disps[1] += ((MPI_Aint) tmp_size) * st_offsets[i];
        -:  129:	}
        -:  130:    }
        -:  131:
      588:  132:    disps[1] *= orig_extent;
        -:  133:
      588:  134:    disps[2] = orig_extent;
      588:  135:    for (i=0; i<ndims; i++) disps[2] *= (MPI_Aint)(array_of_gsizes[i]);
        -:  136:	
      588:  137:    disps[0] = 0;
      588:  138:    blklens[0] = blklens[1] = blklens[2] = 1;
      588:  139:    types[0] = MPI_LB;
      588:  140:    types[1] = type_new;
      588:  141:    types[2] = MPI_UB;
        -:  142:    
      588:  143:    NMPI_Type_struct(3, blklens, disps, types, newtype);
        -:  144:
      588:  145:    NMPI_Type_free(&type_new);
        -:  146:
      588:  147:    DLOOP_Free(st_offsets);
      588:  148:    DLOOP_Free(coords);
      588:  149:    return MPI_SUCCESS;
        -:  150:}
        -:  151:
        -:  152:
        -:  153:/* Returns MPI_SUCCESS on success, an MPI error code on failure.  Code above
        -:  154: * needs to call MPIO_Err_return_xxx.
        -:  155: */
        -:  156:static int MPIOI_Type_block(int *array_of_gsizes, int dim, int ndims, int nprocs,
        -:  157:		     int rank, int darg, int order, MPI_Aint orig_extent,
        -:  158:		     MPI_Datatype type_old, MPI_Datatype *type_new,
        -:  159:		     MPI_Aint *st_offset)
     1880:  160:{
        -:  161:/* nprocs = no. of processes in dimension dim of grid
        -:  162:   rank = coordinate of this process in dimension dim */
        -:  163:    int blksize, global_size, mysize, i, j;
        -:  164:    MPI_Aint stride;
        -:  165:
     1880:  166:    global_size = array_of_gsizes[dim];
        -:  167:
     1880:  168:    if (darg == MPI_DISTRIBUTE_DFLT_DARG)
     1880:  169:	blksize = (global_size + nprocs - 1)/nprocs;
        -:  170:    else {
    #####:  171:	blksize = darg;
        -:  172:
        -:  173:	/* --BEGIN ERROR HANDLING-- */
    #####:  174:	if (blksize <= 0) {
    #####:  175:	    return MPI_ERR_ARG;
        -:  176:	}
        -:  177:
    #####:  178:	if (blksize * nprocs < global_size) {
    #####:  179:	    return MPI_ERR_ARG;
        -:  180:	}
        -:  181:	/* --END ERROR HANDLING-- */
        -:  182:    }
        -:  183:
     1880:  184:    j = global_size - blksize*rank;
     1880:  185:    mysize = (blksize < j) ? blksize : j;
     1880:  186:    if (mysize < 0) mysize = 0;
        -:  187:
     1880:  188:    stride = orig_extent;
     1880:  189:    if (order == MPI_ORDER_FORTRAN) {
    #####:  190:	if (dim == 0)
    #####:  191:	    NMPI_Type_contiguous(mysize, type_old, type_new);
        -:  192:	else {
    #####:  193:	    for (i=0; i<dim; i++) stride *= (MPI_Aint)(array_of_gsizes[i]);
    #####:  194:	    NMPI_Type_hvector(mysize, 1, stride, type_old, type_new);
        -:  195:	}
        -:  196:    }
        -:  197:    else {
     1880:  198:	if (dim == ndims-1)
      588:  199:	    NMPI_Type_contiguous(mysize, type_old, type_new);
        -:  200:	else {
     1292:  201:	    for (i=ndims-1; i>dim; i--) stride *= (MPI_Aint)(array_of_gsizes[i]);
     1292:  202:	    NMPI_Type_hvector(mysize, 1, stride, type_old, type_new);
        -:  203:	}
        -:  204:    }
        -:  205:
     1880:  206:    *st_offset = blksize * rank;
        -:  207:     /* in terms of no. of elements of type oldtype in this dimension */
     1880:  208:    if (mysize == 0) *st_offset = 0;
        -:  209:
     1880:  210:    return MPI_SUCCESS;
        -:  211:}
        -:  212:
        -:  213:
        -:  214:/* Returns MPI_SUCCESS on success, an MPI error code on failure.  Code above
        -:  215: * needs to call MPIO_Err_return_xxx.
        -:  216: */
        -:  217:static int MPIOI_Type_cyclic(int *array_of_gsizes, int dim, int ndims, int nprocs,
        -:  218:		      int rank, int darg, int order, MPI_Aint orig_extent,
        -:  219:		      MPI_Datatype type_old, MPI_Datatype *type_new,
        -:  220:		      MPI_Aint *st_offset)
    #####:  221:{
        -:  222:/* nprocs = no. of processes in dimension dim of grid
        -:  223:   rank = coordinate of this process in dimension dim */
        -:  224:    int blksize, i, blklens[3], st_index, end_index, local_size, rem, count;
        -:  225:    MPI_Aint stride, disps[3];
        -:  226:    MPI_Datatype type_tmp, types[3];
        -:  227:
    #####:  228:    if (darg == MPI_DISTRIBUTE_DFLT_DARG) blksize = 1;
    #####:  229:    else blksize = darg;
        -:  230:
        -:  231:    /* --BEGIN ERROR HANDLING-- */
    #####:  232:    if (blksize <= 0) {
    #####:  233:	return MPI_ERR_ARG;
        -:  234:    }
        -:  235:    /* --END ERROR HANDLING-- */
        -:  236:
    #####:  237:    st_index = rank*blksize;
    #####:  238:    end_index = array_of_gsizes[dim] - 1;
        -:  239:
    #####:  240:    if (end_index < st_index) local_size = 0;
        -:  241:    else {
    #####:  242:	local_size = ((end_index - st_index + 1)/(nprocs*blksize))*blksize;
    #####:  243:	rem = (end_index - st_index + 1) % (nprocs*blksize);
    #####:  244:	local_size += (rem < blksize) ? rem : blksize;
        -:  245:    }
        -:  246:
    #####:  247:    count = local_size/blksize;
    #####:  248:    rem = local_size % blksize;
        -:  249:
    #####:  250:    stride = ((MPI_Aint) nprocs) * ((MPI_Aint) blksize) * orig_extent;
    #####:  251:    if (order == MPI_ORDER_FORTRAN)
    #####:  252:	for (i=0; i<dim; i++) stride *= (MPI_Aint)(array_of_gsizes[i]);
    #####:  253:    else for (i=ndims-1; i>dim; i--) stride *= (MPI_Aint)(array_of_gsizes[i]);
        -:  254:
    #####:  255:    NMPI_Type_hvector(count, blksize, stride, type_old, type_new);
        -:  256:
    #####:  257:    if (rem) {
        -:  258:	/* if the last block is of size less than blksize, include
        -:  259:	   it separately using MPI_Type_struct */
        -:  260:
    #####:  261:	types[0] = *type_new;
    #####:  262:	types[1] = type_old;
    #####:  263:	disps[0] = 0;
    #####:  264:	disps[1] = ((MPI_Aint) count) * stride;
    #####:  265:	blklens[0] = 1;
    #####:  266:	blklens[1] = rem;
        -:  267:
    #####:  268:	NMPI_Type_struct(2, blklens, disps, types, &type_tmp);
        -:  269:
    #####:  270:	NMPI_Type_free(type_new);
    #####:  271:	*type_new = type_tmp;
        -:  272:    }
        -:  273:
        -:  274:    /* In the first iteration, we need to set the displacement in that
        -:  275:       dimension correctly. */
    #####:  276:    if (((order == MPI_ORDER_FORTRAN) && (dim == 0)) ||
        -:  277:	((order == MPI_ORDER_C) && (dim == ndims-1))) {
    #####:  278:        types[0] = MPI_LB;
    #####:  279:        disps[0] = 0;
    #####:  280:        types[1] = *type_new;
    #####:  281:        disps[1] = ((MPI_Aint) rank) * ((MPI_Aint) blksize) * orig_extent;
    #####:  282:        types[2] = MPI_UB;
    #####:  283:        disps[2] = orig_extent * ((MPI_Aint)(array_of_gsizes[dim]));
    #####:  284:        blklens[0] = blklens[1] = blklens[2] = 1;
    #####:  285:        NMPI_Type_struct(3, blklens, disps, types, &type_tmp);
    #####:  286:        NMPI_Type_free(type_new);
    #####:  287:        *type_new = type_tmp;
        -:  288:
    #####:  289:        *st_offset = 0;  /* set it to 0 because it is taken care of in
        -:  290:                            the struct above */
        -:  291:    }
        -:  292:    else {
    #####:  293:        *st_offset = ((MPI_Aint) rank) * ((MPI_Aint) blksize);
        -:  294:        /* st_offset is in terms of no. of elements of type oldtype in
        -:  295:         * this dimension */
        -:  296:    }
        -:  297:
    #####:  298:    if (local_size == 0) *st_offset = 0;
        -:  299:
    #####:  300:    return MPI_SUCCESS;
        -:  301:}