infotest2f90.f90

mpi并行计算的c++代码 可用vc或gcc编译通过 可以用来搭建并行计算试验环境

! This file created from test/mpi/f77/info/infotest2f.f with f77tof90
! -*- Mode: Fortran; -*- 
!
!  (C) 2003 by Argonne National Laboratory.
!      See COPYRIGHT in top-level directory.
!
      program main
      use mpi
      integer ierr, errs
      integer i1, i2
      integer nkeys, i, j, sumindex, vlen, ln, valuelen
      logical found, flag
      character*(MPI_MAX_INFO_KEY) keys(6)
      character*(MPI_MAX_INFO_VAL) values(6)
      character*(MPI_MAX_INFO_KEY) mykey
      character*(MPI_MAX_INFO_VAL) myvalue
!
      data keys/"Key1", "key2", "KeY3", "A Key With Blanks","See Below", &
      &          "last"/
      data values/"value 1", "value 2", "VaLue 3", "key=valu:3","false", &
      &            "no test"/
!
      errs = 0

      call mtest_init( ierr )
      
! Note that the MPI standard requires that leading an trailing blanks
! are stripped from keys and values (Section 4.10, The Info Object)
!
! First, create and initialize an info
      call mpi_info_create( i1, ierr )
      call mpi_info_set( i1, keys(1), values(1), ierr )
      call mpi_info_set( i1, keys(2), values(2), ierr )
      call mpi_info_set( i1, keys(3), values(3), ierr )
      call mpi_info_set( i1, keys(4), values(4), ierr )
      call mpi_info_set( i1, " See Below", values(5), ierr )
      call mpi_info_set( i1, keys(6), " no test ", ierr )
!
      call mpi_info_get_nkeys( i1, nkeys, ierr )
      if (nkeys .ne. 6) then
         print *, 'Number of keys should be 6, is ', nkeys
      endif
      sumindex = 0
      do i=1, nkeys
!        keys are number from 0 to n-1, even in Fortran (Section 4.10)
         call mpi_info_get_nthkey( i1, i-1, mykey, ierr )
         found = .false.
         do j=1, 6
            if (mykey .eq. keys(j)) then
               found = .true.
               sumindex = sumindex + j
               call mpi_info_get_valuelen( i1, mykey, vlen, flag, ierr )
               if (.not.flag) then
                  errs = errs + 1
                  print *, ' no value for key', mykey
               else
                  call mpi_info_get( i1, mykey, MPI_MAX_INFO_VAL, &
      &                               myvalue, flag, ierr )
                  if (myvalue .ne. values(j)) then
                     errs = errs + 1
                     print *, 'Value for ', mykey, ' not expected'
                  else
                     do ln=MPI_MAX_INFO_VAL,1,-1
                        if (myvalue(ln:ln) .ne. ' ') then
                           if (vlen .ne. ln) then
                              errs = errs + 1
                              print *, 'length is ', ln,  &
      &                          ' but valuelen gave ',  vlen,  &
      &                          ' for key ', mykey
                           endif
                           goto 100
                        endif
                     enddo
 100                 continue
                  endif
               endif
            endif
         enddo
         if (.not.found) then
            print *, i, 'th key ', mykey, ' not in list'
         endif
      enddo
      if (sumindex .ne. 21) then
         errs = errs + 1
         print *, 'Not all keys found'
      endif
!
! delete 2, then dup, then delete 2 more
      call mpi_info_delete( i1, keys(1), ierr )
      call mpi_info_delete( i1, keys(2), ierr )
      call mpi_info_dup( i1, i2, ierr )
      call mpi_info_delete( i1, keys(3), ierr )
!
! check the contents of i2
! valuelen does not signal an error for unknown keys; instead, sets
! flag to false
      do i=1,2
         flag = .true.
         call mpi_info_get_valuelen( i2, keys(i), valuelen, flag, ierr )
         if (flag) then
            errs = errs + 1
            print *, 'Found unexpected key ', keys(i)
         endif
      enddo
      do i=3,6
         call mpi_info_get( i2, keys(i), MPI_MAX_INFO_VAL,  &
      &                      myvalue, flag, ierr )
         if (myvalue .ne. values(i)) then
            errs = errs + 1
            print *, 'Found wrong value (', myvalue, ') for key ',  &
      &               keys(i)
         endif
      enddo
!
!     Free info
      call mpi_info_free( i1, ierr )
      call mpi_info_free( i2, ierr )

      call mtest_finalize( errs )
      call mpi_finalize( ierr )

      end