Blame test/mpi/f08/ext/allocmemf90.f90

Packit Service c5cf8c
! -*- Mode: Fortran; -*-
Packit Service c5cf8c
!
Packit Service c5cf8c
!  (C) 2014 by Argonne National Laboratory.
Packit Service c5cf8c
!      See COPYRIGHT in top-level directory.
Packit Service c5cf8c
!
Packit Service c5cf8c
        program main
Packit Service c5cf8c
        use mpi_f08
Packit Service c5cf8c
        use, intrinsic :: iso_c_binding
Packit Service c5cf8c
        real, pointer :: a(:,:)
Packit Service c5cf8c
        integer (kind=MPI_ADDRESS_KIND) asize
Packit Service c5cf8c
        type(c_ptr) cptr
Packit Service c5cf8c
Packit Service c5cf8c
        integer ierr, sizeofreal, errs
Packit Service c5cf8c
        integer i,j
Packit Service c5cf8c
!
Packit Service c5cf8c
        errs = 0
Packit Service c5cf8c
        call mtest_init(ierr)
Packit Service c5cf8c
        call mpi_type_size( MPI_REAL, sizeofreal, ierr )
Packit Service c5cf8c
! Make sure we pass in an integer of the correct type
Packit Service c5cf8c
        asize = sizeofreal * 100 * 100
Packit Service c5cf8c
        call mpi_alloc_mem( asize,MPI_INFO_NULL,cptr,ierr )
Packit Service c5cf8c
Packit Service c5cf8c
        call c_f_pointer(cptr, a, [100, 100])
Packit Service c5cf8c
Packit Service c5cf8c
        do i=1,100
Packit Service c5cf8c
            do j=1,100
Packit Service c5cf8c
                a(i,j) = -1
Packit Service c5cf8c
            enddo
Packit Service c5cf8c
        enddo
Packit Service c5cf8c
        a(3,5) = 10.0
Packit Service c5cf8c
Packit Service c5cf8c
        call mpi_free_mem( a, ierr )
Packit Service c5cf8c
        call mtest_finalize(errs)
Packit Service c5cf8c
Packit Service c5cf8c
        end