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

   1 ! -*- Mode: Fortran; -*-
   2 !
   3 !  (C) 2007 by Argonne National Laboratory.
   4 !      See COPYRIGHT in top-level directory.
   5 !
   6 ! This program tests that the MPI_SIZEOF routine is implemented for the
   7 ! predefined scalar Fortran types.  It confirms that the size of these
   8 ! types matches the size of the corresponding MPI datatypes.
   9 !
  10       program main
  11       use mpi
  12       integer ierr, errs
  13       integer rank, size, mpisize
  14       logical verbose
  15       real    r1,r1v(2)
  16       double precision d1,d1v(3)
  17       complex c1,c1v(4)
  18       integer i1,i1v(5)
  19       character ch1,ch1v(6)
  20       logical l1,l1v(7)
  21
  22       verbose = .false.
  23       errs = 0
  24       call mtest_init ( ierr )
  25       call mpi_comm_rank( MPI_COMM_WORLD, rank, ierr )
  26
  27 ! Test of scalar types
  28       call mpi_sizeof( r1, size, ierr )
  29       call mpi_type_size( MPI_REAL, mpisize, ierr )
  30       if (size .ne. mpisize) then
  31          errs = errs + 1
  32          print *, "Size of MPI_REAL = ", mpisize,                         &
  33      &            " but MPI_SIZEOF gives ", size
  34       endif
  35
  36       call mpi_sizeof( d1, size, ierr )
  37       call mpi_type_size( MPI_DOUBLE_PRECISION, mpisize, ierr )
  38       if (size .ne. mpisize) then
  39          errs = errs + 1
  40          print *, "Size of MPI_DOUBLE_PRECISION = ", mpisize, &
  41               " but MPI_SIZEOF gives ", size
  42       endif
  43
  44       call mpi_sizeof( i1, size, ierr )
  45       call mpi_type_size( MPI_INTEGER, mpisize, ierr )
  46       if (size .ne. mpisize) then
  47          errs = errs + 1
  48          print *, "Size of MPI_INTEGER = ", mpisize,                      &
  49      &            " but MPI_SIZEOF gives ", size
  50       endif
  51
  52       call mpi_sizeof( c1, size, ierr )
  53       call mpi_type_size( MPI_COMPLEX, mpisize, ierr )
  54       if (size .ne. mpisize) then
  55          errs = errs + 1
  56          print *, "Size of MPI_COMPLEX = ", mpisize,                      &
  57      &            " but MPI_SIZEOF gives ", size
  58       endif
  59
  60       call mpi_sizeof( ch1, size, ierr )
  61       call mpi_type_size( MPI_CHARACTER, mpisize, ierr )
  62       if (size .ne. mpisize) then
  63          errs = errs + 1
  64          print *, "Size of MPI_CHARACTER = ", mpisize, &
  65               " but MPI_SIZEOF gives ", size
  66       endif
  67
  68       call mpi_sizeof( l1, size, ierr )
  69       call mpi_type_size( MPI_LOGICAL, mpisize, ierr )
  70       if (size .ne. mpisize) then
  71          errs = errs + 1
  72          print *, "Size of MPI_LOGICAL = ", mpisize,                        &
  73      &        " but MPI_SIZEOF gives ", size
  74       endif
  75 !
  76 ! Test of vector types (1-dimensional)
  77       call mpi_sizeof( r1v, size, ierr )
  78       call mpi_type_size( MPI_REAL, mpisize, ierr )
  79       if (size .ne. mpisize) then
  80          errs = errs + 1
  81          print *, "Size of MPI_REAL = ", mpisize,                         &
  82      &            " but MPI_SIZEOF gives ", size
  83       endif
  84
  85       call mpi_sizeof( d1v, size, ierr )
  86       call mpi_type_size( MPI_DOUBLE_PRECISION, mpisize, ierr )
  87       if (size .ne. mpisize) then
  88          errs = errs + 1
  89          print *, "Size of MPI_DOUBLE_PRECISION = ", mpisize, &
  90               " but MPI_SIZEOF gives ", size
  91       endif
  92
  93       call mpi_sizeof( i1v, size, ierr )
  94       call mpi_type_size( MPI_INTEGER, mpisize, ierr )
  95       if (size .ne. mpisize) then
  96          errs = errs + 1
  97          print *, "Size of MPI_INTEGER = ", mpisize,                      &
  98      &            " but MPI_SIZEOF gives ", size
  99       endif
 100
 101       call mpi_sizeof( c1v, size, ierr )
 102       call mpi_type_size( MPI_COMPLEX, mpisize, ierr )
 103       if (size .ne. mpisize) then
 104          errs = errs + 1
 105          print *, "Size of MPI_COMPLEX = ", mpisize,                      &
 106      &            " but MPI_SIZEOF gives ", size
 107       endif
 108
 109       call mpi_sizeof( ch1v, size, ierr )
 110       call mpi_type_size( MPI_CHARACTER, mpisize, ierr )
 111       if (size .ne. mpisize) then
 112          errs = errs + 1
 113          print *, "Size of MPI_CHARACTER = ", mpisize, &
 114               " but MPI_SIZEOF gives ", size
 115       endif
 116
 117       call mpi_sizeof( l1v, size, ierr )
 118       call mpi_type_size( MPI_LOGICAL, mpisize, ierr )
 119       if (size .ne. mpisize) then
 120          errs = errs + 1
 121          print *, "Size of MPI_LOGICAL = ", mpisize,                        &
 122      &        " but MPI_SIZEOF gives ", size
 123       endif
 124
 125       call mtest_finalize( errs )
 126       call mpi_finalize( ierr )
 127
 128       end