#!/usr/bin/env perl # # This perl script reads in the histFldsMod.F90 file to find the total list of history # fields that can be added for this model version, regardless of namelist options, or # CPP processing. # use strict; #use warnings; #use diagnostics; use Cwd; use English; use Getopt::Long; use IO::File; use File::Glob ':glob'; # Set the directory that contains the CLM configuration scripts. If the command was # issued using a relative or absolute path, that path is in $ProgDir. Otherwise assume # the # command was issued from the current working directory. (my $ProgName = $0) =~ s!(.*)/!!; # name of this script my $ProgDir = $1; # name of directory containing this script -- may be a # relative or absolute path, or null if the script # is in # the user's PATH my $cmdline = "@ARGV"; # Command line arguments to script my $cwd = getcwd(); # current working directory my $cfgdir; # absolute pathname of directory that contains this script my $nm = "${ProgName}::"; # name to use if script dies if ($ProgDir) { $cfgdir = $ProgDir; } else { $cfgdir = $cwd; } # The namelist definition file contains entries for all namelist variables that # can be output by build-namelist. my $nl_definition_file = "$cfgdir/../../bld/namelist_files/namelist_definition_clm4_0.xml"; (-f "$nl_definition_file") or die <<"EOF"; ** $ProgName - Cannot find namelist definition file \"$nl_definition_file\" ** EOF print "Using namelist definition file $nl_definition_file\n"; # The Build::NamelistDefinition module provides utilities to get the list of # megan compounds #The root directory to cesm utils Tools my $cesm_tools = "$cfgdir/../../../../cime/utils"; (-f "$cesm_tools/perl5lib/Build/NamelistDefinition.pm") or die <<"EOF"; ** $ProgName - Cannot find perl module \"Build/NamelistDefinition.pm\" in directory \"$cesm_tools/perl5lib\" ** EOF # Add $cfgdir/perl5lib to the list of paths that Perl searches for modules my @dirs = ( $cfgdir, "$cesm_tools/perl5lib"); unshift @INC, @dirs; require Build::NamelistDefinition; # Create a namelist definition object. This object provides a method for verifying that # the # output namelist variables are in the definition file, and are output in the correct # namelist groups. my $definition = Build::NamelistDefinition->new($nl_definition_file); my $mxname = 0; my $mxlongn = 0; my %fields; my $fldnamevar = "fieldname_var"; sub matchKeyword { # # Match a keyword # my $keyword = shift; my $line = shift; my $fh = shift; my $match = undef; if ( $line =~ /$keyword/ ) { if ( $line =~ /$keyword\s*=\s*['"]([^'"]+)['"]/ ) { $match = $1; } elsif ( $line =~ /$keyword\s*=\s*&\s*$/ ) { $line = <$fh>; if ( $line =~ /^\s*['"]([^'"]+)['"]/ ) { $match = $1; } else { die "ERROR: Trouble getting keyword string\n Line: $line"; } } else { if ( $line =~ /fname\s*=\s*fieldname/ ) { print STDERR "Found variable used for fieldname = $line\n"; $match = $fldnamevar; } elsif ( $line =~ /fname\s*=\s*trim\(fname\)/ ) { $match = undef; } elsif ( $line =~ /units\s*=\s*units/ ) { $match = undef; } elsif ( $line =~ /long_name\s*=\s*long_name/ ) { $match = undef; } elsif ( $line =~ /long_name\s*=\s*longname/ ) { print STDERR "Found variable used for longname = $line\n"; $match = "longname_var"; } else { die "ERROR: Still have a match on $keyword\n Line: $line"; } } } return( $match ); } sub getFieldInfo { # # Get field Information # my $fh = shift; my $line = shift; my $fname = undef; my $units = undef; my $longn = undef; my $endin = undef; do { if ( $line =~ /MEG_/ ) { $line =~ s|'//'_'|_'|g; $line =~ s|'//trim\(meg_cmp\%name\)|megancmpd'|gi; if ( $line =~ /meg_cmp\%name/ ) { die "ERROR: Still have meg_cmp in a line\n"; } } if ( ! defined($fname) ) { $fname = &matchKeyword( "fname", $line, $fh ); } if ( ! defined($units) ) { $units = &matchKeyword( "units", $line, $fh ); } if ( ! defined($longn) ) { $longn = &matchKeyword( "long_name", $line, $fh ); } if ( $line =~ /\)\s*$/ ) { $endin = 1; } if ( ! defined($endin) ) { $line = <$fh>; } } until( (defined($fname) && defined($units) && defined($longn)) || ! defined($line) || defined($endin) ); if ( ! defined($fname) ) { die "ERROR: name undefined for field ending with: $line\n"; } return( $fname, $longn, $units ); } sub setField { # # Set the field # my $name = shift; my $longn = shift; my $units = shift; if ( defined($name) && $name ne $fldnamevar ) { if ( length($name) > $mxname ) { $mxname = length($name); } if ( length($longn) > $mxlongn ) { $mxlongn = length($longn); } my $len; if ( length($longn) > 90 ) { $len = 110; } elsif ( length($longn) > 60 ) { $len = 90; } else { $len = 60; } $fields{$name} = sprintf( "%-${len}s\t(%s)", $longn, $units ); } } sub XML_Header { # # Write out header to history fields file # my $outfh = shift; my $outfilename = shift; my $filename = shift; print STDERR " Write out header to history fields file to: $outfilename\n"; my $svnurl = '$URL$'; my $svnid = '$Id$'; print $outfh <<"EOF"; \<\?xml-stylesheet type="text\/xsl" href="history_fields.xsl"\?\> \<\!-- List of history file field names, long-names and units for all the fields output by CLM. This was created by reading in the file: $filename SVN version information: $svnurl $svnid --\> \ EOF } sub XML_Footer { # # Write out footer to history fields file # my $outfh = shift; print STDERR " Write out footer to history fields file\n"; print $outfh "\n\n"; } my $pwd = `pwd`; chomp( $pwd ); my $filename = "$pwd/histFldsMod.F90"; my $fh = IO::File->new($filename, '<') or die "** $ProgName - can't open history Fields file: $filename\n"; my @megcmpds = $definition->get_valid_values( "megan_cmpds", 'noquotes'=>1 ); # # Read in the list of fields from the source file # And output to an XML file # my $outfilename = "$pwd/../../bld/namelist_files/history_fields_clm4_0.xml"; my $outfh = IO::File->new($outfilename, '>') or die "** $ProgName - can't open output history Fields XML file: $outfilename\n"; &XML_Header( $outfh, $outfilename, $filename ); while (my $line = <$fh>) { # Comments if ($line =~ /(.*)\!/) { $line = $1; } my $format = "\n\n"; if ($line =~ /call\s*hist_addfld/i ) { (my $name, my $longn, my $units) = &getFieldInfo( $fh, $line ); if ( $name ne "MEG_megancmpd" ) { &setField( $name, $longn, $units ); printf( $outfh $format, $name, $units, $longn ); } else { foreach my $megcmpd ( @megcmpds ) { my $name = "MEG_${megcmpd}"; &setField( $name, $longn, $units ); printf( $outfh $format, $name, $units, $longn ); } } } } close( $fh ); &XML_Footer( $outfh ); close( $outfh ); print STDERR " mxname = $mxname\n"; print STDERR " mxlongn = $mxlongn\n"; # # List the fields in a neatly ordered list # foreach my $name ( sort(keys(%fields)) ) { my $len; if ( length($name) > 20 ) { $len = 40; } else { $len = 20; } printf( "%-${len}s = %s\n", $name, $fields{$name} ); }