teshsuite/smpi/mpich3-test/f77/datatype/typenamef.f

   1 C -*- Mode: Fortran; -*-
   2 C
   3 C
   4 C  (C) 2003 by Argonne National Laboratory.
   5 C      See COPYRIGHT in top-level directory.
   6 C
   7       program main
   8       implicit none
   9       include 'mpif.h'
  10       character*(MPI_MAX_OBJECT_NAME) name
  11       integer namelen
  12       integer ierr, errs
  13
  14       errs = 0
  15
  16       call mtest_init( ierr )
  17 C
  18 C Check each Fortran datatype, including the size-specific ones
  19 C See the C version (typename.c) for the relevant MPI sections
  20
  21       call MPI_Type_get_name( MPI_COMPLEX, name, namelen, ierr )
  22       if (name(1:namelen) .ne. "MPI_COMPLEX") then
  23            errs = errs + 1
  24            print *, "Expected MPI_COMPLEX but got "//name(1:namelen)
  25       endif
  26
  27       call MPI_Type_get_name( MPI_DOUBLE_COMPLEX, name, namelen, ierr )
  28       if (name(1:namelen) .ne. "MPI_DOUBLE_COMPLEX") then
  29            errs = errs + 1
  30            print *, "Expected MPI_DOUBLE_COMPLEX but got "//
  31      &          name(1:namelen)
  32       endif
  33
  34       call MPI_Type_get_name( MPI_LOGICAL, name, namelen, ierr )
  35       if (name(1:namelen) .ne. "MPI_LOGICAL") then
  36            errs = errs + 1
  37            print *, "Expected MPI_LOGICAL but got "//name(1:namelen)
  38       endif
  39
  40       call MPI_Type_get_name( MPI_REAL, name, namelen, ierr )
  41       if (name(1:namelen) .ne. "MPI_REAL") then
  42            errs = errs + 1
  43            print *, "Expected MPI_REAL but got "//name(1:namelen)
  44       endif
  45
  46       call MPI_Type_get_name( MPI_DOUBLE_PRECISION, name, namelen, ierr)
  47       if (name(1:namelen) .ne. "MPI_DOUBLE_PRECISION") then
  48            errs = errs + 1
  49            print *, "Expected MPI_DOUBLE_PRECISION but got "//
  50      &          name(1:namelen)
  51       endif
  52
  53       call MPI_Type_get_name( MPI_INTEGER, name, namelen, ierr )
  54       if (name(1:namelen) .ne. "MPI_INTEGER") then
  55            errs = errs + 1
  56            print *, "Expected MPI_INTEGER but got "//name(1:namelen)
  57       endif
  58
  59       call MPI_Type_get_name( MPI_2INTEGER, name, namelen, ierr )
  60       if (name(1:namelen) .ne. "MPI_2INTEGER") then
  61            errs = errs + 1
  62            print *, "Expected MPI_2INTEGER but got "//name(1:namelen)
  63       endif
  64
  65 C 2COMPLEX was present only in MPI 1.0
  66 C      call MPI_Type_get_name( MPI_2COMPLEX, name, namelen, ierr )
  67 C      if (name(1:namelen) .ne. "MPI_2COMPLEX") then
  68 C           errs = errs + 1
  69 C           print *, "Expected MPI_2COMPLEX but got "//name(1:namelen)
  70 C      endif
  71 C
  72       call MPI_Type_get_name(MPI_2DOUBLE_PRECISION, name, namelen, ierr)
  73       if (name(1:namelen) .ne. "MPI_2DOUBLE_PRECISION") then
  74            errs = errs + 1
  75            print *, "Expected MPI_2DOUBLE_PRECISION but got "//
  76      &          name(1:namelen)
  77       endif
  78
  79       call MPI_Type_get_name( MPI_2REAL, name, namelen, ierr )
  80       if (name(1:namelen) .ne. "MPI_2REAL") then
  81            errs = errs + 1
  82            print *, "Expected MPI_2REAL but got "//name(1:namelen)
  83       endif
  84
  85 C 2DOUBLE_COMPLEX isn't in MPI 2.1
  86 C      call MPI_Type_get_name( MPI_2DOUBLE_COMPLEX, name, namelen, ierr )
  87 C      if (name(1:namelen) .ne. "MPI_2DOUBLE_COMPLEX") then
  88 C           errs = errs + 1
  89 C           print *, "Expected MPI_2DOUBLE_COMPLEX but got "//
  90 C     &          name(1:namelen)
  91 C      endif
  92
  93       call MPI_Type_get_name( MPI_CHARACTER, name, namelen, ierr )
  94       if (name(1:namelen) .ne. "MPI_CHARACTER") then
  95            errs = errs + 1
  96            print *, "Expected MPI_CHARACTER but got "//name(1:namelen)
  97       endif
  98
  99       call MPI_Type_get_name( MPI_BYTE, name, namelen, ierr )
 100       if (name(1:namelen) .ne. "MPI_BYTE") then
 101            errs = errs + 1
 102            print *, "Expected MPI_BYTE but got "//name(1:namelen)
 103       endif
 104
 105       if (MPI_REAL4 .ne. MPI_DATATYPE_NULL) then
 106           call MPI_Type_get_name( MPI_REAL4, name, namelen, ierr )
 107           if (name(1:namelen) .ne. "MPI_REAL4") then
 108                errs = errs + 1
 109                print *, "Expected MPI_REAL4 but got "//name(1:namelen)
 110           endif
 111       endif
 112
 113       if (MPI_REAL8 .ne. MPI_DATATYPE_NULL) then
 114           call MPI_Type_get_name( MPI_REAL8, name, namelen, ierr )
 115           if (name(1:namelen) .ne. "MPI_REAL8") then
 116                errs = errs + 1
 117                print *, "Expected MPI_REAL8 but got "//name(1:namelen)
 118           endif
 119       endif
 120
 121       if (MPI_REAL16 .ne. MPI_DATATYPE_NULL) then
 122           call MPI_Type_get_name( MPI_REAL16, name, namelen, ierr )
 123           if (name(1:namelen) .ne. "MPI_REAL16") then
 124                errs = errs + 1
 125                print *, "Expected MPI_REAL16 but got "//name(1:namelen)
 126           endif
 127       endif
 128
 129       if (MPI_COMPLEX8 .ne. MPI_DATATYPE_NULL) then
 130           call MPI_Type_get_name( MPI_COMPLEX8, name, namelen, ierr )
 131           if (name(1:namelen) .ne. "MPI_COMPLEX8") then
 132                errs = errs + 1
 133                print *, "Expected MPI_COMPLEX8 but got "//
 134      &              name(1:namelen)
 135           endif
 136       endif
 137
 138       if (MPI_COMPLEX16 .ne. MPI_DATATYPE_NULL) then
 139           call MPI_Type_get_name( MPI_COMPLEX16, name, namelen, ierr )
 140           if (name(1:namelen) .ne. "MPI_COMPLEX16") then
 141                errs = errs + 1
 142                print *, "Expected MPI_COMPLEX16 but got "//
 143      &              name(1:namelen)
 144           endif
 145       endif
 146
 147       if (MPI_COMPLEX32 .ne. MPI_DATATYPE_NULL) then
 148           call MPI_Type_get_name( MPI_COMPLEX32, name, namelen, ierr )
 149           if (name(1:namelen) .ne. "MPI_COMPLEX32") then
 150                errs = errs + 1
 151                print *, "Expected MPI_COMPLEX32 but got "//
 152      &              name(1:namelen)
 153           endif
 154       endif
 155
 156       if (MPI_INTEGER1 .ne. MPI_DATATYPE_NULL) then
 157           call MPI_Type_get_name( MPI_INTEGER1, name, namelen, ierr )
 158           if (name(1:namelen) .ne. "MPI_INTEGER1") then
 159                errs = errs + 1
 160                print *, "Expected MPI_INTEGER1 but got "//
 161      &              name(1:namelen)
 162           endif
 163       endif
 164
 165       if (MPI_INTEGER2 .ne. MPI_DATATYPE_NULL) then
 166           call MPI_Type_get_name( MPI_INTEGER2, name, namelen, ierr )
 167           if (name(1:namelen) .ne. "MPI_INTEGER2") then
 168                errs = errs + 1
 169                print *, "Expected MPI_INTEGER2 but got "//
 170      &              name(1:namelen)
 171           endif
 172       endif
 173
 174       if (MPI_INTEGER4 .ne. MPI_DATATYPE_NULL) then
 175           call MPI_Type_get_name( MPI_INTEGER4, name, namelen, ierr )
 176           if (name(1:namelen) .ne. "MPI_INTEGER4") then
 177                errs = errs + 1
 178                print *, "Expected MPI_INTEGER4 but got "//
 179      &              name(1:namelen)
 180           endif
 181       endif
 182
 183       if (MPI_INTEGER8 .ne. MPI_DATATYPE_NULL) then
 184           call MPI_Type_get_name( MPI_INTEGER8, name, namelen, ierr )
 185           if (name(1:namelen) .ne. "MPI_INTEGER8") then
 186                errs = errs + 1
 187                print *, "Expected MPI_INTEGER8 but got "//
 188      &              name(1:namelen)
 189           endif
 190       endif
 191
 192 C MPI_INTEGER16 is in MPI 2.1, but it is missing from most tables
 193 C Some MPI implementations may not provide it
 194 C      if (MPI_INTEGER16 .ne. MPI_DATATYPE_NULL) then
 195 C          call MPI_Type_get_name( MPI_INTEGER16, name, namelen, ierr )
 196 C          if (name(1:namelen) .ne. "MPI_INTEGER16") then
 197 C               errs = errs + 1
 198 C               print *, "Expected MPI_INTEGER16 but got "//
 199 C     &              name(1:namelen)
 200 C          endif
 201 C      endif
 202
 203       call mtest_finalize( errs )
 204       call MPI_Finalize( ierr )
 205       end