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

   1 ! This file created from test/mpi/f77/datatype/allctypesf.f with f77tof90
   2 ! -*- Mode: Fortran; -*-
   3 !
   4 !  (C) 2004 by Argonne National Laboratory.
   5 !      See COPYRIGHT in top-level directory.
   6 !
   7       program main
   8       use mpi
   9       integer atype, ierr
  10 !
  11       call mtest_init(ierr)
  12       call mpi_comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN,  &
  13       &                              ierr )
  14 !
  15 !     Check that all Ctypes are available in Fortran (MPI 2.1, p 483, line 46)
  16 !
  17        call checkdtype( MPI_CHAR, "MPI_CHAR", ierr )
  18        call checkdtype( MPI_SIGNED_CHAR, "MPI_SIGNED_CHAR", ierr )
  19        call checkdtype( MPI_UNSIGNED_CHAR, "MPI_UNSIGNED_CHAR", ierr )
  20        call checkdtype( MPI_BYTE, "MPI_BYTE", ierr )
  21        call checkdtype( MPI_WCHAR, "MPI_WCHAR", ierr )
  22        call checkdtype( MPI_SHORT, "MPI_SHORT", ierr )
  23        call checkdtype( MPI_UNSIGNED_SHORT, "MPI_UNSIGNED_SHORT", ierr )
  24        call checkdtype( MPI_INT, "MPI_INT", ierr )
  25        call checkdtype( MPI_UNSIGNED, "MPI_UNSIGNED", ierr )
  26        call checkdtype( MPI_LONG, "MPI_LONG", ierr )
  27        call checkdtype( MPI_UNSIGNED_LONG, "MPI_UNSIGNED_LONG", ierr )
  28        call checkdtype( MPI_FLOAT, "MPI_FLOAT", ierr )
  29        call checkdtype( MPI_DOUBLE, "MPI_DOUBLE", ierr )
  30        if (MPI_LONG_DOUBLE .ne. MPI_DATATYPE_NULL) then
  31          call checkdtype( MPI_LONG_DOUBLE, "MPI_LONG_DOUBLE", ierr )
  32        endif
  33        if (MPI_LONG_LONG_INT .ne. MPI_DATATYPE_NULL) then
  34          call checkdtype2( MPI_LONG_LONG_INT, "MPI_LONG_LONG_INT",  &
  35       &                     "MPI_LONG_LONG", ierr )
  36        endif
  37        if (MPI_UNSIGNED_LONG_LONG .ne. MPI_DATATYPE_NULL) then
  38          call checkdtype( MPI_UNSIGNED_LONG_LONG,  &
  39       &                    "MPI_UNSIGNED_LONG_LONG", ierr )
  40        endif
  41        if (MPI_LONG_LONG .ne. MPI_DATATYPE_NULL) then
  42          call checkdtype2( MPI_LONG_LONG, "MPI_LONG_LONG",  &
  43       &                     "MPI_LONG_LONG_INT", ierr )
  44        endif
  45        call checkdtype( MPI_PACKED, "MPI_PACKED", ierr )
  46        call checkdtype( MPI_LB, "MPI_LB", ierr )
  47        call checkdtype( MPI_UB, "MPI_UB", ierr )
  48        call checkdtype( MPI_FLOAT_INT, "MPI_FLOAT_INT", ierr )
  49        call checkdtype( MPI_DOUBLE_INT, "MPI_DOUBLE_INT", ierr )
  50        call checkdtype( MPI_LONG_INT, "MPI_LONG_INT", ierr )
  51        call checkdtype( MPI_SHORT_INT, "MPI_SHORT_INT", ierr )
  52        call checkdtype( MPI_2INT, "MPI_2INT", ierr )
  53        if (MPI_LONG_DOUBLE_INT .ne. MPI_DATATYPE_NULL) then
  54          call checkdtype( MPI_LONG_DOUBLE_INT, "MPI_LONG_DOUBLE_INT", &
  55       &                    ierr)
  56        endif
  57 !
  58 !     Check that all Ctypes are available in Fortran (MPI 2.2)
  59 !     Note that because of implicit declarations in Fortran, this
  60 !     code should compile even with pre MPI 2.2 implementations.
  61 !
  62        if (MPI_VERSION .gt. 2 .or. (MPI_VERSION .eq. 2 .and.  &
  63       &      MPI_SUBVERSION .ge. 2)) then
  64           call checkdtype( MPI_INT8_T, "MPI_INT8_T", ierr )
  65           call checkdtype( MPI_INT16_T, "MPI_INT16_T", ierr )
  66           call checkdtype( MPI_INT32_T, "MPI_INT32_T", ierr )
  67           call checkdtype( MPI_INT64_T, "MPI_INT64_T", ierr )
  68           call checkdtype( MPI_UINT8_T, "MPI_UINT8_T", ierr )
  69           call checkdtype( MPI_UINT16_T, "MPI_UINT16_T", ierr )
  70           call checkdtype( MPI_UINT32_T, "MPI_UINT32_T", ierr )
  71           call checkdtype( MPI_UINT64_T, "MPI_UINT64_T", ierr )
  72 ! other C99 types
  73           call checkdtype( MPI_C_BOOL, "MPI_C_BOOL", ierr )
  74           call checkdtype( MPI_C_FLOAT_COMPLEX, "MPI_C_FLOAT_COMPLEX", &
  75       &                     ierr)
  76           call checkdtype2( MPI_C_COMPLEX, "MPI_C_COMPLEX",  &
  77       &                      "MPI_C_FLOAT_COMPLEX", ierr )
  78           call checkdtype( MPI_C_DOUBLE_COMPLEX, "MPI_C_DOUBLE_COMPLEX",  &
  79       &                     ierr )
  80           if (MPI_C_LONG_DOUBLE_COMPLEX .ne. MPI_DATATYPE_NULL) then
  81             call checkdtype( MPI_C_LONG_DOUBLE_COMPLEX,  &
  82       &                       "MPI_C_LONG_DOUBLE_COMPLEX", ierr )
  83           endif
  84 ! address/offset types
  85           call checkdtype( MPI_AINT, "MPI_AINT", ierr )
  86           call checkdtype( MPI_OFFSET, "MPI_OFFSET", ierr )
  87        endif
  88 !
  89        call mtest_finalize( ierr )
  90        call MPI_Finalize( ierr )
  91        end
  92 !
  93 ! Check name of datatype
  94       subroutine CheckDtype( intype, name, ierr )
  95       use mpi
  96       integer intype, ierr
  97       character *(*) name
  98       integer ir, rlen
  99       character *(MPI_MAX_OBJECT_NAME) outname
 100 !
 101       outname = ""
 102       call MPI_TYPE_GET_NAME( intype, outname, rlen, ir )
 103       if (ir .ne. MPI_SUCCESS) then
 104          print *, " Datatype ", name, " not available in Fortran"
 105          ierr = ierr + 1
 106       else
 107          if (outname .ne. name) then
 108             print *, " For datatype ", name, " found name ", &
 109       &           outname(1:rlen)
 110             ierr = ierr + 1
 111          endif
 112       endif
 113
 114       return
 115       end
 116 !
 117 ! Check name of datatype (allows alias)
 118       subroutine CheckDtype2( intype, name, name2, ierr )
 119       use mpi
 120       integer intype, ierr
 121       character *(*) name, name2
 122       integer ir, rlen
 123       character *(MPI_MAX_OBJECT_NAME) outname
 124 !
 125       outname = ""
 126       call MPI_TYPE_GET_NAME( intype, outname, rlen, ir )
 127       if (ir .ne. MPI_SUCCESS) then
 128          print *, " Datatype ", name, " not available in Fortran"
 129          ierr = ierr + 1
 130       else
 131          if (outname .ne. name .and. outname .ne. name2) then
 132             print *, " For datatype ", name, " found name ", &
 133       &           outname(1:rlen)
 134             ierr = ierr + 1
 135          endif
 136       endif
 137
 138       return
 139       end