openmpi/contrib/scaling/scaling.pl

#!/usr/bin/env perl
#
# Copyright (c) 2012      Los Alamos National Security, Inc.
#                         All rights reserved.
# Copyright (c) 2015      Intel, Inc. All rights reserved.

use strict;
use Getopt::Long;

# globals
my $num_nodes = 2;
my $my_arg;
my $reps = 1;
my $usedvm = 0;
my $usesrun = 0;
my $usempirun = 0;
my $runall = 0;

my @tests = qw(/bin/true ./orte_no_op ./mpi_no_op ./mpi_no_op);
my @options = ("", "", "", "-mca mpi_add_procs_cutoff 0 -mca pmix_base_async_modex 1");
my @starters = qw(mpirun orte-submit srun orterun);
my @starteroptions = ("-npernode 1 --novm",
                      "--hnp file:dvm_uri -pernode",
                      "--distribution=cyclic",
                      "-npernode 1 --novm");

# Set to true if the script should merely print the cmds
# it would run, but don't run them
my $SHOWME = 0;
# Set to true to suppress most informational messages.
my $QUIET = 0;
# Set to true if we just want to see the help message
my $HELP = 0;

GetOptions(
    "help" => \$HELP,
    "quiet" => \$QUIET,
    "showme" => \$SHOWME,
    "reps=s" => \$reps,
    "dvm" => \$usedvm,
    "srun" => \$usesrun,
    "mpirun" => \$usempirun,
    "all" => \$runall,
) or die "unable to parse options, stopped";

if ($HELP) {
    print <<EOT;
$0 [options]

--help | -h          This help message
--quiet | -q         Only output critical messages to stdout
--showme             Show the actual commands without executing them
--reps               Number of times to run each test (for statistics)
--mpirun             Use only mpirun (or its equivalent orterun)
--dvm                Use only orte-dvm to execute the test
--srun               Use only srun to execute the test
--all                Use all available start commands [default]
EOT
    exit(0);
}

my $n = 1;
my $cmd;
my $starter;
my $test;
my $output;
my @lines;
my $line;
my @results;
my $res;
my $toggle;
my $idx;
my $option;
my $havedvm = 0;

# see which starters are available
my @path = split(":", $ENV{PATH});
my $exists = 0;
$idx=0;
while ($idx <= $#starters) {
    $starter = $starters[$idx];
    $exists = 0;
    foreach my $path (@path) {
        if ( -x "$path/$starter") {
            $exists = 1;
            last;
        }
    }
    unless ($exists) {
        # remove this one from the list
        splice @starters, $idx, 1;
        splice @starteroptions, $idx, 1;
        # adjust the index
        $idx = $idx - 1;
    } elsif ($usedvm && $starter ne "orte-submit") {
        # remove this one from the list
        splice @starters, $idx, 1;
        splice @starteroptions, $idx, 1;
        # adjust the index
        $idx = $idx - 1;
    } elsif ($usesrun && $starter ne "srun") {
        # remove this one from the list
        splice @starters, $idx, 1;
        splice @starteroptions, $idx, 1;
        # adjust the index
        $idx = $idx - 1;
    } elsif ($usempirun && (($starter ne "mpirun") && ($starter ne "orterun"))) {
        # remove this one from the list
        splice @starters, $idx, 1;
        splice @starteroptions, $idx, 1;
        # adjust the index
        $idx = $idx - 1;
    }
    $idx = $idx + 1;
}

# if both mpirun and orterun are present, then
# we don't need to run both as they are just
# symlinks to each other
$exists = 0;
foreach my $path (@path) {
    if ( -x "$path/mpirun") {
        $idx=0;
        foreach $starter (@starters) {
            if ($starter eq "orterun") {
                splice @starters, $idx, 1;
                splice @starteroptions, $idx, 1;
                last;
            }
            $idx = $idx + 1;
        }
        if ($exists) {
            last;
        }
    }
}

# bozo check
if (scalar @starters == 0) {
    print "No available starters\n";
    exit;
}

# if we are going to use the dvm, then we
# need to start it
if (-e "dvm_uri") {
    system("rm -f dvm_uri");
}
foreach $starter (@starters) {
    if ($starter eq "orte-submit") {
        $cmd = "orte-dvm --report-uri dvm_uri 2>&1 &";
        print $cmd . "\n";
        if (!$SHOWME) {
            system($cmd);
            # wait for the rendezvous file to appear
            while (! -e "dvm_uri") {
                sleep(1);
            }
            $havedvm = 1;
        }
    }
}

# determine the number of nodes - doesn't
# matter which starter we use
$cmd = $starters[0] . " " . $starteroptions[0] . " hostname";
$output = `$cmd`;
@lines = split(/\n/, $output);
$num_nodes = $#lines + 1;


print "\n--------------------------------------------------\n";

my $index = 0;
foreach $starter (@starters) {
    my $testnum = 0;
    foreach $test (@tests) {
        $option = $options[$testnum];
        if (-e $test) {
            if (!$SHOWME) {
                # pre-position the executable
                $cmd = $starter . $starteroptions[$index] . " $test 2>&1";
                system($cmd);
            }
            $n = 1;
            while ($n <= $num_nodes) {
                $cmd = "time " . $starter . " " . $starteroptions[$index] . " -np $n $option $test 2>&1";
                print $cmd . "\n";
                if (!$SHOWME) {
                    for (1..$reps) {
                        $toggle = 1;
                        $output = `$cmd`;
                        print $output . "\n";
                        @lines = split(/\n/, $output);
                        foreach $line (@lines) {
                            if (0 <= index($line, "user") ||
                                0 <= index($line, "sys") ||
                                0 <= index($line, "real") ||
                                0 <= index($line, "elapsed")) {
                                $idx = 0;
                                @results = split(/\s+/,$line, 4);
                                foreach $res (@results) {
                                    if ($idx < 3) {
                                        print $res;
                                        if (0 == $toggle) {
                                            print " ";
                                            $toggle = 1;
                                        } else {
                                            print "    ";
                                            $toggle = 0;
                                        }
                                    }
                                    $idx = $idx + 1;
                                }
                                print "\n";
                            }
                        }
                    }
                    print "\n";
                }
                $n = 2 * $n;
            }
            if ($n < $num_nodes) {
                $cmd = "time " . $starter . " " . $starteroptions[$index] . " $option $test 2>&1";
                print $cmd . "\n";
                if (!$SHOWME) {
                    for (1..$reps) {
                        $output = `$cmd`;
                        $output =~ s/(.+)\n.*/$1/;
                        @results = split(/\s+/,$output);
                        print $results[0] . "    " . $results[1] . "    " . $results[2] . "\n";
                    }
                }
            }
            print "\n--------------------------------------------------\n";
        } else {
            print "Test " . $test . " was not found - test skipped\n";
            print "\n--------------------------------------------------\n";
        }
        $testnum = $testnum + 1;
    }
    $index = $index + 1;
}

if ($havedvm) {
    if (!$SHOWME) {
        $cmd = "orte-submit --hnp file:dvm_uri --terminate";
        system($cmd);
    }
    if (-e "dvm_uri") {
        system("rm -f dvm_uri");
    }
}