1! 2! (C) 2004 by Argonne National Laboratory. 3! See COPYRIGHT in top-level directory. 4! 5 program main 6 use mpi 7 integer ierr 8 integer errs 9 integer nints, nadds, ndtypes, combiner 10 integer nparms(2), dummy(1) 11 integer (kind=MPI_ADDRESS_KIND) adummy(1) 12 integer ntype1, nsize, ntype2, ntype3, i 13! 14! Test the Type_create_f90_xxx routines 15! 16 errs = 0 17 call mtest_init( ierr ) 18 19! integers with upto 9 are 4 bytes integers; r of 4 are 2 byte, 20! and r of 2 is 1 byte 21 call mpi_type_create_f90_integer( 9, ntype1, ierr ) 22! 23! Check with get contents and envelope... 24 call mpi_type_get_envelope( ntype1, nints, nadds, ndtypes, & 25 combiner, ierr ) 26 if (nadds .ne. 0) then 27 errs = errs + 1 28 print *, "There should be no addresses on created type (r=9)" 29 endif 30 if (ndtypes .ne. 0) then 31 errs = errs + 1 32 print *, "There should be no datatypes on created type (r=9)" 33 endif 34 if (nints .ne. 1) then 35 errs = errs + 1 36 print *, "There should be exactly 1 integer on create type (r=9)" 37 endif 38 if (combiner .ne. MPI_COMBINER_F90_INTEGER) then 39 errs = errs + 1 40 print *, "The combiner should be INTEGER, not ", combiner 41 endif 42 if (nints .eq. 1) then 43 call mpi_type_get_contents( ntype1, 1, 0, 0, & 44 nparms, adummy, dummy, ierr ) 45 if (nparms(1) .ne. 9) then 46 errs = errs + 1 47 print *, "parameter was ", nparms(1), " should be 9" 48 endif 49 endif 50 51 call mpi_type_create_f90_integer( 8, ntype2, ierr ) 52 if (ntype1 .eq. ntype2) then 53 errs = errs + 1 54 print *, "Types with r = 8 and r = 9 are the same, ", & 55 "should be distinct" 56 endif 57 58! 59! Check that we don't create new types each time. This test will fail only 60! if the MPI implementation checks for un-freed types or runs out of space 61 do i=1, 100000 62 call mpi_type_create_f90_integer( 8, ntype3, ierr ) 63 enddo 64 65 call mtest_finalize( errs ) 66 call mpi_finalize( ierr ) 67 68 end 69