Blame test/mpi/f08/info/infotestf90.f90

Packit Service c5cf8c
! -*- Mode: Fortran; -*-
Packit Service c5cf8c
!
Packit Service c5cf8c
!  (C) 2014 by Argonne National Laboratory.
Packit Service c5cf8c
!      See COPYRIGHT in top-level directory.
Packit Service c5cf8c
!
Packit Service c5cf8c
! Simple info test
Packit Service c5cf8c
       program main
Packit Service c5cf8c
       use mpi_f08
Packit Service c5cf8c
       type(MPI_Info) i1, i2
Packit Service c5cf8c
       integer i, errs, ierr
Packit Service c5cf8c
       integer valuelen
Packit Service c5cf8c
       parameter (valuelen=64)
Packit Service c5cf8c
       character*(valuelen) value
Packit Service c5cf8c
       logical flag
Packit Service c5cf8c
!
Packit Service c5cf8c
       errs = 0
Packit Service c5cf8c
Packit Service c5cf8c
       call MTest_Init( ierr )
Packit Service c5cf8c
Packit Service c5cf8c
       call mpi_info_create( i1, ierr )
Packit Service c5cf8c
       call mpi_info_create( i2, ierr )
Packit Service c5cf8c
Packit Service c5cf8c
       call mpi_info_set( i1, "key1", "value1", ierr )
Packit Service c5cf8c
       call mpi_info_set( i2, "key2", "value2", ierr )
Packit Service c5cf8c
Packit Service c5cf8c
       call mpi_info_get( i1, "key2", valuelen, value, flag, ierr )
Packit Service c5cf8c
       if (flag) then
Packit Service c5cf8c
          print *, "Found key2 in info1"
Packit Service c5cf8c
          errs = errs + 1
Packit Service c5cf8c
       endif
Packit Service c5cf8c
Packit Service c5cf8c
       call MPI_Info_get( i1, "key1", 64, value, flag, ierr )
Packit Service c5cf8c
       if (.not. flag ) then
Packit Service c5cf8c
          print *, "Did not find key1 in info1"
Packit Service c5cf8c
          errs = errs + 1
Packit Service c5cf8c
       else
Packit Service c5cf8c
          if (value .ne. "value1") then
Packit Service c5cf8c
             print *, "Found wrong value (", value, "), expected value1"
Packit Service c5cf8c
             errs = errs + 1
Packit Service c5cf8c
          else
Packit Service c5cf8c
!     check for trailing blanks
Packit Service c5cf8c
             do i=7,valuelen
Packit Service c5cf8c
                if (value(i:i) .ne. " ") then
Packit Service c5cf8c
                   print *, "Found non blank in info value"
Packit Service c5cf8c
                   errs = errs + 1
Packit Service c5cf8c
                endif
Packit Service c5cf8c
             enddo
Packit Service c5cf8c
          endif
Packit Service c5cf8c
       endif
Packit Service c5cf8c
Packit Service c5cf8c
       call mpi_info_free( i1, ierr )
Packit Service c5cf8c
       call mpi_info_free( i2, ierr )
Packit Service c5cf8c
Packit Service c5cf8c
       call MTest_Finalize( errs )
Packit Service c5cf8c
       end