From 2daec0e4d0d333ae9340a9af0a10b1b8bf74ed57 Mon Sep 17 00:00:00 2001 From: David Galiffi Date: Mon, 12 Jan 2026 23:44:26 -0500 Subject: [PATCH] Revert 63713f01e0a42255231d9afab8ef5dea49d7c640 (#2585) ## Motivation Remove Fortran example due to Palamida scan violation. ## Technical Details Revert 63713f01e0a42255231d9afab8ef5dea49d7c640. New test to be added later. Signed-off-by: David Galiffi --- .../examples/mpi/CMakeLists.txt | 61 --- .../examples/mpi/intervals_mpi.f90 | 384 ------------------ .../tests/rocprof-sys-mpi-tests.cmake | 47 --- 3 files changed, 492 deletions(-) delete mode 100644 projects/rocprofiler-systems/examples/mpi/intervals_mpi.f90 diff --git a/projects/rocprofiler-systems/examples/mpi/CMakeLists.txt b/projects/rocprofiler-systems/examples/mpi/CMakeLists.txt index 1a09e8c2e3..2ff4043a3c 100644 --- a/projects/rocprofiler-systems/examples/mpi/CMakeLists.txt +++ b/projects/rocprofiler-systems/examples/mpi/CMakeLists.txt @@ -2,42 +2,6 @@ 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) @@ -98,24 +62,6 @@ 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) @@ -143,11 +89,4 @@ 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 deleted file mode 100644 index 71664f1c7a..0000000000 --- a/projects/rocprofiler-systems/examples/mpi/intervals_mpi.f90 +++ /dev/null @@ -1,384 +0,0 @@ -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 4a8592301d..6af7e1bd5f 100644 --- a/projects/rocprofiler-systems/tests/rocprof-sys-mpi-tests.cmake +++ b/projects/rocprofiler-systems/tests/rocprof-sys-mpi-tests.cmake @@ -180,50 +180,3 @@ 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()