teshsuite/smpi/mpich-test/pt2pt/typebasef.f

   1 C
   2 C Fortran program to test the basic Fortran types
   3 C
   4       subroutine SetupBasicTypes( basictypes, basicnames )
   5       include 'mpif.h'
   6       integer basictypes(*)
   7       character*40 basicnames(*)
   8 C
   9       basictypes(1) = MPI_INTEGER
  10       basictypes(2) = MPI_REAL
  11       basictypes(3) = MPI_DOUBLE_PRECISION
  12       basictypes(4) = MPI_COMPLEX
  13       basictypes(5) = MPI_LOGICAL
  14       basictypes(6) = MPI_CHARACTER
  15       basictypes(7) = MPI_BYTE
  16       basictypes(8) = MPI_PACKED
  17 C
  18       basicnames(1) = 'INTEGER'
  19       basicnames(2) = 'REAL'
  20       basicnames(3) = 'DOUBLE PRECISION'
  21       basicnames(4) = 'COMPLEX'
  22       basicnames(5) = 'LOGICAL'
  23       basicnames(6) = 'CHARACTER'
  24       basicnames(7) = 'BYTE'
  25       basicnames(8) = 'PACKED'
  26 C
  27       return
  28       end
  29 C
  30       program main
  31       include 'mpif.h'
  32       integer basictypes(8)
  33       character*40 basicnames(8)
  34       integer i, errcnt, ierr
  35       integer size, extent, ub, lb
  36 C
  37       call mpi_init(ierr)
  38 C
  39       call SetupBasicTypes( basictypes, basicnames )
  40 C
  41       errcnt = 0
  42       do 10 i=1,8
  43          call MPI_Type_size( BasicTypes(i), size, ierr )
  44          call MPI_Type_extent( BasicTypes(i), extent, ierr )
  45          call MPI_Type_lb( BasicTypes(i), lb, ierr )
  46          call MPI_Type_ub( BasicTypes(i), ub, ierr )
  47          if (size .ne. extent) then
  48             errcnt = errcnt + 1
  49             print *, "size (", size, ") != extent (", extent,
  50      *         ") for basic type ", basicnames(i)
  51          endif
  52          if (lb .ne. 0) then
  53             errcnt = errcnt + 1
  54             print *, "Lowerbound of ", basicnames(i), " was ", lb,
  55      *         " instead of 0"
  56          endif
  57          if (ub .ne. extent) then
  58             errcnt = errcnt + 1
  59             print *, "Upperbound of ", basicnames(i), " was ",
  60      *        ub, " instead of ", extent
  61          endif
  62  10   continue
  63 C
  64       if (errcnt .gt. 0) then
  65          print *, "Found ", errcnt, " errors in testing Fortran types"
  66       else
  67          print *, " Found no errors in basic Fortran "
  68       endif
  69 C
  70       call mpi_finalize(ierr)
  71       end