Blame test/mpi/f90/profile/profile1f90.f90

Packit Service c5cf8c
! This file created from f77/profile/profile1f.f with f77tof90
Packit Service c5cf8c
! -*- Mode: Fortran; -*-
Packit Service c5cf8c
!
Packit Service c5cf8c
!  (C) 2013 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
Packit Service c5cf8c
       integer ierr
Packit Service c5cf8c
       integer smsg(3), rmsg(3), toterrs, wsize, wrank
Packit Service c5cf8c
       common /myinfo/ calls, amount, rcalls, ramount
Packit Service c5cf8c
       integer calls, amount, rcalls, ramount
Packit Service c5cf8c
Packit Service c5cf8c
       toterrs = 0
Packit Service c5cf8c
       call mpi_init( ierr )
Packit Service c5cf8c
       call init_counts()
Packit Service c5cf8c
       call mpi_comm_rank( MPI_COMM_WORLD, wrank, ierr )
Packit Service c5cf8c
       call mpi_comm_size( MPI_COMM_WORLD, wsize, ierr )
Packit Service c5cf8c
Packit Service c5cf8c
       if (wrank .eq. 0) then
Packit Service c5cf8c
           smsg(1) = 3
Packit Service c5cf8c
           call mpi_send( smsg, 1, MPI_INT, 1, 0, MPI_COMM_WORLD, ierr )
Packit Service c5cf8c
       else if (wrank .eq. 1) then
Packit Service c5cf8c
          call mpi_recv( rmsg, 1, MPI_INT, 0, 0, MPI_COMM_WORLD, &
Packit Service c5cf8c
      &         MPI_STATUS_IGNORE, ierr ) 
Packit Service c5cf8c
          if (rmsg(1) .ne. 3) then
Packit Service c5cf8c
             toterrs = toterrs + 1
Packit Service c5cf8c
             print *, "Unexpected received value ", rmsg(1)
Packit Service c5cf8c
          endif
Packit Service c5cf8c
       endif
Packit Service c5cf8c
!
Packit Service c5cf8c
!     check that we used the profiling versions of the routines
Packit Service c5cf8c
       toterrs = 0
Packit Service c5cf8c
       if (wrank .eq. 0) then
Packit Service c5cf8c
          if (calls.ne.1) then
Packit Service c5cf8c
             toterrs = toterrs + 1
Packit Service c5cf8c
             print *, "Sender calls is ", calls
Packit Service c5cf8c
          endif
Packit Service c5cf8c
          if (amount.ne.1) then
Packit Service c5cf8c
             toterrs = toterrs + 1
Packit Service c5cf8c
             print *, "Sender amount is ", amount
Packit Service c5cf8c
          endif
Packit Service c5cf8c
       else if (wrank .eq. 1) then
Packit Service c5cf8c
          if (rcalls.ne.1) then
Packit Service c5cf8c
             toterrs = toterrs + 1
Packit Service c5cf8c
             print *, "Receiver calls is ", rcalls
Packit Service c5cf8c
          endif
Packit Service c5cf8c
          if (ramount.ne.1) then
Packit Service c5cf8c
             toterrs = toterrs + 1
Packit Service c5cf8c
             print *, "Receiver amount is ", ramount
Packit Service c5cf8c
          endif
Packit Service c5cf8c
       endif
Packit Service c5cf8c
Packit Service c5cf8c
       call mtest_finalize( toterrs )
Packit Service c5cf8c
!
Packit Service c5cf8c
       end
Packit Service c5cf8c
!
Packit Service c5cf8c
       subroutine mpi_send( smsg, count, dtype, dest, tag, comm, ierr )
Packit Service c5cf8c
       use mpi
Packit Service c5cf8c
       integer count, dtype, dest, tag, comm, ierr
Packit Service c5cf8c
       integer smsg(count)
Packit Service c5cf8c
       common /myinfo/ calls, amount, rcalls, ramount
Packit Service c5cf8c
       integer calls, amount, rcalls, ramount
Packit Service c5cf8c
!
Packit Service c5cf8c
       calls = calls + 1
Packit Service c5cf8c
       amount = amount + count
Packit Service c5cf8c
       call pmpi_send( smsg, count, dtype, dest, tag, comm, ierr )
Packit Service c5cf8c
       return
Packit Service c5cf8c
       end
Packit Service c5cf8c
!
Packit Service c5cf8c
      subroutine mpi_recv( rmsg, count, dtype, src, tag, comm, status, &
Packit Service c5cf8c
      &     ierr ) 
Packit Service c5cf8c
       use mpi
Packit Service c5cf8c
       integer count, dtype, src, tag, comm, status(MPI_STATUS_SIZE), &
Packit Service c5cf8c
      &      ierr 
Packit Service c5cf8c
       integer rmsg(count)
Packit Service c5cf8c
       common /myinfo/ calls, amount, rcalls, ramount
Packit Service c5cf8c
       integer calls, amount, rcalls, ramount
Packit Service c5cf8c
       rcalls = rcalls + 1
Packit Service c5cf8c
       ramount = ramount + 1
Packit Service c5cf8c
       call pmpi_recv( rmsg, count, dtype, src, tag, comm, status, ierr &
Packit Service c5cf8c
      &      ) 
Packit Service c5cf8c
       return
Packit Service c5cf8c
       end
Packit Service c5cf8c
!
Packit Service c5cf8c
       subroutine init_counts()
Packit Service c5cf8c
       common /myinfo/ calls, amount, rcalls, ramount
Packit Service c5cf8c
       integer calls, amount, rcalls, ramount
Packit Service c5cf8c
       calls = 0
Packit Service c5cf8c
       amount = 0
Packit Service c5cf8c
       rcalls = 0
Packit Service c5cf8c
       ramount = 0
Packit Service c5cf8c
       end
Packit Service c5cf8c
!
Packit Service c5cf8c
       subroutine mpi_pcontrol( ierr )
Packit Service c5cf8c
       integer ierr
Packit Service c5cf8c
       return
Packit Service c5cf8c
       end