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