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