From 63713f01e0a42255231d9afab8ef5dea49d7c640 Mon Sep 17 00:00:00 2001 From: Kian Cossettini Date: Thu, 27 Nov 2025 10:32:09 -0500 Subject: [PATCH] [rocprofiler-systems] Add Fortran MPI CTests (#1172) * Add MPI CTests (use gfortran) * Add proper regex check * Skip Runtime-Instrument due to incompatibility with MPI Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com> --------- Co-authored-by: Sajina Kandy Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com> --- .../docker/Dockerfile.opensuse | 2 +- .../docker/Dockerfile.opensuse.ci | 2 +- .../examples/mpi/CMakeLists.txt | 61 +++ .../examples/mpi/intervals_mpi.f90 | 384 ++++++++++++++++++ .../tests/rocprof-sys-mpi-tests.cmake | 47 +++ 5 files changed, 494 insertions(+), 2 deletions(-) create mode 100644 projects/rocprofiler-systems/examples/mpi/intervals_mpi.f90 diff --git a/projects/rocprofiler-systems/docker/Dockerfile.opensuse b/projects/rocprofiler-systems/docker/Dockerfile.opensuse index 14512a8db0..8b5485d41d 100644 --- a/projects/rocprofiler-systems/docker/Dockerfile.opensuse +++ b/projects/rocprofiler-systems/docker/Dockerfile.opensuse @@ -24,7 +24,7 @@ RUN zypper --non-interactive update -y && \ zypper --non-interactive dist-upgrade -y && \ zypper --non-interactive install -y -t pattern devel_basis && \ zypper --non-interactive install -y binutils-gold chrpath cmake curl dpkg-devel \ - gcc-c++ git gmock gtest iproute2 libdrm-devel libnuma-devel ninja \ + gcc-c++ gcc-fortran git gmock gtest iproute2 libdrm-devel libnuma-devel ninja \ nlohmann_json-devel openmpi3-devel python3-pip rpm-build \ sqlite3-devel wget && \ python3 -m pip install 'cmake==3.21' diff --git a/projects/rocprofiler-systems/docker/Dockerfile.opensuse.ci b/projects/rocprofiler-systems/docker/Dockerfile.opensuse.ci index e8dfd86054..8eb49b15c1 100644 --- a/projects/rocprofiler-systems/docker/Dockerfile.opensuse.ci +++ b/projects/rocprofiler-systems/docker/Dockerfile.opensuse.ci @@ -28,7 +28,7 @@ RUN zypper --non-interactive update -y && \ zypper --non-interactive dist-upgrade -y && \ zypper --non-interactive install -y -t pattern devel_basis && \ zypper --non-interactive install -y binutils-gold chrpath cmake curl dpkg-devel \ - gcc-c++ git gmock gtest iproute2 libnuma-devel ninja nlohmann_json-devel \ + gcc-c++ gcc-fortran git gmock gtest iproute2 libnuma-devel ninja nlohmann_json-devel \ openmpi3-devel papi-devel python3-devel python3-pip \ rpm-build sqlite3-devel vim wget && \ zypper --non-interactive clean --all && \ diff --git a/projects/rocprofiler-systems/examples/mpi/CMakeLists.txt b/projects/rocprofiler-systems/examples/mpi/CMakeLists.txt index 2ff4043a3c..1a09e8c2e3 100644 --- a/projects/rocprofiler-systems/examples/mpi/CMakeLists.txt +++ b/projects/rocprofiler-systems/examples/mpi/CMakeLists.txt @@ -2,6 +2,42 @@ cmake_minimum_required(VERSION 3.21 FATAL_ERROR) project(rocprofiler-systems-mpi-examples LANGUAGES C CXX) +find_program(GFORTRAN_EXECUTABLE NAMES gfortran) +if(GFORTRAN_EXECUTABLE) + enable_language(Fortran) + set(ENABLE_FORTRAN_MPI_CTESTS + TRUE + CACHE BOOL + "Internal variable used by rocprofiler-systems" + ) + execute_process( + COMMAND ${GFORTRAN_EXECUTABLE} --version + OUTPUT_VARIABLE GFORTRAN_VERSION_OUTPUT + RESULT_VARIABLE GFORTRAN_VERSION_RESULT + ERROR_VARIABLE GFORTRAN_VERSION_ERROR + OUTPUT_STRIP_TRAILING_WHITESPACE + ) + if(GFORTRAN_VERSION_RESULT EQUAL 0) + string( + REGEX MATCH + "GNU Fortran \\([^)]*\\) ([0-9]+\\.[0-9]+\\.[0-9]+)" + GFORTRAN_VERSION_MATCH + "${GFORTRAN_VERSION_OUTPUT}" + ) + set(GFORTRAN_VERSION ${CMAKE_MATCH_1}) + rocprofiler_systems_message(STATUS "Detected gfortran version: ${GFORTRAN_VERSION}") + else() + rocprofiler_systems_message(FATAL_ERROR "Failed to get gfortran version from ${GFORTRAN_EXECUTABLE}: ${GFORTRAN_VERSION_ERROR}") + endif() +else() + set(ENABLE_FORTRAN_MPI_CTESTS + FALSE + CACHE BOOL + "Internal variable used by rocprofiler-systems" + ) + rocprofiler_systems_message(WARNING "gfortran was not found, disabling fortran MPI tests...") +endif() + if(ROCPROFSYS_DISABLE_EXAMPLES) get_filename_component(_DIR ${CMAKE_CURRENT_LIST_DIR} NAME) @@ -62,6 +98,24 @@ target_link_libraries(mpi-send-recv PRIVATE mpi-c-interface-library) add_executable(mpi-allreduce allreduce.c) target_link_libraries(mpi-allreduce PRIVATE mpi-c-interface-library m) +if(ENABLE_FORTRAN_MPI_CTESTS) + if(NOT MPI_Fortran_FOUND) + rocprofiler_systems_message(FATAL_ERROR "MPI Fortran support not found. Ensure MPI was configured with Fortran support.") + endif() + add_library(mpi-fortran-interface-library INTERFACE) + target_link_libraries( + mpi-fortran-interface-library + INTERFACE + Threads::Threads + MPI::MPI_Fortran + $ + ) + + # Also tests the case where Fortran Main has FuncReturnStatus == NORETURN + add_executable(mpi-fortran-intervals intervals_mpi.f90) + target_link_libraries(mpi-fortran-intervals PRIVATE mpi-fortran-interface-library) +endif() + set(CMAKE_BUILD_TYPE "Release") add_library(mpi-cxx-interface-library INTERFACE) @@ -89,4 +143,11 @@ if(ROCPROFSYS_INSTALL_EXAMPLES) DESTINATION bin COMPONENT rocprofiler-systems-examples ) + if(ENABLE_FORTRAN_MPI_CTESTS) + install( + TARGETS mpi-fortran-intervals + DESTINATION bin + COMPONENT rocprofiler-systems-examples + ) + endif() endif() diff --git a/projects/rocprofiler-systems/examples/mpi/intervals_mpi.f90 b/projects/rocprofiler-systems/examples/mpi/intervals_mpi.f90 new file mode 100644 index 0000000000..5c824abf4a --- /dev/null +++ b/projects/rocprofiler-systems/examples/mpi/intervals_mpi.f90 @@ -0,0 +1,384 @@ +program main + +!*****************************************************************************80 +! +!! MAIN is the main program for INTERVALS. +! +! Discussion: +! +! INTERVALS uses MPI routines to multiprocess a computational task. +! +! We have a function F(X), an interval [XMIN,XMAX], +! and a value N. +! +! We define N equally spaced points in the interval, +! +! X(I) = ( ( N - I ) * XMIN +! + ( I - 1 ) * XMAX ) +! / ( N - 1 ) +! +! We thus have N-1 subintervals. +! +! We assume we have N processors available. +! +! Processor 0 is designated the master processor, assigned +! to estimating the integral of F(X) over the entire +! interval [ X(1), X(N) ]. +! +! For I = 1 to N-1, processor I is assigned the subinterval +! +! [ X(I), X(I+1) ] +! +! and then estimates the integral Q(I) of F(X) over that +! subinterval. +! +! COMMUNICATION: +! +! Processor 0 communicates to processor I the endpoints of +! the interval it is assigned, and the number of sample points +! to use in that interval. +! +! Processor I communicates to processor 0 the computed value of +! Q(I). +! +! Licensing: +! +! This code is distributed under the GNU LGPL license. +! +! Modified: +! +! 17 March 2006 +! +! Author: +! +! John Burkardt +! +! Reference: +! +! William Gropp, Ewing Lusk, Anthony Skjellum, +! Using MPI: Portable Parallel Programming with the +! Message-Passing Interface, +! Second Edition, +! MIT Press, 1999, +! ISBN: 0262571323. +! +! Snir, Otto, Huss-Lederman, Walker, Dongarra, +! MPI - The Complete Reference, +! Volume 1, The MPI Core, +! second edition, +! MIT Press, 1998. +! + use mpi + + real ( kind = 8 ) f + real ( kind = 8 ) h + integer ( kind = 4 ) i + integer ( kind = 4 ) id + integer ( kind = 4 ) ierr + integer ( kind = 4 ) m + integer ( kind = 4 ) n + real ( kind = 8 ), parameter :: pi = 3.141592653589793238462643D+00 + integer ( kind = 4 ) process + integer ( kind = 4 ) process_num + real ( kind = 8 ) q_global + real ( kind = 8 ) q_local + integer ( kind = 4 ) received + integer ( kind = 4 ) source + integer ( kind = 4 ) status(MPI_Status_size) + integer ( kind = 4 ) tag + integer ( kind = 4 ) target + real ( kind = 8 ) wtime + real ( kind = 8 ) x + real ( kind = 8 ) xb(2) + real ( kind = 8 ) :: x_max = 1.0D+00 + real ( kind = 8 ) :: x_min = 0.0D+00 +! +! Establish the MPI environment. +! + call MPI_Init ( ierr ) +! +! Get this process's ID. +! + call MPI_Comm_rank ( MPI_COMM_WORLD, id, ierr ) +! +! Find out how many processes are available. +! + call MPI_Comm_size ( MPI_COMM_WORLD, process_num, ierr ) +! +! Say hello (once), and shut down right away unless we +! have at least 2 processes available. +! + if ( id == 0 ) then + call timestamp ( ) + write ( *, '(a)' ) ' ' + write ( *, '(a)' ) 'INTERVALS - Master process:' + write ( *, '(a)' ) ' FORTRAN90 version' + write ( *, '(a)' ) ' ' + write ( *, '(a)' ) ' An MPI example program.' + write ( *, '(a)' ) ' A quadrature over an interval is done by' + write ( *, '(a)' ) ' assigning subintervals to processes.' + write ( *, '(a,i8)' ) ' The number of processes is ', process_num + + wtime = MPI_Wtime ( ) + + if ( process_num <= 1 ) then + write ( *, '(a)' ) ' ' + write ( *, '(a)' ) 'INTERVALS - Master process:' + write ( *, '(a)' ) ' Need at least 2 processes!' + call MPI_Finalize ( ierr ) + write ( *, '(a)' ) ' ' + write ( *, '(a)' ) 'INTERVALS - Master process:' + write ( *, '(a)' ) ' Abnormal end of execution.' + stop + end if + + end if + + write ( *, '(a)' ) ' ' + write ( *, '(a,i8,a)' ) 'Process ', id, ': Active!' +! +! Every process could figure out the endpoints of its interval +! on its own. But we want to demonstrate communication. So we +! assume that the assignment of processes to intervals is done +! only by the master process, which then tells each process +! what job it is to do. +! + if ( id == 0 ) then + + do process = 1, process_num-1 + + xb(1) = ( real ( process_num - process, kind = 8 ) * x_min & + + real ( process - 1, kind = 8 ) * x_max ) & + / real ( process_num - 1, kind = 8 ) + + xb(2) = ( real ( process_num - process - 1, kind = 8 ) * x_min & + + real ( process, kind = 8 ) * x_max ) & + / real ( process_num - 1, kind = 8 ) + + target = process + tag = 1 + + call MPI_Send ( xb, 2, MPI_DOUBLE_PRECISION, target, tag, & + MPI_COMM_WORLD, ierr ) + + end do + + else + + tag = 1 + + call MPI_Recv ( xb, 2, MPI_DOUBLE_PRECISION, 0, tag, & + MPI_COMM_WORLD, status, ierr ) + + end if +! +! Wait here until everyone has gotten their assignment. +! + call MPI_Barrier ( MPI_COMM_WORLD, ierr ) + + if ( id == 0 ) then + write ( *, '(a)' ) ' ' + write ( *, '(a)' ) 'INTERVALS - Master process:' + write ( *, '(a)' ) ' Subintervals have been assigned.' + end if +! +! Every process needs to be told the number of points to use. +! Since this is the same value for everybody, we use a broadcast. +! Again, we are doing it in this roundabout way to emphasize that +! the choice for M could really be made at runtime, by processor 0, +! and then sent out to the others. +! + m = 100 + + call MPI_Bcast ( m, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr ) +! +! Now, every process EXCEPT 0 computes its estimate of the +! integral over its subinterval, and sends the result back +! to process 0. +! + if ( id /= 0 ) then + + q_local = 0.0D+00 + + do i = 1, m + + x = ( real ( 2 * m - 2 * i + 1, kind = 8 ) * xb(1) & + + real ( 2 * i - 1, kind = 8 ) * xb(2) ) & + / real ( 2 * m, kind = 8 ) + + q_local = q_local + f ( x ) + + end do + + q_local = q_local * ( xb(2) - xb(1) ) / real ( m, kind = 8 ) + + tag = 2 + + call MPI_Send ( q_local, 1, MPI_DOUBLE_PRECISION, 0, tag, & + MPI_COMM_WORLD, ierr ) +! +! Process 0 expects to receive N-1 partial results. +! + else + + received = 0 + q_global = 0.0D+00 + + do while ( received < process_num - 1 ) + + source = MPI_ANY_SOURCE + tag = 2 + + call MPI_Recv ( q_local, 1, MPI_DOUBLE_PRECISION, source, tag, & + MPI_COMM_WORLD, status, ierr ) + + q_global = q_global + q_local + received = received + 1 + + end do + + end if +! +! The master process prints the answer. +! + if ( id == 0 ) then + + write ( *, '(a)' ) ' ' + write ( *, '(a)' ) 'INTERVALS - Master process:' + write ( *, '(a,g14.6)' ) ' Estimate for PI is ', q_global + write ( *, '(a,g14.6)' ) ' Error is ', q_global - pi + + wtime = MPI_Wtime ( ) - wtime + + write ( *, '(a)' ) ' ' + write ( *, '(a,f14.6)' ) ' Elapsed wall clock seconds = ', wtime + + end if +! +! Terminate MPI. +! + call MPI_Finalize ( ierr ) +! +! Terminate. +! + if ( id == 0 ) then + write ( *, '(a)' ) ' ' + write ( *, '(a)' ) 'INTERVALS:' + write ( *, '(a)' ) ' Normal end of execution.' + write ( *, '(a)' ) ' ' + call timestamp ( ) + end if + + stop +end +function f ( x ) + +!*****************************************************************************80 +! +!! F is the function we are integrating. +! +! Licensing: +! +! This code is distributed under the GNU LGPL license. +! +! Modified: +! +! 10 February 2000 +! +! Author: +! +! John Burkardt +! +! Parameters: +! +! Input, real ( kind = 8 ) X, the argument of the function. +! +! Output, real ( kind = 8 ) F, the value of the function. +! + implicit none + + real ( kind = 8 ) f + real ( kind = 8 ) x + + f = 4.0D+00 / ( 1.0D+00 + x * x ) + + return +end +subroutine timestamp ( ) + +!*****************************************************************************80 +! +!! TIMESTAMP prints the current YMDHMS date as a time stamp. +! +! Example: +! +! 31 May 2001 9:45:54.872 AM +! +! Licensing: +! +! This code is distributed under the GNU LGPL license. +! +! Modified: +! +! 18 May 2013 +! +! Author: +! +! John Burkardt +! +! Parameters: +! +! None +! + implicit none + + character ( len = 8 ) ampm + integer ( kind = 4 ) d + integer ( kind = 4 ) h + integer ( kind = 4 ) m + integer ( kind = 4 ) mm + character ( len = 9 ), parameter, dimension(12) :: month = (/ & + 'January ', 'February ', 'March ', 'April ', & + 'May ', 'June ', 'July ', 'August ', & + 'September', 'October ', 'November ', 'December ' /) + integer ( kind = 4 ) n + integer ( kind = 4 ) s + integer ( kind = 4 ) values(8) + integer ( kind = 4 ) y + + call date_and_time ( values = values ) + + y = values(1) + m = values(2) + d = values(3) + h = values(5) + n = values(6) + s = values(7) + mm = values(8) + + if ( h < 12 ) then + ampm = 'AM' + else if ( h == 12 ) then + if ( n == 0 .and. s == 0 ) then + ampm = 'Noon' + else + ampm = 'PM' + end if + else + h = h - 12 + if ( h < 12 ) then + ampm = 'PM' + else if ( h == 12 ) then + if ( n == 0 .and. s == 0 ) then + ampm = 'Midnight' + else + ampm = 'AM' + end if + end if + end if + + write ( *, '(i2.2,1x,a,1x,i4,2x,i2,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)' ) & + d, trim ( month(m) ), y, h, ':', n, ':', s, '.', mm, trim ( ampm ) + + return +end diff --git a/projects/rocprofiler-systems/tests/rocprof-sys-mpi-tests.cmake b/projects/rocprofiler-systems/tests/rocprof-sys-mpi-tests.cmake index a78ce3e1c0..b9f2e28d28 100644 --- a/projects/rocprofiler-systems/tests/rocprof-sys-mpi-tests.cmake +++ b/projects/rocprofiler-systems/tests/rocprof-sys-mpi-tests.cmake @@ -177,3 +177,50 @@ foreach( ENVIRONMENT "${_mpip_${_EXAMPLE}_environment}" ) endforeach() + +if(ENABLE_FORTRAN_MPI_CTESTS) + set(_fortran_mpip_flat_environment + "ROCPROFSYS_FLAT_PROFILE=ON" + "ROCPROFSYS_COUT_OUTPUT=ON" + "ROCPROFSYS_TIMELINE_PROFILE=OFF" + "ROCPROFSYS_COLLAPSE_PROCESSES=ON" + "ROCPROFSYS_COLLAPSE_THREADS=ON" + "ROCPROFSYS_SAMPLING_FREQ=50" + "ROCPROFSYS_TIMEMORY_COMPONENTS=wall_clock,trip_count" + "${_mpip_environment}" + ) + + if(ROCPROFSYS_USE_MPI) + set(MPI_FORTRAN_REWRITE_RUN_REGEX + ">>> MPI_Init(.*\n.*)>>> MPI_Send(.*\n.*)>>> MPI_Recv(.*\n.*)>>> MPI_Comm_size(.*\n.*)>>> MPI_Comm_rank(.*\n.*)" + ) + else() + set(MPI_FORTRAN_REWRITE_RUN_REGEX + ">>> PMPI_Init(.*\n.*)>>> PMPI_Send(.*\n.*)>>> PMPI_Recv(.*\n.*)>>> PMPI_Comm_size(.*\n.*)>>> PMPI_Comm_rank(.*\n.*)" + ) + endif() + + foreach(_FORTRAN_EXAMPLE intervals) + rocprofiler_systems_add_test( + SKIP_RUNTIME + NAME "mpi-fortran-${_FORTRAN_EXAMPLE}" + TARGET mpi-fortran-${_FORTRAN_EXAMPLE} + MPI ON + NUM_PROCS 2 + LABELS "mpip;fortran" + REWRITE_ARGS + -e + -v + 2 + --label + file + line + args + --min-instructions + 0 + ENVIRONMENT "${_fortran_mpip_flat_environment}" + REWRITE_RUN_PASS_REGEX + ">>> mpi-fortran-${_FORTRAN_EXAMPLE}.inst(.*\n.*)${MPI_FORTRAN_REWRITE_RUN_REGEX}" + ) + endforeach() +endif()