File: trivialf.f

package info (click to toggle)
lam 7.1.2-1
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 54,668 kB
  • ctags: 17,034
  • sloc: ansic: 156,264; sh: 9,976; cpp: 7,699; makefile: 5,590; perl: 476; fortran: 260; asm: 83
file content (68 lines) | stat: -rw-r--r-- 1,843 bytes parent folder | download | duplicates (9)
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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
c
c Copyright (c) 2001-2003 The Trustees of Indiana University.  
c                         All rights reserved.
c Copyright (c) 1998-2001 University of Notre Dame. 
c                         All rights reserved.
c Copyright (c) 1994-1998 The Ohio State University.  
c                         All rights reserved.
c 
c This file is part of the LAM/MPI software package.  For license
c information, see the LICENSE file in the top level directory of the
c LAM/MPI source distribution.
c 
c $HEADER$
c
c $Id: trivialf.f,v 6.4 2003/03/28 22:14:17 jsquyres Exp $
c
c	Transmit a message in a two process system.
c
        program trivial

        include 'mpif.h'

        integer*4 BUFSIZE

        parameter (BUFSIZE = 64)

        integer*4 buffer(BUFSIZE)
        integer rank
        integer size
        integer status(MPI_STATUS_SIZE)

c
c Initialize MPI.
c
        call MPI_INIT(ierror)
c
c Error check the number of processes.
c Determine my rank in the world group.
c The sender will be rank 0 and the receiver, rank 1.
c
        call MPI_COMM_SIZE(MPI_COMM_WORLD, size, ierror)

        if (size .lt. 2) then
           print *,'Need at least 2 processes.'
           call MPI_FINALIZE(ierror)
           stop
        endif

        call MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierror)
c
c As rank 0, send a message to rank 1.
c
        if (rank .eq. 0) then
           call MPI_SEND(buffer(1), BUFSIZE, MPI_INTEGER,
     +          1, 11, MPI_COMM_WORLD, ierror)
           print *,'rank ',rank,' sent message'
c
c As rank 1, receive a message from rank 0.
c
        else if (rank .eq. 1) then
           call MPI_RECV(buffer(1), BUFSIZE, MPI_INTEGER,
     +          0, 11, MPI_COMM_WORLD, status, ierror)      
           print *,'rank ',rank,' received message'
        endif

        call MPI_FINALIZE(ierror)
        stop
        end