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
|