--- /dev/null
+C -*- Mode: Fortran; -*-
+C
+C (C) 2003 by Argonne National Laboratory.
+C See COPYRIGHT in top-level directory.
+C
+ program main
+ implicit none
+ include 'mpif.h'
+ integer errs, ierr, i, intsize
+ integer type1, type2, type3, type4, type5
+ integer max_asizev
+ parameter (max_asizev = 10)
+ include 'typeaints.h'
+ integer blocklens(max_asizev), dtypes(max_asizev)
+ integer displs(max_asizev)
+ integer recvbuf(6*max_asizev)
+ integer sendbuf(max_asizev), status(MPI_STATUS_SIZE)
+ integer rank, size
+
+ errs = 0
+
+ call mtest_init( ierr )
+
+ call mpi_comm_size( MPI_COMM_WORLD, size, ierr )
+ call mpi_comm_rank( MPI_COMM_WORLD, rank, ierr )
+C
+ call mpi_type_size( MPI_INTEGER, intsize, ierr )
+C
+ aintv(1) = 0
+ aintv(2) = 3 * intsize
+ call mpi_type_create_resized( MPI_INTEGER, aintv(1), aintv(2),
+ & type1, ierr )
+ call mpi_type_commit( type1, ierr )
+ aintv(1) = -1
+ aintv(2) = -1
+ call mpi_type_get_extent( type1, aintv(1), aintv(2), ierr )
+ if (aintv(1) .ne. 0) then
+ errs = errs + 1
+ print *, 'Did not get expected lb'
+ endif
+ if (aintv(2) .ne. 3*intsize) then
+ errs = errs + 1
+ print *, 'Did not get expected extent'
+ endif
+ aintv(1) = -1
+ aintv(2) = -1
+ call mpi_type_get_true_extent( type1, aintv(1), aintv(2), ierr )
+ if (aintv(1) .ne. 0) then
+ errs = errs + 1
+ print *, 'Did not get expected true lb'
+ endif
+ if (aintv(2) .ne. intsize) then
+ errs = errs + 1
+ print *, 'Did not get expected true extent (', aintv(2), ') ',
+ & ' expected ', intsize
+ endif
+C
+ do i=1,10
+ blocklens(i) = 1
+ aintv(i) = (i-1) * 3 * intsize
+ enddo
+ call mpi_type_create_hindexed( 10, blocklens, aintv,
+ & MPI_INTEGER, type2, ierr )
+ call mpi_type_commit( type2, ierr )
+C
+ aint = 3 * intsize
+ call mpi_type_create_hvector( 10, 1, aint, MPI_INTEGER, type3,
+ & ierr )
+ call mpi_type_commit( type3, ierr )
+C
+ do i=1,10
+ blocklens(i) = 1
+ dtypes(i) = MPI_INTEGER
+ aintv(i) = (i-1) * 3 * intsize
+ enddo
+ call mpi_type_create_struct( 10, blocklens, aintv, dtypes,
+ & type4, ierr )
+ call mpi_type_commit( type4, ierr )
+
+ do i=1,10
+ displs(i) = (i-1) * 3
+ enddo
+ call mpi_type_create_indexed_block( 10, 1, displs,
+ & MPI_INTEGER, type5, ierr )
+ call mpi_type_commit( type5, ierr )
+C
+C Using each time, send and receive using these types
+ do i=1, max_asizev*3
+ recvbuf(i) = -1
+ enddo
+ do i=1, max_asizev
+ sendbuf(i) = i
+ enddo
+ call mpi_sendrecv( sendbuf, max_asizev, MPI_INTEGER, rank, 0,
+ & recvbuf, max_asizev, type1, rank, 0,
+ & MPI_COMM_WORLD, status, ierr )
+ do i=1, max_asizev
+ if (recvbuf(1+(i-1)*3) .ne. i ) then
+ errs = errs + 1
+ print *, 'type1:', i, 'th element = ', recvbuf(1+(i-1)*3)
+ endif
+ enddo
+C
+ do i=1, max_asizev*3
+ recvbuf(i) = -1
+ enddo
+ do i=1, max_asizev
+ sendbuf(i) = i
+ enddo
+ call mpi_sendrecv( sendbuf, max_asizev, MPI_INTEGER, rank, 0,
+ & recvbuf, 1, type2, rank, 0,
+ & MPI_COMM_WORLD, status, ierr )
+ do i=1, max_asizev
+ if (recvbuf(1+(i-1)*3) .ne. i ) then
+ errs = errs + 1
+ print *, 'type2:', i, 'th element = ', recvbuf(1+(i-1)*3)
+ endif
+ enddo
+C
+ do i=1, max_asizev*3
+ recvbuf(i) = -1
+ enddo
+ do i=1, max_asizev
+ sendbuf(i) = i
+ enddo
+ call mpi_sendrecv( sendbuf, max_asizev, MPI_INTEGER, rank, 0,
+ & recvbuf, 1, type3, rank, 0,
+ & MPI_COMM_WORLD, status, ierr )
+ do i=1, max_asizev
+ if (recvbuf(1+(i-1)*3) .ne. i ) then
+ errs = errs + 1
+ print *, 'type3:', i, 'th element = ', recvbuf(1+(i-1)*3)
+ endif
+ enddo
+C
+ do i=1, max_asizev*3
+ recvbuf(i) = -1
+ enddo
+ do i=1, max_asizev
+ sendbuf(i) = i
+ enddo
+ call mpi_sendrecv( sendbuf, max_asizev, MPI_INTEGER, rank, 0,
+ & recvbuf, 1, type4, rank, 0,
+ & MPI_COMM_WORLD, status, ierr )
+ do i=1, max_asizev
+ if (recvbuf(1+(i-1)*3) .ne. i ) then
+ errs = errs + 1
+ print *, 'type4:', i, 'th element = ', recvbuf(1+(i-1)*3)
+ endif
+ enddo
+C
+ do i=1, max_asizev*3
+ recvbuf(i) = -1
+ enddo
+ do i=1, max_asizev
+ sendbuf(i) = i
+ enddo
+ call mpi_sendrecv( sendbuf, max_asizev, MPI_INTEGER, rank, 0,
+ & recvbuf, 1, type5, rank, 0,
+ & MPI_COMM_WORLD, status, ierr )
+ do i=1, max_asizev
+ if (recvbuf(1+(i-1)*3) .ne. i ) then
+ errs = errs + 1
+ print *, 'type5:', i, 'th element = ', recvbuf(1+(i-1)*3)
+ endif
+ enddo
+C
+ call mpi_type_free( type1, ierr )
+ call mpi_type_free( type2, ierr )
+ call mpi_type_free( type3, ierr )
+ call mpi_type_free( type4, ierr )
+ call mpi_type_free( type5, ierr )
+
+ call mtest_finalize( errs )
+ call mpi_finalize( ierr )
+
+ end