1C
2C Copyright (C) by Argonne National Laboratory
3C     See COPYRIGHT in top-level directory
4C
5
6       program main
7       implicit none
8       include 'mpif.h'
9       integer ierr, provided, errs, rank, size
10       integer iv, isubv, qprovided
11       logical flag
12
13       errs = 0
14       flag = .true.
15       call mpi_finalized( flag, ierr )
16       if (flag) then
17          errs = errs + 1
18          print *, 'Returned true for finalized before init'
19       endif
20       flag = .true.
21       call mpi_initialized( flag, ierr )
22       if (flag) then
23          errs = errs + 1
24          print *, 'Return true for initialized before init'
25       endif
26
27       provided = -1
28       call mpi_init_thread( MPI_THREAD_MULTIPLE, provided, ierr )
29
30       if (provided .ne. MPI_THREAD_MULTIPLE .and.
31     &     provided .ne. MPI_THREAD_SERIALIZED .and.
32     &     provided .ne. MPI_THREAD_FUNNELED .and.
33     &     provided .ne. MPI_THREAD_SINGLE) then
34          errs = errs + 1
35          print *, ' Unrecognized value for provided = ', provided
36       endif
37
38       iv    = -1
39       isubv = -1
40       call mpi_get_version( iv, isubv, ierr )
41       if (iv .ne. MPI_VERSION .or. isubv .ne. MPI_SUBVERSION) then
42          errs = errs + 1
43          print *, 'Version in mpif.h and get_version do not agree'
44          print *, 'Version in mpif.h is ', MPI_VERSION, '.',
45     &              MPI_SUBVERSION
46          print *, 'Version in get_version is ', iv, '.', isubv
47       endif
48       if (iv .lt. 1 .or. iv .gt. 3) then
49          errs = errs + 1
50          print *, 'Version of MPI is invalid (=', iv, ')'
51       endif
52       if (isubv.lt.0 .or. isubv.gt.2) then
53          errs = errs + 1
54          print *, 'Subversion of MPI is invalid (=', isubv, ')'
55       endif
56
57       call mpi_comm_rank( MPI_COMM_WORLD, rank, ierr )
58       call mpi_comm_size( MPI_COMM_WORLD, size, ierr )
59
60       flag = .false.
61       call mpi_is_thread_main( flag, ierr )
62       if (.not.flag) then
63          errs = errs + 1
64          print *, 'is_thread_main returned false for main thread'
65       endif
66
67       call mpi_query_thread( qprovided, ierr )
68       if (qprovided .ne. provided) then
69          errs = errs + 1
70          print *,'query thread and init thread disagree on'//
71     &           ' thread level'
72       endif
73
74       call mpi_finalize( ierr )
75       flag = .false.
76       call mpi_finalized( flag, ierr )
77       if (.not. flag) then
78          errs = errs + 1
79          print *, 'finalized returned false after finalize'
80       endif
81
82       if (rank .eq. 0) then
83          if (errs .eq. 0) then
84             print *, ' No Errors'
85          else
86             print *, ' Found ', errs, ' errors'
87          endif
88       endif
89
90       end
91