File: allocmemf90.f90

package info (click to toggle)
mpich 3.2-7
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 81,040 kB
  • ctags: 68,664
  • sloc: ansic: 358,905; f90: 54,597; perl: 18,527; cpp: 10,203; sh: 9,839; xml: 8,195; fortran: 7,799; makefile: 4,868; ruby: 53; sed: 9; php: 8
file content (36 lines) | stat: -rw-r--r-- 910 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
! -*- Mode: Fortran; -*-
!
!  (C) 2014 by Argonne National Laboratory.
!      See COPYRIGHT in top-level directory.
!
        program main
        use mpi_f08
        use, intrinsic :: iso_c_binding
        real, pointer :: a(:,:)
        integer (kind=MPI_ADDRESS_KIND) asize
        type(c_ptr) cptr

        integer ierr, sizeofreal, errs
        integer i,j
!
        errs = 0
        call mtest_init(ierr)
        call mpi_type_size( MPI_REAL, sizeofreal, ierr )
! Make sure we pass in an integer of the correct type
        asize = sizeofreal * 100 * 100
        call mpi_alloc_mem( asize,MPI_INFO_NULL,cptr,ierr )

        call c_f_pointer(cptr, a, [100, 100])

        do i=1,100
            do j=1,100
                a(i,j) = -1
            enddo
        enddo
        a(3,5) = 10.0

        call mpi_free_mem( a, ierr )
        call mtest_finalize(errs)
        call mpi_finalize(ierr)

        end