source: CONFIG_DEVT/IPSLCM6.5_work_ENSEMBLES/oasis3-mct/lib/mct/mpi-serial/type.c

Last change on this file was 5725, checked in by aclsce, 3 years ago

Added new oasis3-MCT version to be used to handle ensembles simulations with XIOS.

File size: 20.9 KB
Line 
1/*
2 * JCY
3 * 07/2007
4 * Derived Datatype functions for mpi-serial
5 */
6
7#include "type.h"
8#include "mpiP.h"
9#include <stdlib.h>
10#include <stdio.h>
11#include <limits.h>
12
13#ifdef HAVE_CONFIG_H
14#include <config.h>
15#endif
16
17/*
18 * NOTES: All MPI_ prefixed (public) functions operate
19 * using the integer handle for a datatype.  Most of these
20 * functions are wrapper functions for a different function,
21 * _not_ prefixed with MPI_.  These functions translate the
22 * handle to a pointer and call the non-MPI_ func.
23 *
24 * Fortran bindings use FC_FUNC, as defined in mpiP.h.
25 */
26
27
28/*
29 * Wrapper for mpi_handle_to_ptr in handles.c
30 * specific for datatype handles, which may be
31 * predefined negative handles
32 */
33Datatype* mpi_handle_to_datatype(int handle)
34{
35  if (handle < 0)
36    return (Datatype*) &simpletypes[-1-handle];
37  else
38    return (Datatype*) mpi_handle_to_ptr(handle);
39}
40
41/*
42 * Calculate the epsilon value of typemap
43 * using the largest element in the typemap
44 */
45
46int calc_padding(Datatype datatype)
47{
48  long size_max = INT_MIN;
49  long type_len;
50  int i;
51  //find the largest datatype size.  The epsilon padding is (probably) based on this.
52
53  for (i = 0; i < datatype->count; i++)
54  {
55    type_len = Simpletype_length(datatype->pairs[i].type);
56    size_max = type_len > size_max ? type_len : size_max;
57  }
58
59  return size_max;
60}
61
62/* Retrieve size of any simple type
63 * C sizes use sizeof the literal type
64 * they represent.  Fortran types are those
65 * as defined in type.h
66 */
67
68int Simpletype_length(Simpletype t)
69{
70  switch(t)
71  {
72    case SIMPLE_CHAR:
73      return sizeof(char); break;
74    case SIMPLE_SHORT:
75      return sizeof(short); break;
76    case SIMPLE_INT:
77      return sizeof(int); break;
78    case SIMPLE_LONG:
79      return sizeof(long); break;
80    case SIMPLE_UCHAR:
81      return sizeof(unsigned char); break;
82    case SIMPLE_USHORT:
83      return sizeof(unsigned short); break;
84    case SIMPLE_UINT:
85      return sizeof(unsigned int); break;
86    case SIMPLE_ULONG:
87      return sizeof(unsigned long); break;
88    case SIMPLE_FLOAT:
89      return sizeof(float); break;
90    case SIMPLE_DOUBLE:
91      return sizeof(double); break;
92    case SIMPLE_LDOUBLE:
93      return sizeof(long double); break;
94    case SIMPLE_BYTE:
95      return sizeof(char); break;
96    case SIMPLE_FINTEGER:
97      return FSIZE_INTEGER; break;
98    case SIMPLE_FREAL:
99      return FSIZE_REAL; break;
100    case SIMPLE_FDPRECISION:
101      return FSIZE_DPRECISION; break;
102    case SIMPLE_FCOMPLEX:
103      return FSIZE_COMPLEX; break;
104    case SIMPLE_FDCOMPLEX:
105      return FSIZE_DCOMPLEX; break;
106    case SIMPLE_FLOGICAL:
107      return FSIZE_LOGICAL; break;
108    case SIMPLE_FCHARACTER:
109      return FSIZE_CHARACTER; break;
110    case SIMPLE_FINTEGER1:
111      return 1; break;
112    case SIMPLE_FINTEGER2:
113      return 2; break;
114    case SIMPLE_FINTEGER4:
115      return 4; break;
116    case SIMPLE_FINTEGER8:
117      return 8; break;
118    case SIMPLE_FREAL4:
119      return 4; break;
120    case SIMPLE_FREAL8:
121      return 8; break;
122    case SIMPLE_FREAL16:
123      return 16; break;
124    case SIMPLE_FCOMPLEX8:
125      return 8; break;
126    case SIMPLE_FCOMPLEX16:
127      return 16; break;
128    case SIMPLE_FCOMPLEX32:
129      return 32; break;
130    case SIMPLE_LONGLONG:
131      return sizeof(long long); break;
132    case SIMPLE_ULONGLONG:
133      return sizeof(unsigned long long); break;
134    case SIMPLE_OFFSET:
135      return sizeof(MPI_Offset); break;
136
137    default:
138      printf("Invalid simple type\n");
139      exit(1);
140  }
141}
142
143/*
144 * calculates the lower bound of a datatype using typemap
145 * (This gives no regard to MPI_LB, but rather uses only displacements)
146 */
147long calc_lb(Datatype type)
148{
149  int i;
150  int min_disp = INT_MAX;
151  typepair * tp;
152
153  for(i =0; i < type->count; i++)
154  {
155    tp =  type->pairs+i;
156    min_disp = tp->disp < min_disp
157                ? tp->disp
158                : min_disp;
159  }
160  return min_disp;
161}
162
163/*
164 * Calculate upper bound using typemap
165 * (Gives no regard to MPI_UB, just calculates
166 * highest displacement+size of its respective data type)
167 */
168long calc_ub(Datatype type)
169{
170  int i;
171  long max_disp = INT_MIN;
172  typepair * tp;
173
174  for(i = 0; i < type->count; i++)
175  {
176    tp = type->pairs+i;
177    max_disp = tp->disp + Simpletype_length(tp->type) > max_disp
178                ? tp->disp + Simpletype_length(tp->type)
179                : max_disp;
180  }
181
182  return max_disp;
183}
184
185
186/*******************************************************/
187/* MPI_Type_struct is the most general type constructor that
188 * does the common work other constructors.
189 * All other type constructors call this function.
190 */
191
192FC_FUNC( mpi_type_struct, MPI_TYPE_STRUCT )
193         (int * count,       int * blocklens, long * displacements,
194          int *oldtypes_ptr, int *newtype,    int *ierror)
195{
196  *ierror=MPI_Type_struct(*count, blocklens, displacements,
197                                    oldtypes_ptr, newtype);
198}
199
200/* Public function, wrapper for Type_struct that translates handle to
201 * pointer (see NOTES at top of file)
202 */
203int MPI_Type_struct(int count, int * blocklens, MPI_Aint * displacements,
204                    MPI_Datatype *oldtypes,     MPI_Datatype *newtype)
205{
206  int i;
207  Datatype oldtypes_ptr[count];
208  Datatype * newtype_ptr;
209
210  for (i = 0; i < count; i++)
211  {
212    oldtypes_ptr[i] = *(Datatype*) mpi_handle_to_datatype(oldtypes[i]);
213  }
214
215  mpi_alloc_handle(newtype, (void**) &newtype_ptr);
216
217  return Type_struct(count, blocklens, displacements,
218                          oldtypes_ptr, newtype_ptr);
219}
220
221int Type_struct(int count, int * blocklens, MPI_Aint * displacements,
222                Datatype *oldtypes_ptr,     Datatype *newtype)
223{
224  int i, j, k;
225  Datatype temp, temp2;
226  int newcount;
227  char override_lower = 0, //whether to override
228       override_upper = 0;
229  MPI_Aint  new_lb = LONG_MAX,
230            new_ub = LONG_MIN,
231       clb, cub;            //calculated lb and ub
232  int simpletype_count = 0; //total additional blocks for malloc
233  MPI_Aint tmp_offset;      //for contiguous blocks of type
234  MPI_Aint extent;
235
236  // find the total number of elements in the typemap we need to add.
237  for (i = 0; i < count; i++)
238  {
239    //check for MPI_UB or MPI_LB.  These types are special
240    // cases and will be skipped over
241
242    temp2 = oldtypes_ptr[i];
243    if (temp2->pairs[0].type == SIMPLE_LOWER)
244    {
245      //found MPI_LB.  This is a candidate for the actual lb
246      if (new_lb > displacements[i])
247        new_lb = displacements[i];
248      override_lower = 1;
249    }
250    else if (temp2->pairs[0].type == SIMPLE_UPPER)
251    {
252      //same as above, but ub
253      if (new_ub < displacements[i])
254        new_ub = displacements[i];
255      override_upper = 1;
256    }
257    else
258    {
259      //this is not MPI_LB or MPI_UB
260      //However it may still have overriding bounds
261      //Test for these and add its size to the typemap.
262
263      if (temp2->o_lb)
264        // this type's lb has been overridden.
265        // ONLY an overriding lb can be the actual lb now.
266        override_lower = 1;
267      if (temp2->o_ub)
268        //same as above, but ub
269        override_upper = 1;
270
271      simpletype_count += blocklens[i] * oldtypes_ptr[i]->count;
272    }
273  }
274  temp = malloc(sizeof(Typestruct) +
275               ((simpletype_count-1) * sizeof(typepair)));
276
277  temp->count = simpletype_count;
278
279  i = 0;         //old type's index
280  newcount = 0;  //new type's index
281
282  while (i < count)
283  {
284    tmp_offset = 0;
285
286    temp2 = oldtypes_ptr[i];
287
288    //test for previous MPI_LB or MPI_UB in one of the comprising types.
289    //If found, skip over.
290    if (!((temp2->pairs[0].type == SIMPLE_LOWER) ||
291          (temp2->pairs[0].type == SIMPLE_UPPER)))
292    {
293      for (j = 0; j < blocklens[i]; j++)
294      {
295        //Copy the old type's typemap and merge into the new type
296        //by a "flattening" process
297        Type_extent((Datatype) oldtypes_ptr[i], &extent);
298
299        tmp_offset = j * extent;
300
301        if (temp2->o_lb && temp2->lb+displacements[i]+tmp_offset < new_lb)
302          new_lb = temp2->lb+displacements[i]+tmp_offset;
303        if (temp2->o_ub && temp2->ub+displacements[i]+tmp_offset > new_ub)
304        {
305          new_ub = temp2->ub+displacements[i]+tmp_offset;
306        }
307
308        for (k = 0;  k < oldtypes_ptr[i]->count; k++)
309        {
310          Copy_type( (typepair*) oldtypes_ptr[i]->pairs+k,
311                     (typepair*) (temp->pairs+newcount));
312
313
314          ((typepair*) temp->pairs+(newcount))->disp +=
315                       displacements[i] + tmp_offset;
316          newcount++;
317        }
318      }
319    }
320    i++;
321  }
322  //type is NOT committed
323  temp->committed = 0;
324
325  //assign upper and lower bounds here
326  if (override_lower)
327  {
328    //use lowest previous overridden lower bound
329    temp->o_lb = 1;
330    temp->lb = new_lb;
331  }
332  else
333  {
334    //use calculation
335    temp->lb = calc_lb(temp);
336  }
337
338  if (override_upper)
339  {
340    temp->o_ub = 1;
341    temp->ub = new_ub;
342  }
343  else
344  {
345    temp->ub = calc_ub(temp);
346  }
347
348  *newtype = temp;
349  temp = MPI_DATATYPE_NULL;
350
351  return MPI_SUCCESS;
352}
353
354/*******************************************************/
355/*  MPI_Type_contiguous.  Create count copies of a type.
356 *  this creates arrays of the singleton arguments and use them to call
357 *  MPI_Type_struct()
358 */
359
360FC_FUNC( mpi_type_contiguous, MPI_TYPE_CONTIGUOUS )
361         (int *count, int *oldtype, int * newtype, int * ierr)
362{
363  *ierr = MPI_Type_contiguous(*count, *oldtype, newtype);
364}
365
366int MPI_Type_contiguous(int count, MPI_Datatype old, MPI_Datatype * new)
367{
368  int ret;
369  Datatype old_ptr = *(Datatype*) mpi_handle_to_datatype(old);
370  Datatype * new_ptr;
371
372  mpi_alloc_handle(new, (void**) &new_ptr);
373
374  return Type_contiguous(count, old_ptr, new_ptr);
375}
376
377int Type_contiguous(int count, Datatype oldtype, Datatype *newtype)
378{
379  int i;
380  int blocklengths[count];
381  Datatype oldtypes[count];
382  MPI_Aint offsets[count];
383  MPI_Aint extent;
384
385  //each copy is strided by the extent of the datatype.
386  // Calculate that here.
387  Type_extent(oldtype, &extent);
388  for (i = 0; i < count; i++)
389  {
390    blocklengths[i] = 1;
391    offsets[i] = extent * i;
392    oldtypes[i] = oldtype;
393  }
394  return Type_struct(count, blocklengths, offsets, oldtypes, newtype);
395}
396
397/*************************/
398/* Type_vector
399 */
400
401FC_FUNC( mpi_type_vector, MPI_TYPE_VECTOR )
402         (int * count, int * blocklen, int * stride,
403          int * oldtype, int * newtype, int * ierr)
404{
405  *ierr = MPI_Type_vector(*count, *blocklen, *stride, *oldtype, newtype);
406}
407
408int MPI_Type_vector(int count, int blocklen, int stride,
409                    MPI_Datatype oldtype, MPI_Datatype * newtype)
410{
411  Datatype old_ptr = *(Datatype*) mpi_handle_to_datatype(oldtype);
412  Datatype * new_ptr;
413
414  mpi_alloc_handle(newtype, (void**) &new_ptr);
415
416  return Type_vector(count, blocklen, stride, old_ptr, new_ptr);
417}
418
419
420int Type_vector(int count, int blocklen, int stride,
421                Datatype oldtype, Datatype *newtype)
422{
423  MPI_Aint extent;
424  MPI_Aint bstride;
425
426  Type_extent(oldtype, &extent);
427  bstride = stride * extent;
428
429  return Type_hvector(count, blocklen, bstride, oldtype, newtype);
430}
431
432/*******************************************************/
433
434FC_FUNC( mpi_type_hvector, MPI_TYPE_HVECTOR )
435         (int * count,   long * blocklen, long * stride,
436          int * oldtype, int * newtype,   int * ierr)
437{
438  *ierr = MPI_Type_hvector(*count, *blocklen, *stride, *oldtype, newtype);
439}
440
441int MPI_Type_hvector(int count, int blocklen, MPI_Aint stride,
442                     MPI_Datatype oldtype, MPI_Datatype * newtype)
443{
444  Datatype old_ptr = *(Datatype*) mpi_handle_to_datatype(oldtype);
445  Datatype * new_ptr;
446
447  mpi_alloc_handle(newtype, (void**) &new_ptr);
448  return Type_hvector(count, blocklen, stride, old_ptr, new_ptr);
449}
450
451FC_FUNC( mpi_type_create_hvector, MPI_TYPE_CREATE_HVECTOR )
452         (int * count,   long * blocklen, long * stride,
453          int * oldtype, int * newtype,   int * ierr)
454{
455  *ierr = MPI_Type_create_hvector(*count, *blocklen, *stride, *oldtype, newtype);
456}
457
458int MPI_Type_create_hvector(int count, int blocklen, MPI_Aint stride,
459                     MPI_Datatype oldtype, MPI_Datatype * newtype)
460{
461  Datatype old_ptr = *(Datatype*) mpi_handle_to_datatype(oldtype);
462  Datatype * new_ptr;
463
464  mpi_alloc_handle(newtype, (void**) &new_ptr);
465  return Type_hvector(count, blocklen, stride, old_ptr, new_ptr);
466}
467
468
469int Type_hvector(int count, int blocklen, MPI_Aint stride,
470                      Datatype oldtype, Datatype *newtype)
471{
472  int i;
473  int blocklengths[count];
474  Datatype oldtypes[count];
475  MPI_Aint offsets[count];
476  MPI_Aint extent;
477
478  Type_extent(oldtype, &extent);
479  for (i = 0; i < count; i++)
480  {
481    blocklengths[i] = blocklen;
482    offsets[i] = stride * i;
483    oldtypes[i] = oldtype;
484  }
485
486  return Type_struct(count, blocklengths, offsets, oldtypes, newtype);
487}
488
489/*******************************************************/
490
491FC_FUNC( mpi_type_indexed, MPI_TYPE_INDEXED )
492         (int * count,   int * blocklens, int * displacements,
493          int * oldtype, int * newtype,   int * ierr)
494{
495  *ierr = MPI_Type_indexed(*count, blocklens, displacements, *oldtype, newtype);
496}
497
498
499int MPI_Type_indexed(int count, int *blocklens, int *displacements,
500                     MPI_Datatype oldtype, MPI_Datatype * newtype)
501{
502  Datatype old_ptr = *(Datatype*) mpi_handle_to_datatype(oldtype);
503  Datatype * new_ptr;
504
505  mpi_alloc_handle(newtype, (void**) &new_ptr);
506  return Type_indexed(count, blocklens, displacements, old_ptr, new_ptr);
507}
508
509int Type_indexed(int count, int *blocklens, int *displacements,
510                 Datatype oldtype, Datatype *newtype)
511{
512  int i;
513  MPI_Aint extent;
514  MPI_Aint bdisps[count];
515
516  for (i = 0; i < count; i++)
517  {
518    Type_extent(oldtype, &extent);
519    bdisps[i] = displacements[i] * extent;
520  }
521
522  return Type_hindexed(count, blocklens, bdisps, oldtype, newtype);
523}
524
525/*******************************************************/
526
527FC_FUNC( mpi_type_create_indexed_block, MPI_TYPE_CREATE_INDEXED_BLOCK )
528         (int * count,   int * blocklen, int * displacements,
529          int * oldtype, int * newtype,  int * ierr)
530{
531  *ierr = MPI_Type_create_indexed_block(*count, *blocklen, displacements,
532                                        *oldtype, newtype);
533}
534
535int MPI_Type_create_indexed_block(int count, int blocklen, int *displacements,
536                                  MPI_Datatype oldtype, MPI_Datatype * newtype)
537{
538  int ret;
539  Datatype old_ptr = *(Datatype*) mpi_handle_to_datatype(oldtype);
540  Datatype * new_ptr;
541
542  mpi_alloc_handle(newtype, (void**) &new_ptr);
543  return Type_create_indexed_block(count, blocklen, displacements, old_ptr, new_ptr);
544}
545
546int Type_create_indexed_block(int count, int blocklen, int *displacements,
547                              Datatype oldtype, Datatype *newtype)
548{
549  int i;
550  int blocklens[count];
551
552  for (i = 0; i < count; i++)
553    blocklens[i] = blocklen;
554
555  return Type_indexed(count, blocklens, displacements, oldtype, newtype);
556}
557
558/*******************************************************/
559
560FC_FUNC( mpi_type_hindexed, MPI_TYPE_HINDEXED )
561         (int * count,   int * blocklens, MPI_Aint * displacements,
562          int * oldtype, int * newtype,   int * ierr)
563{
564  *ierr = MPI_Type_hindexed(*count, blocklens, displacements,
565                            *oldtype, newtype);
566}
567
568int MPI_Type_hindexed(int count, int *blocklens, MPI_Aint * disps,
569                      MPI_Datatype oldtype, MPI_Datatype * newtype)
570{
571  Datatype old_ptr = *(Datatype*) mpi_handle_to_datatype(oldtype);
572  Datatype * new_ptr;
573
574  mpi_alloc_handle(newtype, (void**) &new_ptr);
575  return Type_hindexed(count, blocklens, disps, old_ptr, new_ptr);
576}
577
578int Type_hindexed(int count, int *blocklens, MPI_Aint *displacements,
579                  Datatype oldtype, Datatype *newtype)
580{
581  int i;
582  Datatype oldtypes[count];
583
584  for (i = 0; i < count; i++)
585  {
586    oldtypes[i] = oldtype;
587  }
588
589  return Type_struct(count, blocklens, displacements, oldtypes, newtype);
590}
591
592
593/*******************************************************/
594
595int Type_dup(Datatype oldtype, Datatype *newtype)
596{
597  int i;
598  //create a deep copy of given Datatype
599  newtype = malloc(sizeof(oldtype));
600  (*newtype)->committed = oldtype->committed;
601  (*newtype)->lb = oldtype->lb;
602  (*newtype)->ub = oldtype->ub;
603  (*newtype)->o_lb = oldtype->o_lb;
604  (*newtype)->o_ub = oldtype->o_ub;
605
606  for (i = 0; i < oldtype->count; i++)
607  {
608    Copy_type((typepair*) oldtype->pairs + i,
609              (typepair*) (*newtype)->pairs + i );
610  }
611}
612
613/* copy_type: Creates a deep copy of source typepair into dest
614 */
615int Copy_type(typepair *source, typepair *dest)
616{
617  dest->type = source->type;
618  dest->disp = source->disp;
619}
620
621/* MPI_Type_size:  Returns the sum of the lengths of each simple
622 * type that makes up the data type argument
623 */
624FC_FUNC( mpi_type_size, MPI_TYPE_SIZE )(int * type, int * size, int * ierr)
625{
626  *ierr=MPI_Type_size(*type, size);
627}
628
629int MPI_Type_size(MPI_Datatype type, int * size)
630{
631  Datatype type_ptr = *(Datatype*) mpi_handle_to_datatype(type);
632  return Type_size(type_ptr, size);
633}
634
635int Type_size(Datatype type, int * size)
636{
637  int i;
638  *size = 0;
639  for (i=0; i < type->count; i++)
640    *size += Simpletype_length(type->pairs[i].type);
641
642
643  return MPI_SUCCESS;
644}
645/* MPI_Type_lb: Returns the lower bound (which may be overridden
646 * or calculated)
647 */
648FC_FUNC( mpi_type_lb, MPI_TYPE_LB )(int * type, long * lb, int * ierr)
649{
650  *ierr = MPI_Type_lb(*type, lb);
651}
652
653int MPI_Type_lb(MPI_Datatype type, MPI_Aint * lb)
654{
655  Datatype type_ptr = *(Datatype*) mpi_handle_to_datatype(type);
656
657  return Type_lb(type_ptr, lb);
658}
659
660int Type_lb(Datatype type, MPI_Aint * lb)
661{
662  *lb = type->lb;
663}
664
665/* MPI_Type_ub: Return upper bound (which may be overridden
666 * or calculated
667 */
668FC_FUNC( mpi_type_ub, MPI_TYPE_UB )(int * type, long * ub, int * ierr)
669{
670  *ierr = MPI_Type_ub(*type, ub);
671}
672
673int MPI_Type_ub(MPI_Datatype type, MPI_Aint * ub)
674{
675  Datatype type_ptr = *(Datatype*) mpi_handle_to_datatype(type);
676
677  return Type_ub(type_ptr, ub);
678}
679
680int Type_ub(Datatype type, MPI_Aint * ub)
681{
682  *ub = type->ub;
683}
684
685/* MPI_Get_address
686 * MPI_Address
687 * Return address of an object
688 */
689FC_FUNC( mpi_get_address, MPI_ADDRESS )(void * loc, long * address, int * ierr)
690{
691  *ierr = FGet_address(loc, address);
692}
693
694FC_FUNC( mpi_address, MPI_ADDRESS )(void * loc, long * address, int * ierr)
695{
696  *address = (long) loc;
697  *ierr = FGet_address(loc, address);
698}
699
700int FGet_address(void * loc, long * address, int * ierr)
701{
702  *address = (long) loc;
703  return MPI_SUCCESS;
704}
705
706int MPI_Address(void * loc, MPI_Aint * address)
707{
708  return MPI_Get_address(loc, address);
709}
710
711int MPI_Get_address(void * loc, MPI_Aint * address)
712{
713  *address = (MPI_Aint) loc;
714  return MPI_SUCCESS;
715}
716
717/* MPI_Type_extent: return ub-lb, plus padding
718 */
719FC_FUNC( mpi_type_extent, MPI_TYPE_EXTENT)(int * type, long * extent, int * ierr)
720{
721  *ierr = MPI_Type_extent(*type, extent);
722}
723
724int MPI_Type_extent(MPI_Datatype type, MPI_Aint * extent)
725{
726  Datatype type_ptr = *(Datatype*) mpi_handle_to_datatype(type);
727
728  return Type_extent(type_ptr, extent);
729}
730
731int Type_extent(Datatype datatype, MPI_Aint * extent)
732{
733
734  if (!(datatype->o_lb || datatype->o_ub))
735  {
736    int epsilon = calc_padding(datatype);
737    //current epsilon value is based off of largest datatype size
738    int mod = (datatype->ub - datatype->lb) % epsilon;
739    if (mod == 0)
740      epsilon = 0;
741    else
742      epsilon = epsilon - mod;
743    *extent = (datatype->ub - datatype->lb) + epsilon;
744  }
745  else
746  {
747    *extent = datatype->ub - datatype->lb;
748  }
749
750  return MPI_SUCCESS;
751}
752
753/* True_extent returns an extent based only on
754 * calculated upper and lower bound, regardless of any
755 * override using MPI_LB or MPI_UB
756 */
757int Type_get_true_extent(Datatype type, MPI_Aint * extent)
758{
759  long epsilon = calc_padding(type);
760  long ub = calc_ub(type);
761  long lb = calc_lb(type);
762  //current epsilon value is based off of largest datatype size
763  long mod = (ub - lb) % epsilon;
764  if (mod == 0)
765    epsilon = 0;
766  else
767    epsilon = epsilon - mod;
768  *extent = (ub - lb) + epsilon;
769
770  return MPI_SUCCESS;
771}
772
773/***********************/
774
775FC_FUNC( mpi_type_commit, MPI_TYPE_COMMIT )(int * datatype, int * ierr)
776{
777  *ierr = MPI_Type_commit(datatype);
778}
779
780int MPI_Type_commit(MPI_Datatype * datatype)
781{
782  Datatype type_ptr = *(Datatype*) mpi_handle_to_datatype(*datatype);
783  (type_ptr)->committed = 1;
784
785  return MPI_SUCCESS;
786}
787
788/**********************/
789FC_FUNC( mpi_type_free, MPI_TYPE_FREE )(int * datatype, int * ierr)
790{
791  *ierr = MPI_Type_free(datatype);
792}
793
794int MPI_Type_free(MPI_Datatype * datatype)
795{
796  Datatype type_ptr = *(Datatype*) mpi_handle_to_datatype(*datatype);
797  free(type_ptr);
798  type_ptr = MPI_DATATYPE_NULL;
799
800  mpi_free_handle(*datatype);
801
802  return MPI_SUCCESS;
803}
804
805/* Print_typemap is used in test programs only when
806 * --enable-test-internal is enabled in configure.
807 */
808
809#ifdef TEST_INTERNAL
810FC_FUNC( print_typemap, PRINT_TYPEMAP )(int * type, int * ierr)
811{
812  *ierr = print_typemap(*type);
813}
814
815int print_typemap(MPI_Datatype type)
816{
817  Datatype type_ptr = *(Datatype*) mpi_handle_to_datatype(type);
818
819  return Pprint_typemap(type_ptr);
820}
821
822int Pprint_typemap(Datatype type)
823{
824  int i;
825  MPI_Aint extent;
826  Type_extent(type, &extent);
827
828  printf("Type with %d type pairs.\n>> lb is %d\n>> ub is %d\n>>"
829          "Extent is %d\n>>Epsilon based on %d\nTypemap: \n{",
830          type->count, type->lb, type->ub, extent, calc_padding(type));
831
832  for (i = 0; i < type->count; i++)
833  {
834    printf("(t%d:%d, o%d)", type->pairs[i].type,
835           Simpletype_length(type->pairs[i].type),
836           type->pairs[i].disp);
837
838    if (i != type->count-1)
839      printf(", ");
840  }
841  printf("}\n");
842
843  return MPI_SUCCESS;
844}
845#endif //TEST_INTERNAL
846
Note: See TracBrowser for help on using the repository browser.