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