teshsuite/smpi/mpich3-test/f77/rma/winnamef.f

   1 C -*- Mode: Fortran; -*-
   2 C
   3 C  (C) 2003 by Argonne National Laboratory.
   4 C      See COPYRIGHT in top-level directory.
   5 C
   6       program main
   7       implicit none
   8       include 'mpif.h'
   9       integer errs, ierr
  10       integer win, rlen, ln
  11       character*(MPI_MAX_OBJECT_NAME) cname
  12       integer buf(10)
  13       integer intsize
  14 C Include addsize defines asize as an address-sized integer
  15       include 'addsize.h'
  16       logical found
  17 C
  18       errs = 0
  19       call mtest_init( ierr )
  20 C
  21 C Create a window and get, set the names on it
  22 C
  23       call mpi_type_size( MPI_INTEGER, intsize, ierr )
  24       asize = 10
  25       call mpi_win_create( buf, asize, intsize,
  26      &     MPI_INFO_NULL, MPI_COMM_WORLD, win, ierr )
  27 C
  28 C     Check that there is no name yet
  29       cname = 'XXXXXX'
  30       rlen  = -1
  31       call mpi_win_get_name( win, cname, rlen, ierr )
  32       if (rlen .ne. 0) then
  33          errs = errs + 1
  34          print *, ' Did not get empty name from new window'
  35       else if (cname(1:6) .ne. 'XXXXXX') then
  36          found = .false.
  37          do ln=MPI_MAX_OBJECT_NAME,1,-1
  38             if (cname(ln:ln) .ne. ' ') then
  39                found = .true.
  40             endif
  41          enddo
  42          if (found) then
  43             errs = errs + 1
  44             print *, ' Found a non-empty name'
  45          endif
  46       endif
  47 C
  48 C Now, set a name and check it
  49       call mpi_win_set_name( win, 'MyName', ierr )
  50       cname = 'XXXXXX'
  51       rlen = -1
  52       call mpi_win_get_name( win, cname, rlen, ierr )
  53       if (rlen .ne. 6) then
  54          errs = errs + 1
  55          print *, ' Expected 6, got ', rlen, ' for rlen'
  56          if (rlen .gt. 0 .and. rlen .lt. MPI_MAX_OBJECT_NAME) then
  57             print *, ' Cname = ', cname(1:rlen)
  58          endif
  59       else if (cname(1:6) .ne. 'MyName') then
  60          errs = errs + 1
  61          print *, ' Expected MyName, got ', cname(1:6)
  62       else
  63          found = .false.
  64          do ln=MPI_MAX_OBJECT_NAME,7,-1
  65             if (cname(ln:ln) .ne. ' ') then
  66                found = .true.
  67             endif
  68          enddo
  69          if (found) then
  70             errs = errs + 1
  71             print *, ' window name is not blank padded'
  72          endif
  73       endif
  74 C
  75       call mpi_win_free( win, ierr )
  76       call mtest_finalize( errs )
  77       call mpi_finalize( ierr )
  78       end