configure

CCSM Research Tools: Community Atmosphere Model (CAM)

    my @e;  # xml elements
    my $e;  # an xml element
    my %a;  # element attributes

    # Check for valid root node
    my $name = $root->get_name();
    $name eq "resolution_parameters" or die
	"file $file is not a resolution parameters file\n";

    # Get spectral grids
    # The "res" attribute values are the keys of %spec_grid
    # The values are references to a hash containing the nlon, nlat keys
    @e = $xml->elements_by_name( "spectral_grid" );
    %a = ();
    my %spec_grid = ();
    while ( $e = shift @e ) {
	%a = $e->get_attributes();
	$spec_grid{"$a{'res'}"} = { 'nlon' => $a{'nlon'},
				    'nlat' => $a{'nlat'}
				  };
    }

    # Get finite volume grids
    # The "res" attribute values are the keys of %fv_grid
    # The values are references to a hash containing the nlon, nlat keys
    @e = $xml->elements_by_name( "fv_grid" );
    %a = ();
    my %fv_grid = ();
    while ( $e = shift @e ) {
	%a = $e->get_attributes();
	$fv_grid{"$a{'res'}"} = { 'nlon' => $a{'nlon'},
				  'nlat' => $a{'nlat'}
				};
    }

    # Get spectral truncation parameters
    # The "res" attribute values are the keys of %spec_trunc
    # The values are references to a hash containing the m, n, and k keys
    @e = $xml->elements_by_name( "spectral_trunc" );
    %a = ();
    my %spec_trunc = ();
    while ( $e = shift @e ) {
	%a = $e->get_attributes();
	$spec_trunc{"$a{'res'}"} = { 'm' => $a{'m'},
				     'n' => $a{'n'},
				     'k' => $a{'k'}
				   };
    }

    return \%spec_grid, \%fv_grid, \%spec_trunc;
}

#-------------------------------------------------------------------------------

sub get_sys_defaults
{
    my ($file, $os) = @_;
    my $xml = XML::Lite->new( $file );
    my $root = $xml->root_element();
    my $e;          # xml element
    my %a;          # element attributes
    my %sys = ();   # return values

    # Check for valid root node
    my $name = $root->get_name();
    $name eq "system_defaults" or die
	"file $file is not a system defaults file\n";

    # SPMD
    $e = $xml->elements_by_name( "spmd" );
    %a = $e->get_attributes();
    $sys{'spmd'} = $a{$os};

    # Threads
    $e = $xml->elements_by_name( "threads" );
    %a = $e->get_attributes();
    $sys{'omp'} = $a{$os};

    return %sys;
}

#-------------------------------------------------------------------------------

sub absolute_path {
#
# Convert a pathname into an absolute pathname, expanding any . or .. characters.
# Assumes pathnames refer to a local filesystem.
# Assumes the directory separator is "/".
#
  my $path = shift;
  my $cwd = getcwd();  # current working directory
  my $abspath;         # resulting absolute pathname

# Strip off any leading or trailing whitespace.  (This pattern won't match if
# there's embedded whitespace.
  $path =~ s!^\s*(\S*)\s*$!$1!;

# Convert relative to absolute path.

  if ($path =~ m!^\.$!) {          # path is "."
      return $cwd;
  } elsif ($path =~ m!^\./!) {     # path starts with "./"
      $path =~ s!^\.!$cwd!;
  } elsif ($path =~ m!^\.\.$!) {   # path is ".."
      $path = "$cwd/..";
  } elsif ($path =~ m!^\.\./!) {   # path starts with "../"
      $path = "$cwd/$path";
  } elsif ($path =~ m!^[^/]!) {    # path starts with non-slash character
      $path = "$cwd/$path";
  }

  my ($dir, @dirs2);
  my @dirs = split "/", $path, -1;   # The -1 prevents split from stripping trailing nulls
                                     # This enables correct processing of the input "/".

  # Remove any "" that are not leading.
  for (my $i=0; $i<=$#dirs; ++$i) {
      if ($i == 0 or $dirs[$i] ne "") {
	  push @dirs2, $dirs[$i];
      }
  }
  @dirs = ();

  # Remove any "."
  foreach $dir (@dirs2) {
      unless ($dir eq ".") {
	  push @dirs, $dir;
      }
  }
  @dirs2 = ();

  # Remove the "subdir/.." parts.
  foreach $dir (@dirs) {
    if ( $dir !~ /^\.\.$/ ) {
        push @dirs2, $dir;
    } else {
        pop @dirs2;   # remove previous dir when current dir is ..
    }
  }
  if ($#dirs2 == 0 and $dirs2[0] eq "") { return "/"; }
  $abspath = join '/', @dirs2;
  return( $abspath );
}

#-------------------------------------------------------------------------------

sub subst_env_path {
#
# Substitute for any environment variables contained in a pathname.
# Assumes the directory separator is "/".
#
  my $path = shift;
  my $newpath;         # resulting pathname

# Strip off any leading or trailing whitespace.  (This pattern won't match if
# there's embedded whitespace.
  $path =~ s!^\s*(\S*)\s*$!$1!;

  my ($dir, @dirs2);
  my @dirs = split "/", $path, -1;   # The -1 prevents split from stripping trailing nulls
                                     # This enables correct processing of the input "/".

  foreach $dir (@dirs) {
    if ( $dir =~ /^\$(.+)$/ ) {
        push @dirs2, $ENV{$1};
    } else {
        push @dirs2, $dir;
    }
  }
  $newpath = join '/', @dirs2;
  return( $newpath );
}

#-------------------------------------------------------------------------------

sub mkdirp {
    my ($dir) = @_;
    my (@dirs) = split /\//, $dir;
    my (@subdirs, $path);

    # if $dir is absolute pathname then @dirs will start with ""
    if ($dirs[0] eq "") { push @subdirs, shift @dirs; }  

    while ( @dirs ) { # check that each subdir exists and mkdir if it doesn't
	push @subdirs, shift @dirs;
	$path = join '/', @subdirs;
	unless (-d $path or mkdir($path, 0777)) { return 0; }
    }
    return 1;
}

#-------------------------------------------------------------------------------

sub get_option {

    my ($mes, @expect) = @_;
    my ($ans, $expect, $max_tries);

    $max_tries = 5;
    print $mes;
    while ($max_tries) {
	$ans = <>; chomp $ans;
	--$max_tries;
	$ans =~ s/^\s+//;
	$ans =~ s/\s+$//;
	# Check for null response which indicates that default is accepted.
	unless ($ans) { return ""; }
	foreach $expect (@expect) {
	    if ($ans =~ /^$expect$/i) { return $expect; }
	}
	if ($max_tries > 1) {
	    print "$ans does not match any of the expected values: @expect\n";
	    print "Please try again: ";
	} elsif ($max_tries == 1) {
	    print "$ans does not match any of the expected values: @expect\n";
	    print "Last chance! ";
	}
    }
    die "Failed to get answer to question: $mes\n";
}

#-------------------------------------------------------------------------------

sub valid_option {

    my ($val, @expect) = @_;
    my ($expect);

    $val =~ s/^\s+//;
    $val =~ s/\s+$//;
    foreach $expect (@expect) {
	if ($val =~ /^$expect$/i) { return $expect; }
    }
    return undef;
}

#-------------------------------------------------------------------------------

sub validate_options {

    my ($source, $opts) = @_;
    my ($opt, $old, @expect);
    
    # dyn
    $opt = 'dyn';
    @expect = ('eul', 'sld', 'fv');
    if (defined $opts->{$opt}) {
	$old = $opts->{$opt};
	$opts->{$opt} = valid_option($old, @expect)
	    or die "** invalid value of $opt ($old) specified in $source\n".
                   "** expected one of: @expect\n";
    }

    # phys
    $opt = 'phys';
    @expect = ('cam1', 'ccm366');
    if (defined $opts->{$opt}) {
	$old = $opts->{$opt};
	$opts->{$opt} = valid_option($old, @expect)
	    or die "** invalid value of $opt ($old) specified in $source\n".
                   "** expected one of: @expect\n";
    }

    # ocn
    $opt = 'ocn';
    @expect = ('dom', 'som');
    if (defined $opts->{$opt}) {
	$old = $opts->{$opt};
	$opts->{$opt} = valid_option($old, @expect)
	    or die "** invalid value of $opt ($old) specified in $source\n".
                   "** expected one of: @expect\n";
    }

    # resolution
    unless ($opts->{'res'} eq 'custom') {
	if ( defined($opts->{'nlon'}) or defined($opts->{'nlat'}) ) {
	    die "** must set -res option to 'custom' for the -nlon or -nlat options\n".
		"** to be recognized\n";
	}
    }

    unless ($opts->{'res'} eq 'custom' and $opts->{'dyn'} ne 'fv') {
	if ( defined($opts->{'trk'}) or defined($opts->{'trm'}) or defined($opts->{'trn'}) ) {
	    die "** must set -res option to 'custom' and -dyn to either 'eul' or 'sld'\n".
		"** for the -trk, -trm, or -trn options to be recognized\n";
	}
    }

}

#-------------------------------------------------------------------------------

sub get_gmake {

# check for a valid version of GNU make in the user's path

    my @makenames = @_;
    my ($make, $retval);

    foreach $make (@makenames) {
	$retval = `$make -v 2>&1`;
	return $make if ($retval =~ /GNU Make/);
    }
    return;
}

#-------------------------------------------------------------------------------

sub check_fc {

# Create a "hello world" test code in Fortran 90 syntax to check the compiler.
# If successful then the name of the compiler used is returned.

    my ($gmake, $cfgdir) = @_;
    my $fh = new IO::File;
    my $file = 'test_fc.F90';

    $fh->open(">$file") or die "** can't open file: $file\n";

    print $fh  <<"EOF";
module m1
   private
   public :: hello
contains
subroutine hello()
   implicit none
   print *, 'hello world'
end subroutine hello
end module m1
program main
   use m1, only: hello
   implicit none
   call hello
end program main
EOF
    $fh->close;

    # execute the test_fc target in the CAM Makefile
    my $cmd = "$gmake test_fc 2>&1";
    my $out = `$cmd`;
    if ($CHILD_ERROR) { 
	die <<"EOF";
**** FAILED ****
Issued the command:
$cmd

The output was:
$out
EOF
    }
    # clean-up (Srcfiles and Depends are created by the makefile)
    unlink 'test_fc.F90', 'test_fc.o', 'test_fc', glob("[Mm]1.[Mm][Oo][Dd]"), 'Srcfiles', 'Depends';

    # search make output for name of Fortran compiler
    $out =~ /(\w*f9\w+)/;
    return $1;
}

#-------------------------------------------------------------------------------

sub check_netcdf {

# Create a test code that has an external reference to the netCDF library
# and check that the Makefile can build it.  Returns 0 on success.

    my ($gmake, $cfgdir) = @_;
    my $fh = new IO::File;
    my $file = 'test_nc.F90';

    $fh->open(">$file") or die "** can't open file: $file\n";

    print $fh  <<"EOF";
program main
   implicit none
#include <netcdf.inc>
   integer :: cmode, ncid, ret
   ret = nf_create('foo.nc', cmode, ncid)
end program main
EOF
    $fh->close;

    # execute the test_nc target in the CAM Makefile
    my $cmd = "$gmake test_nc 2>&1";
    my $out = `$cmd`;
    if ($CHILD_ERROR) { 
	die <<"EOF";
**** FAILED ****
Issued the command:
$cmd

The output was:
$out
EOF
    }

    # clean-up (Srcfiles and Depends are created by the makefile)
    unlink 'test_nc.F90', 'test_nc.o', 'test_nc', 'Srcfiles', 'Depends';

    return 0;
}

#-------------------------------------------------------------------------------

sub check_mpi {

# Create a test code that has an external reference to the MPI library
# and check that the Makefile can build it.  Returns 0 on