Blame test/mpi/f90/ext/allocmemf90.f90
|
Packit |
0848f5 |
! This file created from test/mpi/f77/ext/allocmemf.f with f77tof90
|
|
Packit |
0848f5 |
! -*- Mode: Fortran; -*-
|
|
Packit |
0848f5 |
!
|
|
Packit |
0848f5 |
! (C) 2004 by Argonne National Laboratory.
|
|
Packit |
0848f5 |
! See COPYRIGHT in top-level directory.
|
|
Packit |
0848f5 |
!
|
|
Packit |
0848f5 |
program main
|
|
Packit |
0848f5 |
use mpi
|
|
Packit |
0848f5 |
!
|
|
Packit |
0848f5 |
! This program makes use of a common (but not universal; g77 doesn't
|
|
Packit |
0848f5 |
! have it) extension: the "Cray" pointer. This allows MPI_Alloc_mem
|
|
Packit |
0848f5 |
! to allocate memory and return it to Fortran, where it can be used.
|
|
Packit |
0848f5 |
! As this is not standard Fortran, this test is not run by default.
|
|
Packit |
0848f5 |
! To run it, build (with a suitable compiler) and run with
|
|
Packit |
0848f5 |
! mpiexec -n 1 ./allocmemf
|
|
Packit |
0848f5 |
!
|
|
Packit |
0848f5 |
real a
|
|
Packit |
0848f5 |
pointer (p,a(100,100))
|
|
Packit |
0848f5 |
integer (kind=MPI_ADDRESS_KIND) asize
|
|
Packit |
0848f5 |
|
|
Packit |
0848f5 |
integer ierr, sizeofreal, errs
|
|
Packit |
0848f5 |
integer i,j
|
|
Packit |
0848f5 |
!
|
|
Packit |
0848f5 |
errs = 0
|
|
Packit |
0848f5 |
call mtest_init(ierr)
|
|
Packit |
0848f5 |
call mpi_type_size( MPI_REAL, sizeofreal, ierr )
|
|
Packit |
0848f5 |
! Make sure we pass in an integer of the correct type
|
|
Packit |
0848f5 |
asize = sizeofreal * 100 * 100
|
|
Packit |
0848f5 |
call mpi_alloc_mem( asize,MPI_INFO_NULL,p,ierr )
|
|
Packit |
0848f5 |
|
|
Packit |
0848f5 |
do i=1,100
|
|
Packit |
0848f5 |
do j=1,100
|
|
Packit |
0848f5 |
a(i,j) = -1
|
|
Packit |
0848f5 |
enddo
|
|
Packit |
0848f5 |
enddo
|
|
Packit |
0848f5 |
a(3,5) = 10.0
|
|
Packit |
0848f5 |
|
|
Packit |
0848f5 |
call mpi_free_mem( a, ierr )
|
|
Packit |
0848f5 |
call mtest_finalize(errs)
|
|
Packit |
0848f5 |
call mpi_finalize(ierr)
|
|
Packit |
0848f5 |
|
|
Packit |
0848f5 |
end
|