teshsuite/smpi/mpich3-test/f90/datatype/typecntsf90.f90

   1 ! This file created from test/mpi/f77/datatype/typecntsf.f with f77tof90
   2 ! -*- Mode: Fortran; -*-
   3 !
   4 !  (C) 2003 by Argonne National Laboratory.
   5 !      See COPYRIGHT in top-level directory.
   6 !
   7        program main
   8        use mpi
   9        integer errs, ierr
  10        integer ntype1, ntype2
  11 !
  12 ! This is a very simple test that just tests that the contents/envelope
  13 ! routines can be called.  This should be upgraded to test the new
  14 ! MPI-2 datatype routines (which use address-sized integers)
  15 !
  16
  17        errs = 0
  18        call mtest_init( ierr )
  19
  20        call explore( MPI_INTEGER, MPI_COMBINER_NAMED, errs )
  21        call explore( MPI_BYTE, MPI_COMBINER_NAMED, errs )
  22        call mpi_type_vector( 10, 1, 30, MPI_DOUBLE_PRECISION, ntype1,  &
  23       &                       ierr )
  24        call explore( ntype1, MPI_COMBINER_VECTOR, errs )
  25        call mpi_type_dup( ntype1, ntype2, ierr )
  26        call explore( ntype2, MPI_COMBINER_DUP, errs )
  27        call mpi_type_free( ntype2, ierr )
  28        call mpi_type_free( ntype1, ierr )
  29
  30 !
  31        call mtest_finalize( errs )
  32        call mpi_finalize( ierr )
  33        end
  34 !
  35        subroutine explore( dtype, mycomb, errs )
  36        use mpi
  37        integer dtype, mycomb, errs
  38        integer ierr
  39        integer nints, nadds, ntype, combiner
  40        integer max_nints, max_dtypes, max_asizev
  41        parameter (max_nints = 10, max_dtypes = 10, max_asizev=10)
  42        integer intv(max_nints), dtypesv(max_dtypes)
  43        integer (kind=MPI_ADDRESS_KIND) aint, aintv(max_asizev)
  44
  45 !
  46        call mpi_type_get_envelope( dtype, nints, nadds, ntype, &
  47       &                             combiner, ierr )
  48 !
  49        if (combiner .ne. MPI_COMBINER_NAMED) then
  50           call mpi_type_get_contents( dtype,  &
  51       &         max_nints, max_asizev, max_dtypes, &
  52       &         intv, aintv, dtypesv, ierr )
  53 !
  54 !              dtypesv of constructed types must be free'd now
  55 !
  56           if (combiner .eq. MPI_COMBINER_DUP) then
  57              call mpi_type_free( dtypesv(1), ierr )
  58           endif
  59        endif
  60        if (combiner .ne. mycomb) then
  61           errs = errs + 1
  62           print *, ' Expected combiner ', mycomb, ' but got ', &
  63       &             combiner
  64        endif
  65 !
  66 ! List all combiner types to check that they are defined in mpif.h
  67        if (combiner .eq. MPI_COMBINER_NAMED) then
  68        else if (combiner .eq. MPI_COMBINER_DUP) then
  69        else if (combiner .eq. MPI_COMBINER_CONTIGUOUS) then
  70        else if (combiner .eq. MPI_COMBINER_VECTOR) then
  71        else if (combiner .eq. MPI_COMBINER_HVECTOR_INTEGER) then
  72        else if (combiner .eq. MPI_COMBINER_HVECTOR) then
  73        else if (combiner .eq. MPI_COMBINER_INDEXED) then
  74        else if (combiner .eq. MPI_COMBINER_HINDEXED_INTEGER) then
  75        else if (combiner .eq. MPI_COMBINER_HINDEXED) then
  76        else if (combiner .eq. MPI_COMBINER_INDEXED_BLOCK) then
  77        else if (combiner .eq. MPI_COMBINER_STRUCT_INTEGER) then
  78        else if (combiner .eq. MPI_COMBINER_STRUCT) then
  79        else if (combiner .eq. MPI_COMBINER_SUBARRAY) then
  80        else if (combiner .eq. MPI_COMBINER_DARRAY) then
  81        else if (combiner .eq. MPI_COMBINER_F90_REAL) then
  82        else if (combiner .eq. MPI_COMBINER_F90_COMPLEX) then
  83        else if (combiner .eq. MPI_COMBINER_F90_INTEGER) then
  84        else if (combiner .eq. MPI_COMBINER_RESIZED) then
  85        else
  86           errs = errs + 1
  87           print *, ' Unknown combiner ', combiner
  88        endif
  89
  90        return
  91        end