diff --git a/MOM_code/.cproject b/MOM_code/.cproject new file mode 100644 index 0000000..02fc401 --- /dev/null +++ b/MOM_code/.cproject @@ -0,0 +1,55 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/MOM_code/.gitignore b/MOM_code/.gitignore new file mode 100644 index 0000000..4da79f0 --- /dev/null +++ b/MOM_code/.gitignore @@ -0,0 +1,5 @@ +*~ +exec/ +work/ +bin/mppnccombine.gfortran +.sh_history* diff --git a/MOM_code/.project b/MOM_code/.project new file mode 100644 index 0000000..2bee08a --- /dev/null +++ b/MOM_code/.project @@ -0,0 +1,27 @@ + + + mom_5.1 + + + + + + org.eclipse.cdt.managedbuilder.core.genmakebuilder + clean,full,incremental, + + + + + org.eclipse.cdt.managedbuilder.core.ScannerConfigBuilder + full,incremental, + + + + + + org.eclipse.cdt.core.cnature + org.eclipse.cdt.core.ccnature + org.eclipse.cdt.managedbuilder.core.managedBuildNature + org.eclipse.cdt.managedbuilder.core.ScannerConfigNature + + diff --git a/MOM_code/LICENSE b/MOM_code/LICENSE new file mode 100644 index 0000000..d159169 --- /dev/null +++ b/MOM_code/LICENSE @@ -0,0 +1,339 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Lesser General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along + with this program; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. diff --git a/MOM_code/README b/MOM_code/README new file mode 100644 index 0000000..54877d3 --- /dev/null +++ b/MOM_code/README @@ -0,0 +1,71 @@ + +Where to start +~~~~~~~~~~~~~~ +A good place to start is the "doc" directory, where you +will find "user" guides for the MOM. + +How to run the MOM tests +~~~~~~~~~~~~~~~~~~~~~~~~~ +MOM tests provided in exp directory divide in two types, +both using the GFDL shared infrastructure (FMS) : + +1. Solo models : Run stand alone MOM Ocean model. +2. Coupled models: Run MOM coupled with GFDL ice model + (besides null versions of atmosphere and land models). + +To run Solo models: + a. cd to exp and run mom4p1_solo_compile.csh first. + b. Modify the 'name' variable in the script + mom4p1_solo_run.csh to be the name of the test you + want to run. A list of available tests is included in the script. + c. Get the required input data for the test from GFDL ftp site. + You can get the info by running the script mom4p1_solo_run.csh + and following the instructions. + d. Run mom4p1_solo_run.csh + e. The results go into subdir name/workdir + +To run Coupled models: + Do the same steps above to mom4p1_coupled_compile.csh and mom4p1_coupled_run.csh + +To run EBM models: + Do the same steps above to mom4p1_ebm_compile.csh and mom4p1_ebm_run.csh + + + +Warning: The Solo and Coupled run scripts have been tested only on 10 and 24, ia64 + processors respectively. +Warning: Some of these tests require a large disk space to save the input data. + Choose a partition with enough space (1-2 G) to untar the code and data bundels. +Warning: If you want to use the same root directory for all three experiments we suggest to + compile in the order of increasing complexity: solo -> coupled -> ebm . + You may have to remove some of the existing .o and .mod files + if you want to compile ebm experiment after the coupled experiment. + E.g., you probably have to: cd ../exec; rm mpp*.o mpp*.mod fms_io*.o fms_io*.mod + +Note: IBM platform users might want to add the following line to the top of the run scripts + setenv LDR_CNTRL MAXDATA=0xD0000000@DSA + + +Note: The compile scripts provide the basic capability to use static memory allocation + which might be faster on some platforms. In that case you need to adjust the values + of domain bounds properly according to the number of processors and layout. + + +Summary of directory contents +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +bin/ + -- mkmf script for creating Makefiles + -- template files for the mkmf script + -- assorted other scripts + +exp/ + -- all MOM experiments (test cases) + +src/ + -- source code for all models + +src/postprocessing/ + -- source code for postprocessing programs + +src/preprocessing/ + -- source code for preprocessing programs diff --git a/MOM_code/README.md b/MOM_code/README.md new file mode 100644 index 0000000..55febd0 --- /dev/null +++ b/MOM_code/README.md @@ -0,0 +1,9 @@ +# The Modular Ocean Model + +MOM is a numerical ocean model based on the hydrostatic primitive equations. Development of the model is managed through the Model Development Lab at + +[http://www.mom-ocean.org](http://www.mom-ocean.org) + +Contributions from users and developers are always welcomed. Any questions should be directed to the [mailing list](https://groups.google.com/forum/#!forum/mom-users). + +To get started with MOM please consult the [quickstart guide](http://www.mom-ocean.org/web/docs/project/quickstart). More information can be found in the [online documentation](http://www.mom-ocean.org/web/docs) diff --git a/MOM_code/annex.py b/MOM_code/annex.py new file mode 100644 index 0000000..e24e79f --- /dev/null +++ b/MOM_code/annex.py @@ -0,0 +1,43 @@ +""" +Add a file to the git annex. + +Usage: + +python annex.py + + gets added to the local git annex and also uploaded to the cloud based annex on Amazon S3. +""" + +import os +import sys + + +def main(): + filename = sys.argv[-1] + project = "mom" + + ## Add a file to the local annex + cmd = "git annex add %s --backend=WORM" % filename + print cmd + os.system(cmd) + print + ## Upload the file to the cloud annex + cmd = "git annex copy %s --to cloud" % filename + print cmd + os.system(cmd) + print + target = os.path.realpath(filename).split(os.path.sep)[-1] + + ## Make the file public + cmd = "s3cmd setacl --acl-public s3://breakawaylabs-%s-data/%s" % (project, target) + print cmd + os.system(cmd) + print + ## Add the file to the web annex + cmd = "git annex addurl http://s3.amazonaws.com/breakawaylabs-%s-data/%s --file=%s" % (project, target, filename) + print cmd + os.system(cmd) + print + +if __name__ == '__main__': + main() diff --git a/MOM_code/bin/.prepare_pubrel.csh.swp b/MOM_code/bin/.prepare_pubrel.csh.swp new file mode 100644 index 0000000..d655e66 Binary files /dev/null and b/MOM_code/bin/.prepare_pubrel.csh.swp differ diff --git a/MOM_code/bin/combine_blobs.py b/MOM_code/bin/combine_blobs.py new file mode 100755 index 0000000..973a0c0 --- /dev/null +++ b/MOM_code/bin/combine_blobs.py @@ -0,0 +1,46 @@ + +import os +import numpy +#import netCDF4 +import sys +sys.path.append('/net2/nnz/opt/python/netCDF4-0.9.9/build/lib.linux-i686-2.4/') +import netCDF4 + +class ncFile(object): + def __init__(self,path): + self.path = path + + self.open() + for dimname, dim in self.dims.iteritems(): + if dim.isunlimited(): + self.len = len(dim) + + def close(self): + self.root.close() + del self.root, self.dims, self.vars, self.gatts + + def delete(self): + self.close() + os.remove(self.path) + + def open(self): + self.root = netCDF4.Dataset(self.path,'r') + self.dims = self.root.dimensions + self.vars = self.root.variables + self.gatts = self.root.ncattrs() + +class newFile(object): + def __init__(self,path,seed): + self.path = path + self.root = netCDF4.Dataset(self.path, 'w', format='NETCDF3_CLASSIC') + self.vars = self.root.variables + self.dims = self.root.dimensions + + for att in seed.root.ncattrs(): + self.root.setncattr(att,seed.root.getncattr(att)) + + def close(self): + self.root.close() + del self.root, self.vars, self.dims + + diff --git a/MOM_code/bin/combine_blobs.pyc b/MOM_code/bin/combine_blobs.pyc new file mode 100644 index 0000000..d42fc50 Binary files /dev/null and b/MOM_code/bin/combine_blobs.pyc differ diff --git a/MOM_code/bin/diag_table_chk b/MOM_code/bin/diag_table_chk new file mode 100755 index 0000000..55423a4 --- /dev/null +++ b/MOM_code/bin/diag_table_chk @@ -0,0 +1,598 @@ +#! /usr/bin/perl + +# $Author: Niki.Zadeh $ +# $Revision: 1.1.2.1 $ +# $Date: 2013/12/18 17:47:53 $ + +# Perl script to parse the diag_table. Count the number of files to +# be used, and the max number of fields per file used. + +use strict; +use Switch; +use List::Util qw/max/; +use XML::LibXML; +use Pod::Usage; +use Getopt::Long; + +my $help = 0; +my $verbose = 0; +my $xmlFile = ''; +GetOptions ("help|h" => \$help, + "verbose|v" => \$verbose, + "xml|x=s" => \$xmlFile) or pod2usage(2); +pod2usage(1) if $help; + +# Variable to hold the location of the diag_table file. +my $diag_table_file = ''; + +# diag_table_chk can be called one of two ways. Either, the +# diag_table file is given on the command line, or we will extract the +# information from an XML file and experiment. +if ( ! $xmlFile ) { # If no XML file specified. + if ( $#ARGV < 0 ) { + pod2usage( { -message => "$0: diag_table file must be given as an argument.", + -verbose => 0, + } ); + } else { + $diag_table_file = $ARGV[0] + } +} else { # We are using an XML file. + # Set up the XML Parser. + if ( $#ARGV < 0 ) { + pod2usage( { -message => "$0: experiment must be given as an argument.", + -verbose => 0, + } ); + } else { + # Make sure the $xmlFile exists and is readable + die "File $xmlFile does not exist.\n" unless ( -e $xmlFile ); + die "File $xmlFile exists, but is unreadable.\n" unless ( -r $xmlFile ); + die "$xmlFile is not a file.\n" unless ( -f $xmlFile ); + our $parser = XML::LibXML -> new(); + our $root = $parser -> parse_file($xmlFile) -> getDocumentElement; + our $inputExperiment = $ARGV[0]; + die "$0: Experiment $inputExperiment does not exist in file $xmlFile.\n" unless ( experimentExistsInXML($inputExperiment) ); + $diag_table_file = getDiagTableFromXML($inputExperiment); + } +} + +# Check if the diag table file exists, is not a directory and is readable. +die "$0: File $diag_table_file does not exist.\n" unless ( -e $diag_table_file ); +die "$0: File $diag_table_file exists, but is unreadable.\n" unless ( -r $diag_table_file ); +die "$0: $diag_table_file is not a file.\n" unless ( -f $diag_table_file ); + +# Announce what file we are going to read. +print "Reading file $diag_table_file\n\n"; + +# Open the file handler for the filename. +open(DIAG_TABLE, "<", $diag_table_file); + +# Arrays to hold files and fields. +my @files = ( { + file_name => '', + output_frequency => 0, + output_frequency_units => 0, + output_format => 0, + time_units => 0, + long_name => '', + new_file_frequency => 0, + new_file_frequency_units => 0, + start_time_string => '', + file_duration => 0, + file_duration_units => 0, + } ); + +my @fields = ( { + file_name => '', + module_name => '', + field_name => '', + output_name => '', + time_sampling => '', + time_method => '', + spatial_ops => '', + packing => 0, + } ); + +# Other variables to hold useful information. +my %fields_per_file; +my @warnings = ( { line_number => 0, + message => '', + } ); +my $tableName; +my @globalDate; +# Parse the data from the diag table file, and put it in the +# appropiate array. +while ( ) { + my $line = sanitizeString($_); + next if ( $line =~ /^#/ or $line =~ /^$/ ); + my @line_data = split(/,/,$line,11); + + my $num_warnings = 0; + + if ( $#line_data == 0 ) { # No Commas in string + # Find the descriptor and base date. Neither should have a comma. + my @date = split(/\s+/, sanitizeString($line_data[0])); + if ( $#date >= 1 ) { # We have a date. + my $message = verifyDate(@date); + if ( $message ) { + push @warnings, ( { + line_number => $., + message => "Invalid global date. $message", + } ); + } else { + @globalDate = @date; + } + } else { # We have the the descriptor / table name or the date may be set by the script + if ( $line_data[0] =~ /^\$.*[dD]ate$/ ) { + @globalDate[0] = $line_data[0]; + } else { + $tableName = sanitizeString($line_data[0]); + } + } + } elsif ( $#line_data > 1 ) { + if ( $tableName =~ /^$/ or $globalDate[0] =~ /^$/ ) { + push @warnings, ( { + line_number => $., + message => 'The table descriptor and the base date must be set before any files or fields.', + } ); + $tableName = 'NOT SET' if ( $tableName =~ /^$/ ); + $globalDate[0] = 'NOT SET' if ( $globalDate[0] =~ /^$/ ) ; + } + if ( lc($line_data[5]) =~ /time/ ) { # This is a file. + # Check output_frequency :: Must be >= -1 + if ( $line_data[1] < -1 ) { + $num_warnings++; + push @warnings, ( { + line_number => $., + message => 'Invalid output frequency. Must be >= -1.', + } ); + } + # check output_frequency units :: return from find_unit_ivalue() > 0 + if ( find_unit_ivalue($line_data[2]) < 0 ) { + $num_warnings++; + $line_data[2] =~ s/"//g; + push @warnings, ( { + line_number => $., + message => "Invalid output frequency unit. ($line_data[2]).", + } ); + } + # check output_format :: Must be in the range 1 <= output_format <= 2 + if ( $line_data[3] < 1 or $line_data[3] > 2 ) { + $num_warnings++; + push @ warnings, ( { + line_number => $., + message => "Output_format out of range. Must be in the range [1,2].", + } ); + } + # check time_units :: return from find_unit_ivalue() > 0 + if ( find_unit_ivalue($line_data[4]) < 0 ) { + $num_warnings++; + $line_data[4] =~ s/"//g; + push @warnings, ( { + line_number => $., + message => "Invalid time unit. ($line_data[4]).", + } ); + } + # The following are optional. (There may be a slight problem if the line ends with a ','.) + if ( $#line_data > 6 ) { + # Check new_file_frequency :: Must be > 0 + if ( $line_data[6] < 0 ) { + $num_warnings++; + push @warnings, ( { + line_number => $., + message => "Invalid new file frequency. Must be > 0.", + } ); + } + # Check new_file_frequency_units :: return from find_unit_ivalue() > 0 + if ( find_unit_ivalue($line_data[7]) < 0 ) { + $num_warnings++; + $line_data[7] =~ s/"//g; + push @warnings, ( { + line_number => $., + message => "Invalid new file frequency unit. ($line_data[7]).", + } ); + } + # More optional inputs + if ( $#line_data >= 8 ) { + $num_warnings++; + # remove quotes, beginning and ending space. + $line_data[8] =~ s/"//g; + $line_data[8] =~ s/^\s+//; + $line_data[8] =~ s/\s+$//; + my @start_time = split(/\s+/,$line_data[8]); + # Check start_time_string :: Must be valid date string + my $message = verifyDate(@start_time); + if ( $message ) { + push @warnings, ( { + line_number => $., + message => "Invalid start time format. $message", + } ); + } + # The last two optional inputs + if ( $#line_data > 8 ) { + # Check file_duration :: Must be > 0 + if ( $line_data[9] < 0 ) { + $num_warnings++; + push @warnings, ( { + line_number => $., + message => "Invalid file duration. Must be > 0.", + } ); + } + # Check file_duration_units :: return from find_unit_ivalue() > 0 + if ( find_unit_ivalue($line_data[10]) < 0 ) { + $num_warnings++; + $line_data[10] =~ s/"//g; + push @ warnings, ( { + line_number => $., + message => "Invalid file duration unit. ($line_data[10]).", + } ); + } + } + } + } + if ( $num_warnings == 0 ) { + push @files, ( { + file_name => sanitizeString($line_data[0]), + output_frequency => sanitizeString($line_data[1]), + output_frequency_units => sanitizeString($line_data[2]), + output_format => sanitizeString($line_data[3]), + time_units => sanitizeString($line_data[4]), + long_name => sanitizeString($line_data[5]), + new_file_frequency => sanitizeString($line_data[6]), + new_file_frequency_units => sanitizeString($line_data[7]), + start_time_string => sanitizeString($line_data[8]), + file_duration => sanitizeString($line_data[9]), + file_duration_units => sanitizeString($line_data[10]), + } ); + $fields_per_file{$files[$#files]{file_name}} = 0; + # print "File found (",$files[$#files]{file_name},"), line ",$.,".\n"; + } + } else { # This is a field. + # Make sure there are enough fields on the description line :: must be = 8. + if ( $#line_data != 7 ) { + $num_warnings++; + my $message; + # Are there too many? + if ( $#line_data > 7 ) { + $message = "Too many fields on field description line."; + } else { # Nope, too few. + $message = "Not enough fields on field description line."; + } + push @warnings, ( { + line_number => $., + message => $message, + } ); + } + + # Verify that file_name exists in the files array + $line_data[3] =~ s/"//g; + $line_data[3] =~ s/^\s+//; + $line_data[3] =~ s/\s+$//; + my $notfound = 1; + for (my $i=0; $i <= $#files; $i++) { + if ( $files[$i]{file_name} =~ $line_data[3] ) { + $notfound = 0; + last; + } + } + if ( $notfound ) { + $num_warnings++; + push @warnings, ( { + line_number => $., + message => "File ($line_data[3]) not defined. It must be defined before any fields.", + } ); + } + # Verify time_method / time_avg is valid + if ( invalid_timeSample(sanitizeString($line_data[5])) ) { + $ num_warnings++; + push @warnings, ( { + line_number => $., + message => "Time sampling method must be one of (.true., mean, average, avg, .false., none, point, maximum, max, minimum, min, diurnal[#]).", + } ); + } + # Verify packing is valid :: must be in range [1,8] + if ( $line_data[7] < 1 or $line_data[7] > 8 ) { + $num_warnings++; + push @warnings, ( { + line_number => $., + message => "Packing is out of the valid range. Must be in the range [1,8]." + } ); + } + if ( $num_warnings == 0 ) { + push @fields, ( { + file_name => sanitizeString($line_data[3]), + module_name => sanitizeString($line_data[0]), + field_name => sanitizeString($line_data[1]), + output_name => sanitizeString($line_data[2]), + time_sampling => sanitizeString($line_data[4]), + time_method => sanitizeString($line_data[5]), + spatial_ops => sanitizeString($line_data[6]), + packing => sanitizeString($line_data[7]), + } ); + $fields_per_file{$fields[$#fields]{file_name}}++; + } + } + } +} + +if ( $verbose ) { + my $files2output; + my $fields2output; + open(FILES, '>', \$files2output); + open(FIELDS, '>', \$fields2output); + + my $file_name; + my $output_frequency; + my $output_frequency_units; + my $output_format; + my $time_units; + my $module_name; + my $field_name; + my $output_name; + my $time_sampling; + my $time_method; + my $spatial_ops; + my $packing; + +format FILES_TOP = + Files + Output Axis +File Name Frequency FMT Units +------------------------------------------------------------ +. + +format FILES = +@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @>>> @<<<<<<< @||| @<<<< +$file_name, $output_frequency, $output_frequency_units, $output_format, $time_units +. + + for ( my $file=1; $file <= $#files; $file++ ) { + $file_name = $files[$file]{file_name}; + $output_frequency = $files[$file]{output_frequency}; + $output_frequency_units = $files[$file]{output_frequency_units}; + $output_format = $files[$file]{output_format}; + $time_units = $files[$file]{time_units}; + write FILES; + } + +format FIELDS_TOP = + + Fields + Output Sample Spatial +Field Name Module File Name Name Samples Method Ops Packing +------------------------------------------------------------------------------------------------------------- +. + +format FIELDS = +@<<<<<<<<<<<<<<< @<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<< @<<<<< @<<<<<< @<<< @< +$field_name, $module_name, $file_name, $output_name, $time_sampling, $time_method, $spatial_ops, $packing +. + + for ( my $field=1; $field <=$#fields; $field++ ) { + $module_name = $fields[$field]{module_name}; + $field_name = $fields[$field]{field_name}; + $output_name = $fields[$field]{output_name}; + $file_name = $fields[$field]{file_name}; + $time_sampling = $fields[$field]{time_sampling}; + $time_method = $fields[$field]{time_method}; + $spatial_ops = $fields[$field]{spatial_ops}; + $packing = $fields[$field]{packing}; + write FIELDS; + } + # Output the files and fields + close(FILES); + close(FIELDS); + print $files2output; + print $fields2output; + print "\n"; +} + +print "Table Descriptor:\t",$tableName,"\n"; +print "Base Date:\t\t",join(' ',@globalDate),"\n"; +print "Number of files:\t",$#files,"\n"; +print "Max fields per file:\t",max(values(%fields_per_file)),"\n"; +print "Number of warnings:\t",$#warnings,"\n"; + +if ( $#warnings ) { + for ( my $warning=1; $warning <= $#warnings; $warning++ ) { + print STDERR "WARNING($warnings[$warning]{line_number}): $warnings[$warning]{message}\n"; + } +} + +# Verify that the given unit is understood. +# A return value of -1 indicated an unknown unit. +sub invalid_timeSample { + my $timeSample = $_[0]; + + switch ($timeSample) { + case (/^\.true\.$/i) { return 0; } + case (/^\.false\.$/i) { return 0; } + case (/^mean|average|avg$/) { return 0; } + case (/^none|point$/) { return 0; } + case (/^maximum|max$/) { return 0; } + case (/^minimum|min$/) { return 0; } + case (/^diurnal\d+$/) { return 0; } + else { return 1 }; + } +} + +# Verify that the given unit is understood. +# A return value of -1 indicated an unknown unit. +sub find_unit_ivalue { + my $unit_string = $_[0]; + + switch ($unit_string) { + case (/seconds/) { return 1; } + case (/minutes/) { return 2; } + case (/hours/) { return 3; } + case (/days/) { return 4; } + case (/months/) { return 5; } + case (/years/) { return 6; } + else { return -1 } + } +} + +sub experimentExistsInXML { + my $experiment = shift(@_); + my $experimentNode = $::root -> findnodes("experiment[\@label='$experiment' or \@name='$experiment']") -> get_node(1); + + return $experimentNode; +} + +sub getDiagTableFromXML { + my $experiment = shift(@_); + my $diagTableNode = $::root -> findnodes("experiment[\@label='$experiment' or \@name='$experiment']/input/diagTable") -> get_node(1); + + # If the diagTable node is empty, then recursivly check the parent experiment until it is found. + if ( $diagTableNode ) { + return $diagTableNode -> findvalue("\@file"); + } else { + my $parent = $::root -> findvalue("experiment[\@label='$experiment' or \@name='$experiment]/\@inherit"); + if ( $parent) { + &getDiagTable($parent); + } else { + die "$0: Cannot find diagTable tag in the XML file $::xmlFile.\n" + } + } +} + +sub verifyDate { + # The date must already be in an array. We will check the size here. + # The format should be (year, month, day, hour, min, sec) + my @date = @_; + my $leapYear = 0; + + my @months = ( { month => 'January', + days => 31 }, + { month => 'February', + days => 28 }, + { month => 'March', + days => 31 }, + { month => 'April', + days => 30 }, + { month => 'May', + days => 31 }, + { month => 'June', + days => 30 }, + { month => 'July', + days => 31 }, + { month => 'August', + days => 31 }, + { month => 'September', + days => 30 }, + { month => 'October', + days => 31 }, + { month => 'November', + days => 30 }, + { month => 'December', + days => 31 } ); + + if ( scalar(@date) != 6 ) { + # Wrong number of elements in date. Are we too big? + return 'Too many elements in date string.' if ( scalar(@date) > 6 ) ; + return 'Too few elements in date string.' if ( scalar(@date) < 6 ); + } + + return 'Year must be > 0.' if ( $date[0] < 0 ); + + # Correct number of days in February if this is a leap year. + $months[1]{days} = $months[1]{days} + 1 if ( isLeapYear($date[0]) ); + + return 'Month must be in the range [1,12].' if ( $date[1] < 1 or $date[1] > 12 ) ; + + return "Days must be in the range [1,$months[$date[1]-1]{days}] for $months[$date[1]-1]{month} in year $date[0]." if ( $date[2] < 1 or $date[2] > $months[$date[1]-1]{days} ); + + return 'Hours must be in the range [0,24].' if ( $date[3] < 0 or $date[3] > 24 ); + + return 'Minutes must be in the range [0,60].' if ( $date[4] < 0 or $date[4] > 60 ); + + return 'Seconds must be in the range [0,60].' if ( $date[5] < 0 or $date[5] > 60 ); + + return ''; +} + +sub isLeapYear { + my $year = shift(@_); + + if ( ($year % 4 == 0) and ($year % 100 != 0) or ($year % 400 == 0) ) { + return 1; + } else { + return 0; + } +} + +sub sanitizeString { + # Remove the quote marks and any additional space before and after + # the string. + my $string = shift(@_); + + $string =~ s/"//g; + $string =~ s/^\s+//; + $string =~ s/\s+$//; + + return $string; +} + +__END__ + +=head1 NAME + +diag_table_chk - Parse a diag_table, and report the number of files, max fields, and parse errors + +=head1 SYNOPSIS + +diag_table_chk [-h|--help] + +diag_table_chk [-v|--verbose] I + +diag_table_chk [-v|--verbose] -x I I + +=head1 DESCRIPTION + +B will parse a diag_table and report on the number of +files in the diag_table, the max fields used per file, and will give +warnings on any parse errors found in the format of 'WARNING()'. + +=head1 OPTIONS + +=over 8 + +=item B<-h>, B<--help> + +Display usage information + +=item B<-v>, B<--verbose> + +Display the files and fields that were found. + +=item B<-x>, B<--xml> + +Read the diagnostic table file from I<> from the I<>. + +=item + +The file name of the diagnostic table to check + +=back + +=head1 EXAMPLE + + > diag_table_chk -x SM2.1U-LM3V.xml SM2.1U_Control-1990_lm3v_pot_A1 + + Table Descriptor: NOT SET + Base Date: 0101 01 01 0 0 0 + Number of files: 14 + Max fields per file: 93 + Number of warnings: 2 + WARNING(3): The table descriptor and the base date must be set before any files or fields. + WARNING(206): Time sampling method must be one of (.true., mean, average, avg, .false., none, point, maximum, max, minimum, min, diurnal[#]). + +=head1 AUTHOR + +Seth Underwood + +=head1 BUGS + +No known bugs at this time. +Report any bug to the author. + +=cut diff --git a/MOM_code/bin/environs.gfdl_ws_32.intel b/MOM_code/bin/environs.gfdl_ws_32.intel new file mode 100644 index 0000000..cd80b1f --- /dev/null +++ b/MOM_code/bin/environs.gfdl_ws_32.intel @@ -0,0 +1,17 @@ + source $MODULESHOME/init/csh + module use -a /home/fms/local/modulefiles + module purge + module load ifort.11.0.074 + module load icc.11.0.074 + module load idb.10.1.35 + module load hdf5-1.8.3 + module load netcdf-4.0.1 + setenv OMP_NUM_THREADS 1 +# + setenv NC_BLKSZ 64K + setenv FMS_ARCHIVE /archive/fms + setenv PATH ${PATH}:. + setenv netcdf3_inc_dir "/usr/local/netcdf-3.6.2/include" + setenv netcdf3_lib_dir "/usr/local/netcdf-3.6.2/lib" + setenv mpirunCommand "mpirun -np" + diff --git a/MOM_code/bin/environs.gfdl_ws_64.gnu b/MOM_code/bin/environs.gfdl_ws_64.gnu new file mode 100644 index 0000000..a4a20fa --- /dev/null +++ b/MOM_code/bin/environs.gfdl_ws_64.gnu @@ -0,0 +1,14 @@ + source $MODULESHOME/init/csh + module purge + module rm netcdf hdf5 + module load mpich2/1.2.1p1 + module use -a /home/fms/local/modulefiles + module load hdf5/1.8.5-patch1-gnu-4 + module load netcdf/4.1.1-gnu-4 +# + setenv PATH ${PATH}:. + setenv mpirunCommand "/net2/nnz/opt/mpich2-1.3_ifort11_x64/bin/mpirun -np" + setenv FMS_ARCHIVE /archive/fms + setenv PATH ${PATH}:. + + diff --git a/MOM_code/bin/environs.gfdl_ws_64.intel b/MOM_code/bin/environs.gfdl_ws_64.intel new file mode 100644 index 0000000..6e63048 --- /dev/null +++ b/MOM_code/bin/environs.gfdl_ws_64.intel @@ -0,0 +1,16 @@ + source $MODULESHOME/init/csh + module use -a /home/fms/local/modulefiles + module purge + module rm netcdf hdf5 + module load ifort/11.1.073 + module load icc/11.1.073 + module load hdf5/1.8.6 + module load netcdf/4.1.2 + module load mpich2/1.2.1p1 +# + setenv PATH ${PATH}:. + setenv mpirunCommand "/net2/nnz/opt/mpich2-1.3_ifort11_x64/bin/mpirun -np" + setenv FMS_ARCHIVE /archive/fms + setenv PATH ${PATH}:. + + diff --git a/MOM_code/bin/environs.gfortran b/MOM_code/bin/environs.gfortran new file mode 100644 index 0000000..e69de29 diff --git a/MOM_code/bin/environs.hpcs.intel b/MOM_code/bin/environs.hpcs.intel new file mode 100644 index 0000000..214c2bc --- /dev/null +++ b/MOM_code/bin/environs.hpcs.intel @@ -0,0 +1,16 @@ + source /opt/modules/default/init/tcsh + module purge + module load ifort.11.0.074 + module load icc.11.0.074 + module load idb.11.0.034 + module load scsl-1.5.1.0 + module load mpt-1.18 + module load hdf5-1.8.1 + module load netcdf-4.0.1 + setenv NC_BLKSZ 64K + setenv FMS_ARCHIVE /archive/fms + setenv PATH ${PATH}:. + setenv netcdf3_inc_dir "/usr/local/netcdf-3.6.2/include" + setenv netcdf3_lib_dir "/usr/local/netcdf-3.6.2/lib" + setenv mpirunCommand "mpirun -np" + diff --git a/MOM_code/bin/environs.ibm.xlf b/MOM_code/bin/environs.ibm.xlf new file mode 100644 index 0000000..57deddb --- /dev/null +++ b/MOM_code/bin/environs.ibm.xlf @@ -0,0 +1,3 @@ +export OMP_NUM_THREADS=1 +export BG_APPTHREADDEPTH=1 + diff --git a/MOM_code/bin/environs.ifc b/MOM_code/bin/environs.ifc new file mode 100644 index 0000000..e69de29 diff --git a/MOM_code/bin/environs.ifc.RNP b/MOM_code/bin/environs.ifc.RNP new file mode 100644 index 0000000..e69de29 diff --git a/MOM_code/bin/environs.ifc.pocNP b/MOM_code/bin/environs.ifc.pocNP new file mode 100644 index 0000000..e69de29 diff --git a/MOM_code/bin/environs.ifc.pocNP-OMPI b/MOM_code/bin/environs.ifc.pocNP-OMPI new file mode 100644 index 0000000..e69de29 diff --git a/MOM_code/bin/environs.ifc.test b/MOM_code/bin/environs.ifc.test new file mode 100644 index 0000000..e69de29 diff --git a/MOM_code/bin/environs.nci b/MOM_code/bin/environs.nci new file mode 100644 index 0000000..a492176 --- /dev/null +++ b/MOM_code/bin/environs.nci @@ -0,0 +1,8 @@ + source /etc/profile.d/nf_csh_modules + module purge + module load intel-fc + module load intel-cc + module load hdf5 + module load netcdf + module load openmpi + setenv mpirunCommand "mpirun -np" diff --git a/MOM_code/bin/environs.ncrc1.intel b/MOM_code/bin/environs.ncrc1.intel new file mode 100644 index 0000000..d4bdcaa --- /dev/null +++ b/MOM_code/bin/environs.ncrc1.intel @@ -0,0 +1,21 @@ +#This file should set all the necessary system environment variables +#and/or load all the necessary modules for the code to compile and run on the specific platform. +#Users need to find these for their systems. +# + source $MODULESHOME/init/csh + module rm PrgEnv-pgi PrgEnv-pathscale netcdf + module load PrgEnv-intel/3.1.29 + module load hdf5/1.8.4.1 + module load netcdf/4.0.1.3 + module load nco + module list + setenv MPICH_MAX_SHORT_MSG_SIZE 8000 + setenv NC_BLKSZ 1M + setenv F_UFMTENDIAN big + setenv OMP_NUM_THREADS 1 +# + setenv FMS_ARCHIVE /lustre/fs/archive/fms + setenv mpirunCommand "aprun -n" + setenv PATH ${PATH}:. + setenv netcdf3_inc_dir "/opt/cray/netcdf/3.6.2/netcdf-gnu/include" + setenv netcdf3_lib_dir "/opt/cray/netcdf/3.6.2/netcdf-gnu/lib" diff --git a/MOM_code/bin/environs.ncrc2.gnu b/MOM_code/bin/environs.ncrc2.gnu new file mode 100644 index 0000000..6460981 --- /dev/null +++ b/MOM_code/bin/environs.ncrc2.gnu @@ -0,0 +1,15 @@ + source $MODULESHOME/init/csh + module use -a /ncrc/home2/fms/local/modulefiles + module unload PrgEnv-pgi PrgEnv-pathscale PrgEnv-intel PrgEnv-gnu PrgEnv-cray + module unload netcdf fre fre-commands + module load PrgEnv-gnu + module load hdf5/1.8.8 + module load netcdf/4.2.0 + module list + setenv MPICH_MAX_SHORT_MSG_SIZE 8000 + setenv KMP_STACKSIZE 512m + setenv NC_BLKSZ 1M + + setenv mpirunCommand "aprun -n" + setenv PATH ${PATH}:. + diff --git a/MOM_code/bin/environs.ncrc2.intel b/MOM_code/bin/environs.ncrc2.intel new file mode 100644 index 0000000..fda798e --- /dev/null +++ b/MOM_code/bin/environs.ncrc2.intel @@ -0,0 +1,21 @@ +#This file should set all the necessary system environment variables +#and/or load all the necessary modules for the code to compile and run on the specific platform. +#Users need to find these for their systems. +# + source $MODULESHOME/init/csh + module rm PrgEnv-pgi PrgEnv-pathscale netcdf + module load PrgEnv-intel + module swap intel intel/12.0.5.220 + module load hdf5/1.8.7 + module load netcdf/4.1.3 + module list + setenv MPICH_MAX_SHORT_MSG_SIZE 8000 + setenv NC_BLKSZ 1M + setenv F_UFMTENDIAN big +# setenv OMP_NUM_THREADS 1 +# +# setenv FMS_ARCHIVE /lustre/fs/archive/fms + setenv mpirunCommand "aprun -n" + setenv PATH ${PATH}:. +# setenv netcdf3_inc_dir "/opt/cray/netcdf/3.6.2/netcdf-gnu/include" +# setenv netcdf3_lib_dir "/opt/cray/netcdf/3.6.2/netcdf-gnu/lib" diff --git a/MOM_code/bin/environs.workstation.gfort b/MOM_code/bin/environs.workstation.gfort new file mode 100644 index 0000000..124be6e --- /dev/null +++ b/MOM_code/bin/environs.workstation.gfort @@ -0,0 +1,2 @@ + setenv mpirunCommand "mpirun -np" + diff --git a/MOM_code/bin/environs.workstation.intel b/MOM_code/bin/environs.workstation.intel new file mode 100644 index 0000000..cd80b1f --- /dev/null +++ b/MOM_code/bin/environs.workstation.intel @@ -0,0 +1,17 @@ + source $MODULESHOME/init/csh + module use -a /home/fms/local/modulefiles + module purge + module load ifort.11.0.074 + module load icc.11.0.074 + module load idb.10.1.35 + module load hdf5-1.8.3 + module load netcdf-4.0.1 + setenv OMP_NUM_THREADS 1 +# + setenv NC_BLKSZ 64K + setenv FMS_ARCHIVE /archive/fms + setenv PATH ${PATH}:. + setenv netcdf3_inc_dir "/usr/local/netcdf-3.6.2/include" + setenv netcdf3_lib_dir "/usr/local/netcdf-3.6.2/lib" + setenv mpirunCommand "mpirun -np" + diff --git a/MOM_code/bin/list_files_with_tag b/MOM_code/bin/list_files_with_tag new file mode 100755 index 0000000..08a8cfc --- /dev/null +++ b/MOM_code/bin/list_files_with_tag @@ -0,0 +1,73 @@ +#!/usr/bin/perl +#Contact: arl, pjk +#Usage: list_files_with_tag tagname +# Returns list of files under CVS control, relative to current +# directory, which can be updated or checked out with the tag tagname. +#Modified to also list files not currently checked out (arl, 4/2002) +#Version: $Id: list_files_with_tag,v 1.1.2.1 2013/12/18 17:47:54 Niki.Zadeh Exp $ + +#test that a tagname was given as an argument +if( "$#ARGV" ne "0" ) { + print "\nUsage: list_files_with_tag tagname\n\n"; + print " Returns list of files under CVS control, relative to current\n"; + print " directory, which can be updated or checked out with the tag tagname.\n\n"; + exit; +} +$tag = @ARGV[0]; + +#use cvs status on files in the current directory to determine which +#have the given tag. This includes those files which have been deleted +#on the branch tag. Then parse the output into %files. + +@cvsstatus = `cvs status -v 2>&1`; +$i = 0; +while($i <= $#cvsstatus) { + if( $cvsstatus[$i] =~ /cvs status: Examining (\S+)/ ) { + $thisdir = $1; + } + elsif( $cvsstatus[$i] =~ /^File: \w/ ) { + @thisline = split ' ',$cvsstatus[$i]; + $currentfile = $thisline[1]; + } + elsif( $cvsstatus[$i] =~ /Existing Tags/ ) { +#skip a line + $i++; +#Each tag line is of the form tag (branch/revision...) + while ($cvsstatus[$i] =~ s/\(.+\)//g) { +#remove blanks + $cvsstatus[$i] =~ s/\s+//g; +#create hash of files (unique list). Don't print "./" in front of files. + if ($tag =~ /^$cvsstatus[$i]$/) { + if( "$thisdir" eq "." ) { + $files{"$currentfile"} = 1; + } + else { + $files{"$thisdir/$currentfile"} = 1; + } + } + $i++; + } + } + $i++; +} + +#Add list of files that would be checked out with this tag. +#This will include new files not currently checked out. + +@cvsupdate = `cvs update -p -d -r $tag 2>&1`; +$i = 0; +while($i <= $#cvsupdate ) { + if( $cvsupdate[$i] =~ /Checking out/ ) { + @line = split(' ', $cvsupdate[$i]); + $files{"$line[2]"} = 1; + } + $i++; +} + +@unique_files = sort(keys(%files)); + +if( @unique_files ) { + foreach $file (@unique_files) { + print "$file\n"; + } +} diff --git a/MOM_code/bin/list_paths b/MOM_code/bin/list_paths new file mode 100755 index 0000000..1cb890b --- /dev/null +++ b/MOM_code/bin/list_paths @@ -0,0 +1,98 @@ +#!/bin/csh -ef +# $Id: list_paths,v 1.1.2.1 2013/12/18 17:47:54 Niki.Zadeh Exp $ +#----------------------------------------------------------------------- +# list_paths: CVS administrative script +# +# AUTHOR: V. Balaji (vb@gfdl.gov) +# SGI/GFDL Princeton University +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# For the full text of the GNU General Public License, +# write to: Free Software Foundation, Inc., +# 675 Mass Ave, Cambridge, MA 02139, USA. +#----------------------------------------------------------------------- +# script to be run from the CVSROOT/modules file to create path lists +# $1 contains the name of the archive being checked out +# this script creates two files: +# path_names contains all the source files ( *.{c,C,f,F,fh,f90,F90,h,H,inc} ) +# path_names.html contains all the doc files ( *.{html,ps,txt}, README, readme ) +# NOTE: if these files exist, they are appended to. +# This is necessary, since for aliases that checkout multiple +# directories you need to keep the results from earlier checkouts. +# This could yield unexpected results if you use the same working +# directory for different experiments using different modules. You +# must remove these files if beginning a fresh experiment. + +set argv = (`getopt o: $*`) +set out = "$cwd/path_names" +#--------------------------------------------------- +while ("$argv[1]" != "--") + switch ($argv[1]) + case -o: + set out = $argv[2]; shift argv; breaksw + endsw + shift argv +end +shift argv +#--------------------------------------------------- + +unset noclobber +if( $?DEBUG )echo Running $0 in $cwd, args $* + +set src = "$out.src.tmp" +set doc = "$out.doc.tmp" +set outdoc = "$out.html" + +touch $out # create the file if it doesn't exist +cp $out $src +find $* -type f \ + \( -name \*.c \ + -o -name \*.C \ + -o -name \*.f \ + -o -name \*.fh \ + -o -name \*.F \ + -o -name \*.f90 \ + -o -name \*.F90 \ + -o -name \*.h \ + -o -name \*.H \ + -o -name \*.inc \ + \) -print >> $src + +sed 's:.*/\(.*\):\0 \1:' $src | nl | sort --key 3 -u | sort -n | awk '{print $2}' > $out +echo "A list of the files you checked out is in the file $out ..." + +touch $doc # create the file if it doesn't exist +find $* -type f \ + \( -name \*.html \ + -o -name \*.ps \ + -o -name \*.txt \ + -o -name \*.pdf \ + -o -name \*.jpg \ + -o -name readme \ + -o -name read_me \ + -o -name README \ + \) -print > $src +if ( -z $src ) then + rm -f $doc $src + exit +endif +# $src has non-zero size (i.e some doc exists) +cat $src >> $doc + +#write path_names.html file +echo "Documentation in current working directory" > $outdoc +echo "

Documentation in current working directory

" >> $outdoc +sort -u $doc | awk '{print "

" $1 ""}' >> $outdoc +echo '

This file was automatically generated by list_paths.' >> $outdoc +echo '$Revision: 1.1.2.1 $ $Date: 2013/12/18 17:47:54 $' >> $outdoc + +rm -f $doc $src diff --git a/MOM_code/bin/mkmf b/MOM_code/bin/mkmf new file mode 100755 index 0000000..75f3cd5 --- /dev/null +++ b/MOM_code/bin/mkmf @@ -0,0 +1,472 @@ +#!/usr/bin/perl +#----------------------------------------------------------------------- +# mkmf: Perl script for makefile construction +# +# AUTHOR: V. Balaji (v.balaji@noaa.gov) +# Princeton University/GFDL +# +# Full web documentation for mkmf: +# http://www.gfdl.noaa.gov/~vb/mkmf.html +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# For the full text of the GNU General Public License, +# write to: Free Software Foundation, Inc., +# 675 Mass Ave, Cambridge, MA 02139, USA. +#----------------------------------------------------------------------- + +$ENV{'LANG'} = 'C'; +require 5; +use strict; +use File::Basename; +use Getopt::Std; +use Config; # use to put in platform-specific stuff +use vars qw( $opt_a $opt_c $opt_d $opt_f $opt_l $opt_m $opt_o $opt_p $opt_t $opt_v $opt_x $opt_I ); # declare these global to be shared with Getopt:Std + +#subroutines +sub ensureTrailingSlash { +#ensure trailing slash on directory names + local $/ = '/'; chomp @_[0]; @_[0] .= '/'; +} + +my $version = '$Id: mkmf,v 1.1.2.1 2013/12/18 17:47:54 Niki.Zadeh Exp $ '; + +# initialize variables: use getopts for these +getopts( 'a:I:c:dfm:o:l:p:t:vx' ) || die "\aSyntax: $0 [-a abspath] [-c cppdefs] [-d] [-f] [-m makefile] [-o otherflags] ][-p program] [-t template] [-v] [-x] [-I \"space separated include dirs\"] [targets]\n"; +$opt_v = 1 if $opt_d; # debug flag turns on verbose flag also +print "$0 $version\n" if $opt_v; + +my $mkfile = $opt_m || 'Makefile'; +print "Making makefile $mkfile ...\n" if $opt_v; + +$opt_p = 'a.out' unless $opt_p; # set default program name +my @targets = '.'; # current working directory is always included in targets +push @targets, @ARGV; # then add remaining arguments on command line + +ensureTrailingSlash($opt_a) if $opt_a; + +#some generic declarations +my( $file, $include, $line, $module, $name, $object, $path, $source, $suffix, $target, $word ); +my @list; +#some constants +my $endline = $/; +my @src_suffixes = ( q/\.F/, q/\.F90/, q/\.c/, q/\.f/, q/\.f90/ ); +my @inc_suffixes = ( q/\.H/, q/\.fh/, q/\.h/, q/\.inc/, q/\.h90/ ); +# push @inc_suffixes, @src_suffixes; # sourcefiles can be includefiles too: DISALLOW, 6 May 2004 +# suffixes for the target (mkmf -p): if isn't on the list below it's a program +my @tgt_suffixes = ( q/\.a/ ); + +my %compile_cmd = ( # command to create .o file from a given source file suffix + q/.F/ => q/$(FC) $(CPPDEFS) $(CPPFLAGS) $(FPPFLAGS) $(FFLAGS) $(OTHERFLAGS) -c/, + q/.F90/ => q/$(FC) $(CPPDEFS) $(CPPFLAGS) $(FPPFLAGS) $(FFLAGS) $(OTHERFLAGS) -c/, + q/.c/ => q/$(CC) $(CPPDEFS) $(CPPFLAGS) $(CFLAGS) $(OTHERFLAGS) -c/, + q/.f/ => q/$(FC) $(FFLAGS) $(OTHERFLAGS) -c/, + q/.f90/ => q/$(FC) $(FFLAGS) $(OTHERFLAGS) -c/ ); +my %delim_match = ( q/'/ => q/'/, # hash to find includefile delimiter pair + q/"/ => q/"/, + q/ q/>/ ); + +#formatting command for MAKEFILE, keeps very long lines to 256 characters +format MAKEFILE = +^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< \~ +$line +. + +sub print_formatted_list{ +#this routine, in conjunction with the format line above, can be used to break up long lines +# it is currently used to break up the potentially long defs of SRC, OBJ, CPPDEFS, etc. +# not used for the dependency lists + $line = "@_"; + local $: = " \t\n"; # the default formatting word boundary includes the hyphen, but not here + while ( $opt_f && length $line > 254 ) { + write MAKEFILE, $line; + } + print MAKEFILE $line unless $line eq ''; + print MAKEFILE "\n"; +} + +#begin writing makefile +open MAKEFILE, ">$mkfile" or die "\aERROR opening file $mkfile for writing: $!\n"; +printf MAKEFILE "# Makefile created by %s $version\n\n", basename($0); +print MAKEFILE "SRCROOT = $opt_a\n\n" if $opt_a; # make abspath a variable +if ( $opt_c ) { + $opt_c =~ s/\s+$//; + if ( $Config{osname} eq 'aix' ) { + $opt_c .= ' -D__aix'; +#AIX fortran (xlf) requires -WF, in front, comma delimiter, no spaces + my $cppdefs_xlf = '-WF "' . $opt_c . '"'; + $cppdefs_xlf =~ s/,/\\,/g; # escape any commas already there + $cppdefs_xlf =~ s/\s+/,/g; # replace whitespace with commas + &print_formatted_list("CPPDEFS_XLF = $cppdefs_xlf"); + $compile_cmd{'.F'} = q/$(FC) $(CPPDEFS_XLF) $(FFLAGS) $(OTHERFLAGS) -c/; + $compile_cmd{'.F90'} = q/$(FC) $(CPPDEFS_XLF) $(FFLAGS) $(OTHERFLAGS) -c/; + } + &print_formatted_list("CPPDEFS = $opt_c") if $opt_c; +} +print MAKEFILE "\nOTHERFLAGS = $opt_o" if $opt_o; +#vb 2009-12-17, include now comes after vardefs, so that it can modify make variables +print MAKEFILE "\n\ninclude $opt_t\n\n" if $opt_t; #include template if supplied +print MAKEFILE "\n.DEFAULT:\n\t-echo \$@ does not exist.\n"; +print MAKEFILE "all: $opt_p\n"; # first target should be program, so you can type just 'make' + +#if cppdefs flag is present, look for changes in cppdefs +my %chgdefs; +if ( $opt_c ) { +#split argument of -c into newdefs + my %newdefs; + foreach ( split /\s*-D/, $opt_c ) { + $newdefs{$_} = 1; + } +#get olddefs from file .cppdefs + my %olddefs; + my $cppdefsfile = ".$opt_p.cppdefs"; + if ( -f $cppdefsfile ) { + open CPPFILE, $cppdefsfile or die "\aERROR opening cppdefsfile $cppdefsfile: $!\n"; + while ( ) { + foreach $word ( split ) { + $olddefs{$word} = 1; + } + } + close CPPFILE; +#get words that are not in both newdefs and olddefs +#if you move this foreach{} outside the enclosing if{} then +# all cppdefs will be considered changed if there is no .cppdefs file. + foreach ( keys %newdefs, keys %olddefs ) { + $chgdefs{$_} = 1 unless( $newdefs{$_} && $olddefs{$_} ); + } + } +#write current cppdefs list to file .cppdefs + open CPPFILE, ">$cppdefsfile"; + my @newdefs = keys %newdefs; + print CPPFILE " @newdefs\n"; + close CPPFILE; + if( $opt_d ) { + @list = keys %newdefs; print "newdefs= @list\n"; + @list = keys %olddefs; print "olddefs= @list\n"; + @list = keys %chgdefs; print "chgdefs= @list\n"; + } +} +delete $chgdefs{''}; + +# get a list of sourcefiles to be treated from targets +# (a sourcefile is any regular file with a suffix matching src_suffixes) +# if target is a sourcefile, add to list +# if target is a directory, get all sourcefiles there +# if target is a regular file that is not a sourcefile, look for a +# sourcefile on last work of each line, rest of line (if present) is the +# compile command to apply to this file. +#@sources will contain a unique list of sourcefiles in targets +#@objects will contain corresponding objects + +#separate targets into directories and files +my %scanned; # list of directories/files already scanned +my %actual_source_of; # hash returning sourcefile from object +my %source_of; # sourcefile from object, using SRCROOT variable if present +my @includepaths; +my $scanOrder = 0; # used to remember order of directory scan +foreach $target ( @targets ) { + print STDERR '.' unless $opt_v; # show progress on screen (STDERR is used because it is unbuffered) + if ( $opt_a and substr($target,0,1) ne '/' ) { + # if an abs_path exists, attach it to all relative paths + $target = $opt_a . $target; + } + ensureTrailingSlash($target) if( -d $target ); + print "target=$target\n" if $opt_v; +#directory + if ( -d $target && !$scanned{$target} ) { + print "Processing directory $target\n" if $opt_v; + opendir DIR, $target; + my @files = readdir DIR; +#find all sourcefiles in directory DIR + foreach ( @files ) { + ( $name, $path, $suffix ) = fileparse( "$target$_", @inc_suffixes ); + push @includepaths, $target if $suffix; # is this line doing anything? looks like includepaths='' later... + ( $name, $path, $suffix ) = fileparse( "$target$_", @src_suffixes ); + $object = "$name.o"; + if( $suffix && !$actual_source_of{$object} ) { + if ( $opt_a and substr($path,0,1) ne '/' ) { # if an abs_path exists, attach it to all relative paths + ensureTrailingSlash($path); + $path = '' if $path eq './'; + $source_of{$object} = '$(SRCROOT)' . "$path$name$suffix"; + $path = $opt_a . $path; + } + $actual_source_of{$object} = "$path$name$suffix"; + $source_of{$object} = $actual_source_of{$object} unless $source_of{$object}; + } + } + closedir DIR; + $scanned{$target} = $scanOrder++; + } elsif ( -f $target ) { +#file: check if it is a sourcefile + ( $name, $path, $suffix ) = fileparse( $target, @src_suffixes ); + $object = "$name.o"; + if ( !$actual_source_of{$object} ) { + if ( $suffix ) { + $path = '' if $path eq './'; + if ( $opt_a and substr($path,0,1) ne '/' ) { # if an abs_path exists, attach it to all relative paths + ensureTrailingSlash($path); + $source_of{$object} = '$(SRCROOT)' . "$path$name$suffix"; + $path = $opt_a . $path; + } + $actual_source_of{$object} = "$path$name$suffix"; + $source_of{$object} = $actual_source_of{$object} unless $source_of{$object}; + } else { + ( $name, $path, $suffix ) = fileparse( $target, @inc_suffixes ); + if ( ! $suffix ) { +#not a sourcefile: assume it contains list of sourcefiles +#specify files requiring special commands (e.g special compiler flags) thus: +# f90 -Oaggress a.f90 +#if last word on line is not a valid sourcefile, line is ignored + open CMDFILE, $target; + print "Reading commands from $target...\n" if $opt_v; + while ( ) { + next if ( $_ eq "\n"); + $line = $_; + my @wordlist = split; + $file = @wordlist[$#wordlist]; # last word on line + ( $name, $path, $suffix ) = fileparse( $file, @src_suffixes ); + print "file=$file suffix=$suffix in $target\n" if $opt_d; + $object = "$name.o"; + if ( $suffix && !$actual_source_of{$object} ) { + $path = '' if $path eq './'; + if ( $opt_a and ( substr($path,0,1) ne '/' ) ) { # if an abs_path exists, attach it to all relative paths + ensureTrailingSlash($path); + $source_of{$object} = '$(SRCROOT)' . "$path$name$suffix"; + $path = $opt_a . $path; + } + $actual_source_of{$object} = "$path$name$suffix"; + $source_of{$object} = $actual_source_of{$object} unless $source_of{$object}; + $scanned{$path} = $scanOrder++ unless $scanned{$path}; +#command for this file is all of line except the filename + $line =~ /\s+$file/; $line=$`; + if ( $line ) { + $compile_cmd{"$name$suffix"} = $line; + print "Special command for file $name$suffix: ($line)\n" if $opt_v; + } + } + if ( ! $suffix ) { # look for include files + ( $name, $path, $suffix ) = fileparse( $file, @inc_suffixes ); + if ( $opt_a and ( substr($path,0,1) ne '/' ) ) { # if an abs_path exists, attach it to all relative paths + ensureTrailingSlash($path); + $path = $opt_a . $path; + } + print "file=$file path=$path suffix=$suffix order=$scanOrder in $target\n" if $opt_d; +# anything that's found here is an includefile but not a sourcefile... +# just include directory in scan + $scanned{$path} = $scanOrder++ + if ( $suffix && !$scanned{$path} ); + } + } + close CMDFILE; + } + } + } + } +} +delete $actual_source_of{''}; +# sort scanned directories by scan order +sub ascendingScanOrder { $scanned{$a} <=> $scanned{$b}; } +my @dirs = sort ascendingScanOrder keys %scanned; +my @sources = values %source_of; +my @objects = keys %source_of; +if( $opt_d ) { + print "DEBUG: dirs= @dirs\n"; + print "DEBUG: sources= @sources\n"; + print "DEBUG: objects= @objects\n"; +} + +my %obj_of_module; # hash returning name of object file containing module +my %modules_used_by; # hash of modules used by a given source file (hashed against the corresponding object) +my %includes_in; # hash of includes in a given source file (hashed against the corresponding object) +my %has_chgdefs; # hash of files contains cppdefs that have been changed +#subroutine to scan file for use and module statements, and include files +# first argument is $object, second is $file +sub scanfile_for_keywords { + my $object = shift; + my $file = shift; + local $/ = $endline; +#if file has already been scanned, return: but first check if any .o needs to be removed + if( $scanned{$file} ) { + if( $has_chgdefs{$file} and -f $object ) { + unlink $object or die "\aERROR unlinking $object: $!\n"; + print " Object $object is out-of-date because of change to cppdefs, removed.\n" if $opt_v; + } + return; + } + print "Scanning file $file of object $object ...\n" if $opt_v; + open FILE, $file or die "\aERROR opening file $file of object $object: $!\n"; + foreach $line ( ) { + if ( $line =~ /^\s*module\s+(\w*)/ix ) { + if ( $1 ) { + my $module = lc $1; + if ( $obj_of_module{$module} && $module ne "procedure" ) { + die "\a\nAMBIGUOUS: Module $module is associated with $file as well as $actual_source_of{$obj_of_module{$module}}.\n"; + } + $obj_of_module{$module} = $object; + } + } + if ( $line =~ /^\s*use\s*(\w*)/ix ) { + $modules_used_by{$object} .= ' ' . lc $1 if $1; + } + if ( $line =~ /^[\#\s]*include\s*(['""'<])([\w\.\/]*)$delim_match{\1}/ix ) { + $includes_in{$file} .= ' ' . $2 if $2; + } + foreach ( keys %chgdefs ) { + $_ .= '='; /\s*=/; $word=$`; #cut string at =sign, else whole string + if ( $line =~ /\b$word\b/ ) { + $has_chgdefs{$file} = 1; + if ( -f $object ) { + unlink $object or die "\aERROR unlinking $object: $!\n"; + print " Object $object is out-of-date because of change to cppdef $word, removed.\n" if $opt_v; + } + } + } + } + close FILE; + $scanned{$file} = 1; + print " uses modules=$modules_used_by{$object}, and includes=$includes_in{$file}.\n" if $opt_d; +} + +foreach $object ( @objects ) { + &scanfile_for_keywords( $object, $actual_source_of{$object} ); +} + +my %off_sources; # list of source files not in current directory +my %includes; # global list of includes +my %used; # list of object files that are used by others +my @cmdline; +# for each file in sources, write down dependencies on includes and modules +foreach $object ( sort @objects ) { + print STDERR '.' unless $opt_v; # show progress on screen (STDERR is used because it is unbuffered) + my %is_used; # hash of objects containing modules used by current object + my %obj_of_include; # hash of includes for current object + $is_used{$object} = 1; # initialize with current object so as to avoid recursion + print "Collecting dependencies for $object ...\n" if $opt_v; + @cmdline = "$object: $source_of{$object}"; + ( $name, $path, $suffix ) = fileparse( $actual_source_of{$object}, @src_suffixes ); + $off_sources{$source_of{$object}} = 1 unless( $path eq './' or $path eq '' ); +#includes: done in subroutine since it must be recursively called to look for embedded includes + @includepaths = ''; + &get_include_list( $object, $actual_source_of{$object} ); +#modules + foreach $module ( split /\s+/, $modules_used_by{$object} ) { + $target = $obj_of_module{$module}; +#we need to check target ne '' also below, since it is not mkmf's privilege +#to complain about modules not found. That should be left to the compiler. + if( $target and !$is_used{$target} ) { + $is_used{$target} = 1; + push @cmdline, $target; + $used{$target} = 1; + print " found module $module in object $target ...\n" if $opt_v; + } + } +#write the command line: if no file-specific command, use generic command for this suffix + &print_formatted_list(@cmdline); + $file = $actual_source_of{$object}; + if ( $compile_cmd{$name.$suffix} ) { + print MAKEFILE "\t$compile_cmd{$name.$suffix}"; + } else { + print MAKEFILE "\t$compile_cmd{$suffix}"; + } + foreach ( @includepaths ) { # include files may be anywhere in directory array + print MAKEFILE " -I$_" if $_; + } + if ( $opt_I ){ + foreach ( split /\s+/, $opt_I ){ + print MAKEFILE " -I$_"; + } + } + print MAKEFILE "\t$source_of{$object}\n"; + +# subroutine to seek out includes recursively + sub get_include_list { + my( $incfile, $incname, $incpath, $incsuffix ); + my @paths; + my $object = shift; + my $file = shift; + foreach ( split /\s+/, $includes_in{$file} ) { + print "object=$object, file=$file, include=$_.\n" if $opt_d; + ( $incname, $incpath, $incsuffix ) = fileparse( $_, @inc_suffixes ); + if( $incsuffix ) { # only check for files with proper suffix + undef $incpath if $incpath eq './'; + if( $incpath =~ /^\// ) { + @paths = $incpath; # exact incpath specified, use it + } else { + @paths = @dirs; + } + foreach ( @paths ) { + local $/ = '/'; chomp; # remove trailing / if present + my $newincpath = "$_/$incpath" if $_; + undef $newincpath if $newincpath eq './'; + $incfile = "$newincpath$incname$incsuffix"; + if ( $opt_a and ( substr($newincpath,0,1) ne '/' ) ) { + $newincpath = '$(SRCROOT)' . $newincpath; + } + print "DEBUG: checking for $incfile in $_ ...\n" if $opt_d; + if ( -f $incfile and $obj_of_include{$incfile} ne $object ) { + print " found $incfile ...\n" if $opt_v; + push @cmdline, "$newincpath$incname$incsuffix"; + $includes{$incfile} = 1; + chomp( $newincpath, $path ); + $off_sources{$incfile} = 1 if $newincpath; + $newincpath = '.' if $newincpath eq ''; + push @includepaths, $newincpath unless( grep $_ eq $newincpath, @includepaths ); + &scanfile_for_keywords($object,$incfile); + $obj_of_include{$incfile} = $object; + &get_include_list($object,$incfile); # recursively look for includes + last; + } + } + } + } + } +} + +#lines to facilitate creation of local copies of source from other directories +#commented out because it makes make default rules kick in +foreach ( keys %off_sources ) { + my $file = basename($_); + $file =~ s/\$\(SRCROOT\)//; + print MAKEFILE "./$file: $_\n\tcp $_ .\n"; +} + +#objects not used by other objects +#if every object is a module, then only the unused objects +#need to be passed to the linker (see commented OBJ = line below). +#if any f77 or C routines are present, we need complete list +my @unused_objects; +foreach $object ( @objects ) { + push @unused_objects, $object unless $used{$object}; +} + +&print_formatted_list( "SRC =", @sources, keys %includes ); +&print_formatted_list( "OBJ =", @objects ); +# &print_formatted_list( "OBJ =", @unused_objects ); +my $noff = scalar keys %off_sources; +&print_formatted_list( "OFF =", keys %off_sources ) if $noff > 0; + +#write targets +print MAKEFILE "clean: neat\n\t-rm -f .$opt_p.cppdefs \$(OBJ) $opt_p\n"; +print MAKEFILE "neat:\n\t-rm -f \$(TMPFILES)\n"; +print MAKEFILE "localize: \$(OFF)\n\tcp \$(OFF) .\n" if $noff > 0; +print MAKEFILE "TAGS: \$(SRC)\n\tetags \$(SRC)\n"; +print MAKEFILE "tags: \$(SRC)\n\tctags \$(SRC)\n"; +( $name, $path, $suffix ) = fileparse( $opt_p, @tgt_suffixes ); +if( $suffix eq '.a' ) { + print MAKEFILE "$opt_p: \$(OBJ)\n\t\$(AR) \$(ARFLAGS) $opt_p \$(OBJ)\n"; +} else { +# opt_l is a new flag added to take care of libraries + print MAKEFILE "$opt_p: \$(OBJ) $opt_l\n\t\$(LD) \$(OBJ) -o $opt_p $opt_l \$(LDFLAGS)\n"; +} +close MAKEFILE; +print " $mkfile is ready.\n"; + +exec 'make', '-f', $mkfile if $opt_x; diff --git a/MOM_code/bin/mkmf.debugtemplate.gfdl_ws_32.intel b/MOM_code/bin/mkmf.debugtemplate.gfdl_ws_32.intel new file mode 100644 index 0000000..6f5c44a --- /dev/null +++ b/MOM_code/bin/mkmf.debugtemplate.gfdl_ws_32.intel @@ -0,0 +1,182 @@ +# template for the Intel fortran compiler +# typical use with mkmf +# mkmf -t template.ifc -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include +############ +# commands # +############ +FC = ifort +CC = icc +LD = ifort +######### +# flags # +######### +DEBUG = on +REPRO = +VERBOSE = +OPENMP = + +############################################## +# Need to use at least GNU Make version 3.81 # +############################################## +need := 3.81 +ok := $(filter $(need),$(firstword $(sort $(MAKE_VERSION) $(need)))) +ifneq ($(need),$(ok)) +$(error Need at least make version $(need). Load module gmake/3.81) +endif + +MAKEFLAGS += --jobs=2 + +NETCDF_ROOT = /home/nnz/local/build/netcdf-4.1.1_ifort11_HDF +MPICH_ROOT = /home/nnz/local/build/mpich2-1.3_ifort11 +#MPICH_ROOT = /usr/local/mpich +HDF5_ROOT = /home/nnz/local/build/hdf5-1.8.5-patch1_zlib-1.2.5_ifort11/lib +ZLIB_ROOT = /home/nnz/local/build/zlib-1.2.5 +INCLUDE = -I$(NETCDF_ROOT)/include -I$(MPICH_ROOT)/include + + +FPPFLAGS := -fpp -Wp,-w $(INCLUDE) + +FFLAGS := -fno-alias -automatic -safe-cray-ptr -ftz -assume byterecl -i4 -r8 -nowarn +FFLAGS_OPT = -O3 -debug minimal -fp-model precise -override-limits +FFLAGS_DEBUG = -g -O0 -check -check noarg_temp_created -check nopointer -warn -warn noerrors -fpe0 -traceback -ftrapuv +FFLAGS_REPRO = -O2 -debug minimal -no-vec -fp-model precise -override-limits +FFLAGS_OPENMP = -openmp +FFLAGS_VERBOSE = -v -V -what + + +CFLAGS := -D__IFC $(INCLUDE) +CFLAGS_OPT = -O2 -debug minimal -no-vec +CFLAGS_OPENMP = -openmp +CFLAGS_DEBUG = -O0 -g -ftrapuv -traceback + +LDFLAGS := +LDFLAGS_VERBOSE := -Wl,-V,--verbose,-cref,-M + +ifneq ($(REPRO),) +CFLAGS += $(CFLAGS_REPRO) +FFLAGS += $(FFLAGS_REPRO) +endif +ifneq ($(DEBUG),) +CFLAGS += $(CFLAGS_DEBUG) +FFLAGS += $(FFLAGS_DEBUG) +#else +#CFLAGS += $(CFLAGS_OPT) +#FFLAGS += $(FFLAGS_OPT) +endif + +ifneq ($(OPENMP),) +CFLAGS += $(CFLAGS_OPENMP) +FFLAGS += $(FFLAGS_OPENMP) +endif + +ifneq ($(VERBOSE),) +CFLAGS += $(CFLAGS_VERBOSE) +FFLAGS += $(FFLAGS_VERBOSE) +LDFLAGS += $(LDFLAGS_VERBOSE) +endif + +ifeq ($(NETCDF),3) + # add the use_LARGEFILE cppdef + ifneq ($(findstring -Duse_netCDF,$(CPPDEFS)),) + CPPDEFS += -Duse_LARGEFILE + endif +endif + +ifneq ($(findstring netcdf-4.0.1,$(LOADEDMODULES)),) + LIBS := -L$(NETCDF_ROOT)/lib -lnetcdf -L$(HDF5_ROOT)/lib -lhdf5_hl -lhdf5 -lcurl -L$(ZLIB_ROOT)/lib -lz +else + LIBS := -L$(NETCDF_ROOT)/lib -lnetcdf +endif + +LIBS += -L$(MPICH_ROOT)/lib -lmpich -lpthread -lmpl +LDFLAGS += $(LIBS) + +#--------------------------------------------------------------------------- +# you should never need to change any lines below. + +# see the MIPSPro F90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .opt create an optimization report +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source +# make .i create a preprocessed file (for .F) +# make .i90 create a preprocessed file (for .F90) + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh -f +TMPFILES = .*.m *.B *.L *.i *.i90 *.l *.s *.mod *.opt + +.SUFFIXES: .F .F90 .H .L .T .f .f90 .h .i .i90 .l .o .s .opt .x + +.f.L: + $(FC) $(FFLAGS) -c -listing $*.f +.f.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f +.f.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f +.f.T: + $(FC) $(FFLAGS) -c -cif $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -S $*.f +.f.x: + $(FC) $(FFLAGS) -o $*.x $*.f *.o $(LDFLAGS) +.f90.L: + $(FC) $(FFLAGS) -c -listing $*.f90 +.f90.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f90 +.f90.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f90 +.f90.T: + $(FC) $(FFLAGS) -c -cif $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -S $*.f90 +.f90.x: + $(FC) $(FFLAGS) -o $*.x $*.f90 *.o $(LDFLAGS) +.F.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F +.F.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F +.F.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F +.F.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F +.F.f: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F > $*.f +.F.i: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F +.F.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F +.F.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F *.o $(LDFLAGS) +.F90.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F90 +.F90.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F90 +.F90.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F90 +.F90.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F90 +.F90.f90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F90 > $*.f90 +.F90.i90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F90 *.o $(LDFLAGS) diff --git a/MOM_code/bin/mkmf.debugtemplate.ia64 b/MOM_code/bin/mkmf.debugtemplate.ia64 new file mode 100644 index 0000000..7c411f5 --- /dev/null +++ b/MOM_code/bin/mkmf.debugtemplate.ia64 @@ -0,0 +1,106 @@ +# template for the Intel fortran compiler +# typical use with mkmf +# mkmf -t template.ifc -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include +CPPFLAGS = +FFLAGS_BASE = -v -V -what -fpp -fno-alias -stack_temps -safe_cray_ptr -ftz -i_dynamic -assume byterecl -g -i4 -r8 -Wp,-w +FFLAGS_REPRO = -fltconsistency +FFLAGS_DEBUG = -check -check noarg_temp_created -warn -warn noerrors -debug variable_locations -inline_debug_info -fpe0 -traceback -ftrapuv +FFLAGS = $(FFLAGS_BASE) $(FFLAGS_REPRO) $(FFLAGS_DEBUG) -O0 +FC = ifort +CC = icc +CFLAGS_BASE = -g -D__IFC +CFLAGS_DEBUG = -ftrapuv -traceback +CFLAGS = $(CFLAGS_BASE) $(CFLAGS_DEBUG) -O0 +LD = ifort +LDFLAGS = -Wl,-V,--verbose,-cref,-Map linker.map -lnetcdf -lmpi -lsma +MAKEFLAGS+=--jobs=8 + +#--------------------------------------------------------------------------- +# you should never need to change any lines below. + +# see the MIPSPro F90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .opt create an optimization report +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source +# make .i create a preprocessed file (for .F) +# make .i90 create a preprocessed file (for .F90) + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh -f +TMPFILES = .*.m *.B *.L *.i *.i90 *.l *.s *.mod *.opt + +.SUFFIXES: .F .F90 .H .L .T .f .f90 .h .i .i90 .l .o .s .opt .x + +.f.L: + $(FC) $(FFLAGS) -c -listing $*.f +.f.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f +.f.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f +.f.T: + $(FC) $(FFLAGS) -c -cif $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -S $*.f +.f.x: + $(FC) $(FFLAGS) -o $*.x $*.f *.o $(LDFLAGS) +.f90.L: + $(FC) $(FFLAGS) -c -listing $*.f90 +.f90.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f90 +.f90.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f90 +.f90.T: + $(FC) $(FFLAGS) -c -cif $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -S $*.f90 +.f90.x: + $(FC) $(FFLAGS) -o $*.x $*.f90 *.o $(LDFLAGS) +.F.L: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -listing $*.F +.F.opt: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F +.F.l: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $(LIST) $*.F +.F.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -cif $*.F +.F.f: + $(FC) $(CPPDEFS) $(CPPFLAGS) -EP $*.F > $*.f +.F.i: + $(FC) $(CPPDEFS) $(CPPFLAGS) -P $*.F +.F.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -S $*.F +.F.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -o $*.x $*.F *.o $(LDFLAGS) +.F90.L: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -listing $*.F90 +.F90.opt: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F90 +.F90.l: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $(LIST) $*.F90 +.F90.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -cif $*.F90 +.F90.f90: + $(FC) $(CPPDEFS) $(CPPFLAGS) -EP $*.F90 > $*.f90 +.F90.i90: + $(FC) $(CPPDEFS) $(CPPFLAGS) -P $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -S $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -o $*.x $*.F90 *.o $(LDFLAGS) diff --git a/MOM_code/bin/mkmf.debugtemplate.ia64_hdf b/MOM_code/bin/mkmf.debugtemplate.ia64_hdf new file mode 100644 index 0000000..d4ee7de --- /dev/null +++ b/MOM_code/bin/mkmf.debugtemplate.ia64_hdf @@ -0,0 +1,106 @@ +# template for the Intel fortran compiler +# typical use with mkmf +# mkmf -t template.ifc -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include +CPPFLAGS = +FFLAGS_BASE = -v -V -what -fpp -fno-alias -stack_temps -safe_cray_ptr -ftz -i_dynamic -assume byterecl -g -i4 -r8 -Wp,-w +FFLAGS_REPRO = -fltconsistency +FFLAGS_DEBUG = -check -check noarg_temp_created -warn -warn noerrors -debug variable_locations -inline_debug_info -fpe0 -traceback -ftrapuv +FFLAGS = $(FFLAGS_BASE) $(FFLAGS_REPRO) $(FFLAGS_DEBUG) -O0 +FC = ifort +CC = icc +CFLAGS_BASE = -g -D__IFC +CFLAGS_DEBUG = -ftrapuv -traceback +CFLAGS = $(CFLAGS_BASE) $(CFLAGS_DEBUG) -O0 +LD = ifort +LDFLAGS = -Wl,-V,--verbose,-cref,-Map linker.map -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lz -lmpi -lsma +MAKEFLAGS+=--jobs=8 + +#--------------------------------------------------------------------------- +# you should never need to change any lines below. + +# see the MIPSPro F90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .opt create an optimization report +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source +# make .i create a preprocessed file (for .F) +# make .i90 create a preprocessed file (for .F90) + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh -f +TMPFILES = .*.m *.B *.L *.i *.i90 *.l *.s *.mod *.opt + +.SUFFIXES: .F .F90 .H .L .T .f .f90 .h .i .i90 .l .o .s .opt .x + +.f.L: + $(FC) $(FFLAGS) -c -listing $*.f +.f.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f +.f.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f +.f.T: + $(FC) $(FFLAGS) -c -cif $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -S $*.f +.f.x: + $(FC) $(FFLAGS) -o $*.x $*.f *.o $(LDFLAGS) +.f90.L: + $(FC) $(FFLAGS) -c -listing $*.f90 +.f90.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f90 +.f90.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f90 +.f90.T: + $(FC) $(FFLAGS) -c -cif $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -S $*.f90 +.f90.x: + $(FC) $(FFLAGS) -o $*.x $*.f90 *.o $(LDFLAGS) +.F.L: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -listing $*.F +.F.opt: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F +.F.l: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $(LIST) $*.F +.F.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -cif $*.F +.F.f: + $(FC) $(CPPDEFS) $(CPPFLAGS) -EP $*.F > $*.f +.F.i: + $(FC) $(CPPDEFS) $(CPPFLAGS) -P $*.F +.F.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -S $*.F +.F.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -o $*.x $*.F *.o $(LDFLAGS) +.F90.L: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -listing $*.F90 +.F90.opt: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F90 +.F90.l: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $(LIST) $*.F90 +.F90.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -cif $*.F90 +.F90.f90: + $(FC) $(CPPDEFS) $(CPPFLAGS) -EP $*.F90 > $*.f90 +.F90.i90: + $(FC) $(CPPDEFS) $(CPPFLAGS) -P $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -S $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -o $*.x $*.F90 *.o $(LDFLAGS) diff --git a/MOM_code/bin/mkmf.debugtemplate.sgi b/MOM_code/bin/mkmf.debugtemplate.sgi new file mode 100644 index 0000000..63ffe6e --- /dev/null +++ b/MOM_code/bin/mkmf.debugtemplate.sgi @@ -0,0 +1,96 @@ +# Makefile template for SGI MIPSpro f90 +#typical use with netCDF: +# mkmf -t template.sgi -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include + +FC = f90 +CPPFLAGS = -macro_expand +#FFLAGS = -64 -mips4 -i4 -r8 -d8 -O2 -OPT:Olimit=0 #optimized +FFLAGS = -64 -mips4 -i4 -r8 -d8 -woff134,200,787,1670 -ansi -DEBUG:conform_check=YES:subscript_check=ON:trap_uninitialized=ON:verbose_runtime=ON -g #for debugging +LIST = -listing + +#to debug shmem codes, you need the dbfork library +#TOTALVIEW = -L/opt/totalview/4.1.0-3/irix6-mips/lib -ldbfork_n64 +#TOTALVIEW = -ldbfork_n64 +#TOTALVIEW = -L/sw/mel/totalview/lib -ldbfork_n64 + +LD = f90 +LDFLAGS = -64 -mips4 -v -show $(LIBS) # this is verbose +#LDFLAGS = -64 -mips4 -dont_warn_unused $(LIBS) +#LIBS must be customized for your site +LIBS = $(TOTALVIEW) -L/usr/local/lib -lnetcdf -lmpi -lsma -lexc -lscs + +#--------------------------------------------------------------------------- +# you should never need to change any lines below. + +# see the MIPSPro F90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .T create a CIF file +# make .L create a compiler listing +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source + +# make .i create a preprocessed file (only for .F and .F90 +# extensions) + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh +TMPFILES = .*.m *.B *.L *.i *.l *.s *.mod + +.SUFFIXES: .F .F90 .H .L .T .f .f90 .h .i .o .s .x + +.f.L: + $(FC) $(FFLAGS) -c $(LIST) $*.f +.f.T: + $(FC) $(FFLAGS) -c -cif $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -S $*.f +.f.x: + $(FC) $(FFLAGS) -o $*.x $*.f *.o $(LDFLAGS) +.f90.L: + $(FC) $(FFLAGS) -c $(LIST) $*.f90 +.f90.T: + $(FC) $(FFLAGS) -c -cif $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -S $*.f90 +.f90.x: + $(FC) $(FFLAGS) -o $*.x $*.f90 *.o $(LDFLAGS) +.F.L: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $(LIST) $*.F +.F.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -cif $*.F +.F.f: + $(CPP) $(CPPDEFS) $(CPPFLAGS) $*.F > $*.f +.F.i: + $(FC) $(CPPDEFS) $(CPPFLAGS) -P $*.F +.F.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -S $*.F +.F.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -o $*.x $*.F *.o $(LDFLAGS) +.F90.L: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $(LIST) $*.F90 +.F90.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -cif $*.F90 +.F90.f90: + $(CPP) $(CPPDEFS) $(CPPFLAGS) $*.F90 > $*.f90 +.F90.i: + $(FC) $(CPPDEFS) $(CPPFLAGS) -P $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -S $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -o $*.x $*.F90 *.o $(LDFLAGS) diff --git a/MOM_code/bin/mkmf.html b/MOM_code/bin/mkmf.html new file mode 100644 index 0000000..007db3b --- /dev/null +++ b/MOM_code/bin/mkmf.html @@ -0,0 +1,476 @@ + + + + + + + + + + +mkmf user's guide + + + + + +
+

mkmf - a tool for making makefiles

+
+mkmf is a tool written in perl5 that will construct a +makefile from distributed source. A single executable program is the +typical result, but I dare say it is extensible to a makefile for any +purpose at all. + +

Author: Balaji, SGI/GFDL. +

+
+ +

Features of mkmf include: + +

    + +
  • It understands dependencies in f90 (modules and +use), the fortran include statement, +and the cpp #include statement in any type of source; +
  • There are no restrictions on filenames, module names, etc.; +
  • It supports the concept of overlays (where source is maintained in +layers of directories with a defined precedence); +
  • It can keep track of changes to cpp flags, and +knows when to recompile affected source (i.e, files +containing #ifdefs that have been changed since the +last invocation); +
  • It will run on any unix platform that has perl version 5 installed; +
  • It is free, and released under GPL. GFDL users can copy (or, +better still, directly invoke) the file +/net/vb/public/bin/mkmf. External users can download the +source here. Current +public revision is 4.12. + +
+ +

mkmf is pronounced make-make-file or +make-m-f or even McMuff (Paul Kushner's suggestion). + +

The calling syntax is: + +

mkmf [-a abspath] [-c cppdefs] [-d] [-f] [-m makefile] [-p program] [-t template] [-v] [-x] [args] + +

    + +
  1. -a abspath attaches the abspath at +the front of all relative paths to sourcefiles; + +
  2. cppdefs is a list of cpp +#defines to be passed to the source files: affected +object files will be selectively removed if there has been a change in +this state; + +
  3. -d is a debug flag to mkmf (much +more verbose than -v, but probably of use only if you +are modifying mkmf itself); + +
  4. -f is a formatting flag to restrict lines in the +makefile to 256 characters. This was introduced in response to a +customer who wanted to edit his makefiles using +vi). Lines longer than that will use continuation +lines as needed; + +
  5. makefile is the name of the makefile written (default +Makefile); + +
  6. template is a file containing a list of make +macros or commands written to the beginning of the makefile; + +
  7. program is the name of the final target (default +a.out); + +
  8. -v is a verbosity flag to mkmf; + +
  9. -x executes the makefile immediately; + +
  10. args are a list of directories and files to be +searched for targets and dependencies. + +
+ +

Makefile structure:

+ +

A sourcefile is any file with a source file suffix +(currently .F, .F90, .c, .f. .f90). An includefile is +any file with an include file suffix (currently .H, .fh, .h, +.inc). A valid sourcefile can also be an includefile. + +

Each sourcefile in the list is presumed to produce an object file +with the same basename and a .o extension in the current +working directory. If more than one sourcefile in the list would produce +identically-named object files, only the first is used and the rest +are discarded. This permits the use of overlays: if dir3 +contained the basic source code, dir2 contained bugfixes, and +dir1 contained mods for a particular run, mkmf dir1 dir2 +dir3 would create a makefile for correct compilation. Please note +that precedence descends from left to right. This is the +conventional order used by compilers when searching for libraries, +includes, etc: left to right along the command line, with the first +match invalidating all subsequent ones. See the Examples section for a closer look at precedence rules. + +

The makefile currently runs $(FC) on fortran files +and $(CC) on C files. Flags to the compiler can be set +in $(FFLAGS) or $(CFLAGS). The final +loader step executes $(LD). Flags to the loader can be +set in $(LDFLAGS). Preprocessor flags are used by +.F, .F90 and .c files, +and can be set in $(CPPFLAGS). These macros have a +default meaning on most systems, and can be modified in the template +file. The predefined macros can be discovered by running make +-p. + +

In addition, the macro $(CPPDEFS) is applied to the +preprocessor. This can contain the cpp #defines which +may change from run to run. cpp options that do not +change between compilations should be placed in +$(CPPFLAGS). + +

Includefiles are recursively searched for embedded includes. + +

For emacs users, the make target +TAGS is always provided. This creates a TAGS file in +the current working directory with a cross-reference table linking all +the sourcefiles. If you don't know about emacs tags, please consult +the emacs help files! It is an incredibly useful feature. + +

The default action for non-existent files is to touch them +(i.e create null files of that name) in the current working directory. + +

All the object files are linked to a single executable. It is +therefore desirable that there be a single main program source among +the arguments to mkmf, otherwise, the loader is likely to +complain. + +

Treatment of [args]:

+ +

The argument list args is treated sequentially from +left to right. Arguments can be of three kinds: + +

    +
  • If an argument is a sourcefile, it is added to the list of sourcefiles. +
  • If an argument is a directory, all the sourcefiles in +that directory are added to the list of sourcefiles. +
  • If an argument is a regular file, it is presumed to contain a list +of sourcefiles. Any line not containing a sourcefile is discarded. If +the line contains more than one word, the last word on the line should +be the sourcefile name, and the rest of the line is a file-specific +compilation command. This may be used, for instance, to provide +compiler flags specific to a single file in the sourcefile list: + +

    +a.f90
+b.f90
+f90 -Oaggress c.f90
+
    + +

    This will add a.f90, b.f90 and c.f90 to the +sourcefile list. The first two files will be compiled using the +generic command $(FC) $(FFLAGS). But when the make requires +c.f90 to be compiled, it will be compiled with f90 +-Oaggress. +

+ +

The current working directory is always the first (and +top-precedence) argument, even if args is not supplied. + +

Treatment of [-c cppdefs]:

+ +

The argument cppdefs is treated as +follows. cppdefs should contain a comprehensive list +of the cpp #defines to be +preprocessed. This list is compared against the current "state", +maintained in the file .cppdefs in the current +working directory. If there are any changes to this state, +mkmf will remove all object files +affected by this change, so that the subsequent make +will recompile those files. Previous versions of mkmf +attempted to touch the relevant source, an operation +that was only possible with the right permissions. The current version +works even with read-only source. + +

The file .cppdefs is created if it does not exist. If you +wish to edit it by hand (don't!) it merely contains a list of the +cpp flags separated by blanks, in a single record, with no +newline at the end. + +

cppdefs also sets the make macro +CPPDEFS. If this was set in a template file and also +in the -c flag to mkmf, the value in +-c takes precedence. Typically, you should set only +CPPFLAGS in the template file, and +CPPDEFS via mkmf -c. + +

Treatment of includefiles:

+ +

Include files are often specified without an explicit path, e.g +

+#include "config.h"
+
+ +

mkmf first attempts to locate the includefile in the same +directory as the source file. If it is not found there, it looks in +the directories listed as arguments, maintaining the same +left-to-right precedence as described above. + +

This follows the behaviour of most f90 compilers: includefiles +inherit the path to the source, or else follow the order of include +directories specified from left to right on the f90 command +line, with the -I flags descending in precedence from +left to right. + +

If you have includefiles in a directory dir other than +those listed above, you can specify it yourself by including +-Idir in $(FFLAGS) in your template +file. Includepaths in the template file take precedence over those +generated by mkmf. (I suggest using +FFLAGS for this rather than CPPFLAGS +because fortran includes can occur even in source +requiring no preprocessing). + +

Examples:

+
    +

  1. The template file for the SGI MIPSpro compiler contains: + +

    +

    +FC = f90
+LD = f90
+CPPFLAGS = -macro_expand
+FFLAGS = -d8 -64 -i4 -r8 -mips4 -O3
+LDFLAGS = -64 -mips4 $(LIBS)
+LIST = -listing
+
    + +The meaning of the various flags may be divined by reading the +manual. A line defining the make macro LIBS, e.g: + +

    +LIBS = -lmpi
+
    + +may be added anywhere in the template to have it added to the link +command line. + +

    +Sample template files for different OSs and compilers are available in +the directory /net/vb/public/bin. + +

  2. This example illustrates the effective use of mkmf's +precedence rules. Let the current working directory contain a file +named path_names containing the lines: + +

    +updates/a.f90
+updates/b.f90
+
    + +

    The directory /home/src/base contains the files: + +

    +a.f90
+b.f90
+c.f90
+
    + +

    Typing 

    mkmf path_names /home/src/base
    produces the +following Makefile: + +

    +# Makefile created by mkmf $Id: mkmf.html,v 1.1.2.1 2013/12/18 17:47:54 Niki.Zadeh Exp $ 
+
+
+.DEFAULT:
+	-touch $@
+all: a.out
+c.o: /home/src/base/c.f90
+	$(FC) $(FFLAGS) -c	/home/src/base/c.f90
+a.o: updates/a.f90
+	$(FC) $(FFLAGS) -c	updates/a.f90
+b.o: updates/b.f90
+	$(FC) $(FFLAGS) -c	updates/b.f90
+./c.f90: /home/src/base/c.f90
+	cp /home/src/base/c.f90 .
+./a.f90: updates/a.f90
+	cp updates/a.f90 .
+./b.f90: updates/b.f90
+	cp updates/b.f90 .
+SRC = /home/src/base/c.f90 updates/a.f90 updates/b.f90
+OBJ = c.o a.o b.o
+OFF = /home/src/base/c.f90 updates/a.f90 updates/b.f90
+clean: neat
+	-rm -f .cppdefs $(OBJ) a.out
+neat:
+	-rm -f $(TMPFILES)
+localize: $(OFF)
+	cp $(OFF) .
+TAGS: $(SRC)
+	etags $(SRC)
+tags: $(SRC)
+	ctags $(SRC)
+a.out: $(OBJ)
+	$(LD) $(OBJ) -o a.out $(LDFLAGS)
+
+
    + +

    Note that when files of the same name recur in the target list, the +files in the updates directory (specified in +path_names) are used rather than those in the base source +repository /home/src/base. + +Assume that now you want to test some changes to c.f90. You +don't want to make changes to the base source repository itself prior +to testing; so you make yourself a local copy. + +

    +make ./c.f90
+
    + +

    You didn't even need to know where c.f90 originally was. + +Now you can make changes to your local copy ./c.f90. To +compile using your changed copy, type: + +

    +mkmf path_names /home/src/base
+make
+
    + +The new Makefile looks like this: + +

    +# Makefile created by mkmf $Id: mkmf.html,v 1.1.2.1 2013/12/18 17:47:54 Niki.Zadeh Exp $ 
+
+
+.DEFAULT:
+	-touch $@
+all: a.out
+c.o: c.f90
+	$(FC) $(FFLAGS) -c	c.f90
+a.o: updates/a.f90
+	$(FC) $(FFLAGS) -c	updates/a.f90
+b.o: updates/b.f90
+	$(FC) $(FFLAGS) -c	updates/b.f90
+./a.f90: updates/a.f90
+	cp updates/a.f90 .
+./b.f90: updates/b.f90
+	cp updates/b.f90 .
+SRC = c.f90 updates/a.f90 updates/b.f90
+OBJ = c.o a.o b.o
+OFF = updates/a.f90 updates/b.f90
+clean: neat
+	-rm -f .cppdefs $(OBJ) a.out
+neat:
+	-rm -f $(TMPFILES)
+localize: $(OFF)
+	cp $(OFF) .
+TAGS: $(SRC)
+	etags $(SRC)
+tags: $(SRC)
+	ctags $(SRC)
+a.out: $(OBJ)
+	$(LD) $(OBJ) -o a.out $(LDFLAGS)
+
+
    + +

    Note that you are now using your local copy of c.f90 for +the compile, since the files in the current working directory always +take precedence. To revert to using the base copy, just remove the +local copy and run mkmf again. + +

  3. This illustrates the use of mkmf -c: + +

    +mkmf -c "-Dcppflag -Dcppflag2=2 -Dflag3=string ..."
+
    + +

    will set CPPDEFS to this value, and also save this +state in the file .cppdefs. If the argument to +-c is changed in a subsequent call: + +

    +mkmf -c "-Dcppflag -Dcppflag2=3 -Dflag3=string ..."
+
    + +mkmf will scan the source list for sourcefiles that make +references to cppflag2, and the corresponding object files +will be removed. + +
+ +

Caveats:

+
    +

  1. In F90, the module name must occur on the same source line as +the module or use keyword. That is to +say, if your code contained: + +

    use &
+
       this_module
    + +

    it would confuse mkmf. Similarly, a fortran +include statement must not be split across lines. + +

  2. Two use statements on the same line is not +currently recognized, that is: + +

    use module1; use module2
    + +

    is to be avoided. + +

  3. I currently provide a default action for files listed as +dependencies but not found: in this case, I touch the +file, creating a null file of that name in the current directory. I am +willing to debate the wisdom of this, if you are disturbed. But it is +currently the least annoying way I've found to take care of a +situation when cpp #includes buried within obsolete +ifdefs ask for files that don't exist: + +

    +#ifdef obsolete
+#include "nonexistent.h"
+#endif
+
    + +

  4. If the formatting flag -f is used, long lines +will be broken up at intervals of 256 characters. This can lead to +problems if individual paths are longer than 256 characters. + +
+ +

Changes

+ +The RCS log for +mkmf contains a comprehensive list of changes. In the +unlikely event that you should wish to check out a retro version, +please get in touch with me, Balaji. + +

TODO:

+ +
    +
  1. An option to write a dependency graph, perhaps in HTML. +
+ +

Please address all inquires to Balaji, +SGI/GFDL. + + +

+
+Author: V. Balaji +
Document last modified +
+ + + + + + diff --git a/MOM_code/bin/mkmf.template.gfdl_ws_32.intel b/MOM_code/bin/mkmf.template.gfdl_ws_32.intel new file mode 100644 index 0000000..47bc3de --- /dev/null +++ b/MOM_code/bin/mkmf.template.gfdl_ws_32.intel @@ -0,0 +1,182 @@ +# template for the Intel fortran compiler +# typical use with mkmf +# mkmf -t template.ifc -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include +############ +# commands # +############ +FC = ifort +CC = icc +LD = ifort +######### +# flags # +######### +DEBUG = +REPRO = on +VERBOSE = +OPENMP = + +############################################## +# Need to use at least GNU Make version 3.81 # +############################################## +need := 3.81 +ok := $(filter $(need),$(firstword $(sort $(MAKE_VERSION) $(need)))) +ifneq ($(need),$(ok)) +$(error Need at least make version $(need). Load module gmake/3.81) +endif + +MAKEFLAGS += --jobs=2 + +NETCDF_ROOT = /home/nnz/local/build/netcdf-4.1.1_ifort11_HDF +MPICH_ROOT = /home/nnz/local/build/mpich2-1.3_ifort11 +#MPICH_ROOT = /usr/local/mpich +HDF5_ROOT = /home/nnz/local/build/hdf5-1.8.5-patch1_zlib-1.2.5_ifort11/lib +ZLIB_ROOT = /home/nnz/local/build/zlib-1.2.5 +INCLUDE = -I$(NETCDF_ROOT)/include -I$(MPICH_ROOT)/include + + +FPPFLAGS := -fpp -Wp,-w $(INCLUDE) + +FFLAGS := -fno-alias -automatic -safe-cray-ptr -ftz -assume byterecl -i4 -r8 -nowarn +FFLAGS_OPT = -O3 -debug minimal -fp-model precise -override-limits +FFLAGS_DEBUG = -g -O0 -check -check noarg_temp_created -check nopointer -warn -warn noerrors -fpe0 -traceback -ftrapuv +FFLAGS_REPRO = -O2 -debug minimal -no-vec -fp-model precise -override-limits +FFLAGS_OPENMP = -openmp +FFLAGS_VERBOSE = -v -V -what + + +CFLAGS := -D__IFC $(INCLUDE) +CFLAGS_OPT = -O2 -debug minimal -no-vec +CFLAGS_OPENMP = -openmp +CFLAGS_DEBUG = -O0 -g -ftrapuv -traceback + +LDFLAGS := +LDFLAGS_VERBOSE := -Wl,-V,--verbose,-cref,-M + +ifneq ($(REPRO),) +CFLAGS += $(CFLAGS_REPRO) +FFLAGS += $(FFLAGS_REPRO) +endif +ifneq ($(DEBUG),) +CFLAGS += $(CFLAGS_DEBUG) +FFLAGS += $(FFLAGS_DEBUG) +#else +#CFLAGS += $(CFLAGS_OPT) +#FFLAGS += $(FFLAGS_OPT) +endif + +ifneq ($(OPENMP),) +CFLAGS += $(CFLAGS_OPENMP) +FFLAGS += $(FFLAGS_OPENMP) +endif + +ifneq ($(VERBOSE),) +CFLAGS += $(CFLAGS_VERBOSE) +FFLAGS += $(FFLAGS_VERBOSE) +LDFLAGS += $(LDFLAGS_VERBOSE) +endif + +ifeq ($(NETCDF),3) + # add the use_LARGEFILE cppdef + ifneq ($(findstring -Duse_netCDF,$(CPPDEFS)),) + CPPDEFS += -Duse_LARGEFILE + endif +endif + +ifneq ($(findstring netcdf-4.0.1,$(LOADEDMODULES)),) + LIBS := -L$(NETCDF_ROOT)/lib -lnetcdf -L$(HDF5_ROOT)/lib -lhdf5_hl -lhdf5 -lcurl -L$(ZLIB_ROOT)/lib -lz +else + LIBS := -L$(NETCDF_ROOT)/lib -lnetcdf +endif + +LIBS += -L$(MPICH_ROOT)/lib -lmpich -lpthread -lmpl +LDFLAGS += $(LIBS) + +#--------------------------------------------------------------------------- +# you should never need to change any lines below. + +# see the MIPSPro F90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .opt create an optimization report +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source +# make .i create a preprocessed file (for .F) +# make .i90 create a preprocessed file (for .F90) + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh -f +TMPFILES = .*.m *.B *.L *.i *.i90 *.l *.s *.mod *.opt + +.SUFFIXES: .F .F90 .H .L .T .f .f90 .h .i .i90 .l .o .s .opt .x + +.f.L: + $(FC) $(FFLAGS) -c -listing $*.f +.f.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f +.f.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f +.f.T: + $(FC) $(FFLAGS) -c -cif $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -S $*.f +.f.x: + $(FC) $(FFLAGS) -o $*.x $*.f *.o $(LDFLAGS) +.f90.L: + $(FC) $(FFLAGS) -c -listing $*.f90 +.f90.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f90 +.f90.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f90 +.f90.T: + $(FC) $(FFLAGS) -c -cif $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -S $*.f90 +.f90.x: + $(FC) $(FFLAGS) -o $*.x $*.f90 *.o $(LDFLAGS) +.F.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F +.F.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F +.F.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F +.F.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F +.F.f: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F > $*.f +.F.i: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F +.F.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F +.F.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F *.o $(LDFLAGS) +.F90.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F90 +.F90.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F90 +.F90.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F90 +.F90.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F90 +.F90.f90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F90 > $*.f90 +.F90.i90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F90 *.o $(LDFLAGS) diff --git a/MOM_code/bin/mkmf.template.gfdl_ws_64.gnu b/MOM_code/bin/mkmf.template.gfdl_ws_64.gnu new file mode 100644 index 0000000..9f7a06e --- /dev/null +++ b/MOM_code/bin/mkmf.template.gfdl_ws_64.gnu @@ -0,0 +1,184 @@ +# $Id: mkmf.template.gfdl_ws_64.gnu,v 1.1.2.1 2013/12/18 17:47:54 Niki.Zadeh Exp $ +# template for the Intel fortran compiler +# typical use with mkmf +# mkmf -t template.ifc -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include +############ +# commands # +############ +FC = gfortran +CC = gcc +LD = gfortran $(MAIN_PROGRAM) +######### +# flags # +######### +DEBUG = +REPRO = +VERBOSE = +OPENMP = + +MAKEFLAGS += --jobs=$(shell grep '^processor' /proc/cpuinfo | wc -l) + +FPPFLAGS := + +FFLAGS := -fcray-pointer -fdefault-real-8 -Waliasing -ffree-line-length-none -fno-range-check +FFLAGS += -I/net2/nnz/opt/netcdf-4.1.1/include +#FFLAGS += -I/home/fms/local/opt/netcdf/4.1.1-gnu-4/include +#The above fails with USE netcdf, ONLY: NF_FILL_REAL => NF90_FILL_REAL +# 1 +# Fatal Error: Parse error when checking module version for file 'netcdf.mod' opened at (1) +# +#FFLAGS += $(shell nc-config --fflags) +# +FFLAGS += -I/net2/nnz/opt/mpich2-1.3_ifort11_x64/include +#FFLAGS += -I/usr/local/x64/mpich2-1.2.1p1/include # I do not trust this package, mpirun does not work +#$(shell pkg-config --cflags-only-I mpich2-c) +FFLAGS_OPT = -O2 +FFLAGS_REPRO = +FFLAGS_DEBUG = -O0 -g -W -fbounds-check +FFLAGS_OPENMP = -fopenmp +FFLAGS_VERBOSE = + +CFLAGS := -D__IFC +CFLAGS += $(shell nc-config --cflags) +CFLAGS += -I/net2/nnz/opt/netcdf-4.1.1/include -I/net2/nnz/opt/mpich2-1.3_ifort11_x64/include +#CFLAGS += $(shell pkg-config --cflags-only-I mpich2-c) +CFLAGS_OPT = -O2 +CFLAGS_OPENMP = -fopenmp +CFLAGS_DEBUG = -O0 -g + +# Optional Testing compile flags. Mutually exclusive from DEBUG, REPRO, and OPT +# *_TEST will match the production if no new option(s) is(are) to be tested. +FFLAGS_TEST = -O2 +CFLAGS_TEST = -O2 + +LDFLAGS := +LDFLAGS_OPENMP := -fopenmp +LDFLAGS_VERBOSE := + +ifneq ($(REPRO),) +CFLAGS += $(CFLAGS_REPRO) +FFLAGS += $(FFLAGS_REPRO) +endif +ifneq ($(DEBUG),) +CFLAGS += $(CFLAGS_DEBUG) +FFLAGS += $(FFLAGS_DEBUG) +else ifneq ($(TEST),) +CFLAGS += $(CFLAGS_TEST) +FFLAGS += $(FFLAGS_TEST) +else +CFLAGS += $(CFLAGS_OPT) +FFLAGS += $(FFLAGS_OPT) +endif + +ifneq ($(OPENMP),) +CFLAGS += $(CFLAGS_OPENMP) +FFLAGS += $(FFLAGS_OPENMP) +LDFLAGS += $(LDFLAGS_OPENMP) +endif + +ifneq ($(VERBOSE),) +CFLAGS += $(CFLAGS_VERBOSE) +FFLAGS += $(FFLAGS_VERBOSE) +LDFLAGS += $(LDFLAGS_VERBOSE) +endif + +ifeq ($(NETCDF),3) + # add the use_LARGEFILE cppdef + ifneq ($(findstring -Duse_netCDF,$(CPPDEFS)),) + CPPDEFS += -Duse_LARGEFILE + endif +endif + +LIBS := $(shell nc-config --flibs) -L/net2/nnz/opt/mpich2-1.3_ifort11_x64/lib -lmpich -lmpl -lpthread +#$(shell pkg-config --libs mpich2-f90) #does not work +LDFLAGS += $(LIBS) + +#--------------------------------------------------------------------------- +# you should never need to change any lines below. + +# see the MIPSPro F90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .opt create an optimization report +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source +# make .i create a preprocessed file (for .F) +# make .i90 create a preprocessed file (for .F90) + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh -f +TMPFILES = .*.m *.B *.L *.i *.i90 *.l *.s *.mod *.opt + +.SUFFIXES: .F .F90 .H .L .T .f .f90 .h .i .i90 .l .o .s .opt .x + +.f.L: + $(FC) $(FFLAGS) -c -listing $*.f +.f.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f +.f.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f +.f.T: + $(FC) $(FFLAGS) -c -cif $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -S $*.f +.f.x: + $(FC) $(FFLAGS) -o $*.x $*.f *.o $(LDFLAGS) +.f90.L: + $(FC) $(FFLAGS) -c -listing $*.f90 +.f90.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f90 +.f90.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f90 +.f90.T: + $(FC) $(FFLAGS) -c -cif $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -S $*.f90 +.f90.x: + $(FC) $(FFLAGS) -o $*.x $*.f90 *.o $(LDFLAGS) +.F.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F +.F.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F +.F.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F +.F.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F +.F.f: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F > $*.f +.F.i: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F +.F.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F +.F.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F *.o $(LDFLAGS) +.F90.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F90 +.F90.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F90 +.F90.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F90 +.F90.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F90 +.F90.f90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F90 > $*.f90 +.F90.i90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F90 *.o $(LDFLAGS) diff --git a/MOM_code/bin/mkmf.template.gfdl_ws_64.gnu.debug b/MOM_code/bin/mkmf.template.gfdl_ws_64.gnu.debug new file mode 100644 index 0000000..1744c6c --- /dev/null +++ b/MOM_code/bin/mkmf.template.gfdl_ws_64.gnu.debug @@ -0,0 +1,184 @@ +# $Id: mkmf.template.gfdl_ws_64.gnu.debug,v 1.1.2.1 2013/12/18 17:47:54 Niki.Zadeh Exp $ +# template for the Intel fortran compiler +# typical use with mkmf +# mkmf -t template.ifc -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include +############ +# commands # +############ +FC = gfortran +CC = gcc +LD = gfortran $(MAIN_PROGRAM) +######### +# flags # +######### +DEBUG = on +REPRO = +VERBOSE = +OPENMP = + +MAKEFLAGS += --jobs=$(shell grep '^processor' /proc/cpuinfo | wc -l) + +FPPFLAGS := + +FFLAGS := -fcray-pointer -fdefault-real-8 -Waliasing -ffree-line-length-none -fno-range-check +FFLAGS += -I/net2/nnz/opt/netcdf-4.1.1/include +#FFLAGS += -I/home/fms/local/opt/netcdf/4.1.1-gnu-4/include +#The above fails with USE netcdf, ONLY: NF_FILL_REAL => NF90_FILL_REAL +# 1 +# Fatal Error: Parse error when checking module version for file 'netcdf.mod' opened at (1) +# +#FFLAGS += $(shell nc-config --fflags) +# +FFLAGS += -I/net2/nnz/opt/mpich2-1.3_ifort11_x64/include +#FFLAGS += -I/usr/local/x64/mpich2-1.2.1p1/include # I do not trust this package, mpirun does not work +#$(shell pkg-config --cflags-only-I mpich2-c) +FFLAGS_OPT = -O2 +FFLAGS_REPRO = +FFLAGS_DEBUG = -O0 -g -W -fbounds-check +FFLAGS_OPENMP = -fopenmp +FFLAGS_VERBOSE = + +CFLAGS := -D__IFC +CFLAGS += $(shell nc-config --cflags) +CFLAGS += -I/net2/nnz/opt/netcdf-4.1.1/include -I/net2/nnz/opt/mpich2-1.3_ifort11_x64/include +#CFLAGS += $(shell pkg-config --cflags-only-I mpich2-c) +CFLAGS_OPT = -O2 +CFLAGS_OPENMP = -fopenmp +CFLAGS_DEBUG = -O0 -g + +# Optional Testing compile flags. Mutually exclusive from DEBUG, REPRO, and OPT +# *_TEST will match the production if no new option(s) is(are) to be tested. +FFLAGS_TEST = -O2 +CFLAGS_TEST = -O2 + +LDFLAGS := +LDFLAGS_OPENMP := -fopenmp +LDFLAGS_VERBOSE := + +ifneq ($(REPRO),) +CFLAGS += $(CFLAGS_REPRO) +FFLAGS += $(FFLAGS_REPRO) +endif +ifneq ($(DEBUG),) +CFLAGS += $(CFLAGS_DEBUG) +FFLAGS += $(FFLAGS_DEBUG) +else ifneq ($(TEST),) +CFLAGS += $(CFLAGS_TEST) +FFLAGS += $(FFLAGS_TEST) +else +CFLAGS += $(CFLAGS_OPT) +FFLAGS += $(FFLAGS_OPT) +endif + +ifneq ($(OPENMP),) +CFLAGS += $(CFLAGS_OPENMP) +FFLAGS += $(FFLAGS_OPENMP) +LDFLAGS += $(LDFLAGS_OPENMP) +endif + +ifneq ($(VERBOSE),) +CFLAGS += $(CFLAGS_VERBOSE) +FFLAGS += $(FFLAGS_VERBOSE) +LDFLAGS += $(LDFLAGS_VERBOSE) +endif + +ifeq ($(NETCDF),3) + # add the use_LARGEFILE cppdef + ifneq ($(findstring -Duse_netCDF,$(CPPDEFS)),) + CPPDEFS += -Duse_LARGEFILE + endif +endif + +LIBS := $(shell nc-config --flibs) -L/net2/nnz/opt/mpich2-1.3_ifort11_x64/lib -lmpich -lmpl -lpthread +#$(shell pkg-config --libs mpich2-f90) #does not work +LDFLAGS += $(LIBS) + +#--------------------------------------------------------------------------- +# you should never need to change any lines below. + +# see the MIPSPro F90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .opt create an optimization report +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source +# make .i create a preprocessed file (for .F) +# make .i90 create a preprocessed file (for .F90) + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh -f +TMPFILES = .*.m *.B *.L *.i *.i90 *.l *.s *.mod *.opt + +.SUFFIXES: .F .F90 .H .L .T .f .f90 .h .i .i90 .l .o .s .opt .x + +.f.L: + $(FC) $(FFLAGS) -c -listing $*.f +.f.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f +.f.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f +.f.T: + $(FC) $(FFLAGS) -c -cif $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -S $*.f +.f.x: + $(FC) $(FFLAGS) -o $*.x $*.f *.o $(LDFLAGS) +.f90.L: + $(FC) $(FFLAGS) -c -listing $*.f90 +.f90.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f90 +.f90.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f90 +.f90.T: + $(FC) $(FFLAGS) -c -cif $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -S $*.f90 +.f90.x: + $(FC) $(FFLAGS) -o $*.x $*.f90 *.o $(LDFLAGS) +.F.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F +.F.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F +.F.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F +.F.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F +.F.f: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F > $*.f +.F.i: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F +.F.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F +.F.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F *.o $(LDFLAGS) +.F90.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F90 +.F90.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F90 +.F90.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F90 +.F90.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F90 +.F90.f90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F90 > $*.f90 +.F90.i90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F90 *.o $(LDFLAGS) diff --git a/MOM_code/bin/mkmf.template.gfdl_ws_64.intel b/MOM_code/bin/mkmf.template.gfdl_ws_64.intel new file mode 100644 index 0000000..486afa1 --- /dev/null +++ b/MOM_code/bin/mkmf.template.gfdl_ws_64.intel @@ -0,0 +1,181 @@ +# template for the Intel fortran compiler +# typical use with mkmf +# mkmf -t template.ifc -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include +############ +# commands # +############ +FC = ifort +CC = icc +LD = ifort +######### +# flags # +######### +DEBUG = +REPRO = on +VERBOSE = +OPENMP = + +############################################## +# Need to use at least GNU Make version 3.81 # +############################################## +need := 3.81 +ok := $(filter $(need),$(firstword $(sort $(MAKE_VERSION) $(need)))) +ifneq ($(need),$(ok)) +$(error Need at least make version $(need). Load module gmake/3.81) +endif + +MAKEFLAGS += --jobs=2 + +NETCDF_ROOT = /usr/local/x64/netcdf-4.1.2 +MPICH_ROOT = /usr/local/x64/mpich2 +HDF5_ROOT = /usr/local/x64/hdf5-1.8.6/lib +ZLIB_ROOT = +INCLUDE = -I$(NETCDF_ROOT)/include -I$(MPICH_ROOT)/include + + +FPPFLAGS := -fpp -Wp,-w $(INCLUDE) + +FFLAGS := -fno-alias -automatic -safe-cray-ptr -ftz -assume byterecl -i4 -r8 -nowarn +FFLAGS_OPT = -O3 -debug minimal -fp-model precise -override-limits +FFLAGS_DEBUG = -g -O0 -check -check noarg_temp_created -check nopointer -warn -warn noerrors -fpe0 -traceback -ftrapuv +FFLAGS_REPRO = -O2 -debug minimal -no-vec -fp-model precise -override-limits +FFLAGS_OPENMP = -openmp +FFLAGS_VERBOSE = -v -V -what + + +CFLAGS := -D__IFC $(INCLUDE) +CFLAGS_OPT = -O2 -debug minimal -no-vec +CFLAGS_OPENMP = -openmp +CFLAGS_DEBUG = -O0 -g -ftrapuv -traceback + +LDFLAGS := +LDFLAGS_VERBOSE := -Wl,-V,--verbose,-cref,-M + +ifneq ($(REPRO),) +CFLAGS += $(CFLAGS_REPRO) +FFLAGS += $(FFLAGS_REPRO) +endif +ifneq ($(DEBUG),) +CFLAGS += $(CFLAGS_DEBUG) +FFLAGS += $(FFLAGS_DEBUG) +#else +#CFLAGS += $(CFLAGS_OPT) +#FFLAGS += $(FFLAGS_OPT) +endif + +ifneq ($(OPENMP),) +CFLAGS += $(CFLAGS_OPENMP) +FFLAGS += $(FFLAGS_OPENMP) +endif + +ifneq ($(VERBOSE),) +CFLAGS += $(CFLAGS_VERBOSE) +FFLAGS += $(FFLAGS_VERBOSE) +LDFLAGS += $(LDFLAGS_VERBOSE) +endif + +ifeq ($(NETCDF),3) + # add the use_LARGEFILE cppdef + ifneq ($(findstring -Duse_netCDF,$(CPPDEFS)),) + CPPDEFS += -Duse_LARGEFILE + endif +endif + +ifneq ($(findstring netcdf-4.0.1,$(LOADEDMODULES)),) + LIBS := -L$(NETCDF_ROOT)/lib -lnetcdf -lnetcdff -L$(HDF5_ROOT)/lib -lhdf5_hl -lhdf5 -lcurl -L$(ZLIB_ROOT)/lib -lz +else + LIBS := -L$(NETCDF_ROOT)/lib -lnetcdf -lnetcdff +endif + +LIBS += -L$(MPICH_ROOT)/lib -lmpich -lpthread +LDFLAGS += $(LIBS) + +#--------------------------------------------------------------------------- +# you should never need to change any lines below. + +# see the MIPSPro F90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .opt create an optimization report +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source +# make .i create a preprocessed file (for .F) +# make .i90 create a preprocessed file (for .F90) + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh -f +TMPFILES = .*.m *.B *.L *.i *.i90 *.l *.s *.mod *.opt + +.SUFFIXES: .F .F90 .H .L .T .f .f90 .h .i .i90 .l .o .s .opt .x + +.f.L: + $(FC) $(FFLAGS) -c -listing $*.f +.f.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f +.f.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f +.f.T: + $(FC) $(FFLAGS) -c -cif $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -S $*.f +.f.x: + $(FC) $(FFLAGS) -o $*.x $*.f *.o $(LDFLAGS) +.f90.L: + $(FC) $(FFLAGS) -c -listing $*.f90 +.f90.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f90 +.f90.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f90 +.f90.T: + $(FC) $(FFLAGS) -c -cif $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -S $*.f90 +.f90.x: + $(FC) $(FFLAGS) -o $*.x $*.f90 *.o $(LDFLAGS) +.F.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F +.F.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F +.F.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F +.F.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F +.F.f: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F > $*.f +.F.i: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F +.F.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F +.F.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F *.o $(LDFLAGS) +.F90.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F90 +.F90.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F90 +.F90.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F90 +.F90.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F90 +.F90.f90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F90 > $*.f90 +.F90.i90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F90 *.o $(LDFLAGS) diff --git a/MOM_code/bin/mkmf.template.gfortran b/MOM_code/bin/mkmf.template.gfortran new file mode 100644 index 0000000..66a84cc --- /dev/null +++ b/MOM_code/bin/mkmf.template.gfortran @@ -0,0 +1,229 @@ +# $Id: gnu.mk,v 1.1.2.1.2.1 2012/03/07 15:08:54 sdu Exp $ +# template for the Intel fortran compiler +# typical use with mkmf +# mkmf -t template.ifc -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include +############ +# commands # +############ +FC = mpif90 +CC = mpicc +CXX = mpic++ +LD = mpif90 $(MAIN_PROGRAM) +######### +# flags # +######### +DEBUG = +REPRO = +VERBOSE = +OPENMP = + +MAKEFLAGS += --jobs=$(shell grep '^processor' /proc/cpuinfo | wc -l) + +# Required Preprocessor Macros: +CPPDEFS += -Duse_netCDF + +# Additional Preprocessor Macros needed due to Autotools and CMake +CPPDEFS += -DHAVE_SCHED_GETAFFINITY + +# Macro for Fortran preprocessor +FPPFLAGS := $(INCLUDES) +# Fortran Compiler flags for the NetCDF library +FPPFLAGS += $(shell nf-config --fflags) +# Fortran Compiler flags for the MPICH MPI library +FFPFLAGS += -I/usr/lib/x86_64-linux-gnu/openmpi/lib +FFPFLAGS += -I/usr/lib/x86_64-linux-gnu/openmpi/include +FFPFLAGS += -I/usr/lib/x86_64-linux-gnu/openmpi/include/openmpi +# Base set of Fortran compiler flags +FFLAGS := -fcray-pointer -fdefault-double-8 -fdefault-real-8 -Waliasing -ffree-line-length-none -fno-range-check + +# Flags based on perforance target (production (OPT), reproduction (REPRO), or debug (DEBUG) +FFLAGS_OPT = -O3 +FFLAGS_REPRO = -O2 -fbounds-check +FFLAGS_DEBUG = -O0 -g -W -fbounds-check -fbacktrace -ffpe-trap=invalid,zero,overflow + +# Flags to add additional build options +FFLAGS_OPENMP = -fopenmp +FFLAGS_VERBOSE = +FFLAGS_COVERAGE = + +# Macro for C preprocessor +CPPFLAGS := $(INCLUDES) +# C Compiler flags for the NetCDF library +CPPFLAGS += $(shell nc-config --cflags) +# C Compiler flags for the MPICH MPI library +CPPFLAGS += -I/usr/lib/x86_64-linux-gnu/openmpi/lib +CPPFLAGS += -I/usr/lib/x86_64-linux-gnu/openmpi/include +CPPFLAGS += -I/usr/lib/x86_64-linux-gnu/openmpi/include/openmpi + +# Base set of C compiler flags +CFLAGS := -D__IFC +# Flags based on perforance target (production (OPT), reproduction (REPRO), or debug (DEBUG) +CFLAGS_OPT = -O2 +CFLAGS_REPRO = -O2 +CFLAGS_DEBUG = -O0 -g + +# Flags to add additional build options +CFLAGS_OPENMP = -fopenmp +CFLAGS_VERBOSE = +CFLAGS_COVERAGE = + +# Optional Testing compile flags. Mutually exclusive from DEBUG, REPRO, and OPT +# *_TEST will match the production if no new option(s) is(are) to be tested. +FFLAGS_TEST := $(FFLAGS_OPT) +CFLAGS_TEST := $(CFLAGS_OPT) + +# Linking flags +LDFLAGS := +LDFLAGS_OPENMP := -fopenmp +LDFLAGS_VERBOSE := +LDFLAGS_COVERAGE := + +# Start with a blank LIBS +LIBS = +# NetCDF library flags +LIBS += $(shell nf-config --flibs) +# MPICH MPI library flags +LIBS += -L/usr/lib/x86_64-linux-gnu/openmpi/lib -lmpi +LIBS += -lnetcdff +# Get compile flags based on target macros. +ifdef REPRO +CFLAGS += $(CFLAGS_REPRO) +FFLAGS += $(FFLAGS_REPRO) +else ifdef DEBUG +CFLAGS += $(CFLAGS_DEBUG) +FFLAGS += $(FFLAGS_DEBUG) +else ifdef TEST +CFLAGS += $(CFLAGS_TEST) +FFLAGS += $(FFLAGS_TEST) +else +CFLAGS += $(CFLAGS_OPT) +FFLAGS += $(FFLAGS_OPT) +endif + +ifdef OPENMP +CFLAGS += $(CFLAGS_OPENMP) +FFLAGS += $(FFLAGS_OPENMP) +LDFLAGS += $(LDFLAGS_OPENMP) +endif + +ifdef SSE +CFLAGS += $(SSE) +FFLAGS += $(SSE) +endif + +ifdef NO_OVERRIDE_LIMITS +FFLAGS += $(FFLAGS_OVERRIDE_LIMITS) +endif + +ifdef VERBOSE +CFLAGS += $(CFLAGS_VERBOSE) +FFLAGS += $(FFLAGS_VERBOSE) +LDFLAGS += $(LDFLAGS_VERBOSE) +endif + +ifeq ($(NETCDF),3) + # add the use_LARGEFILE cppdef + ifneq ($(findstring -Duse_netCDF,$(CPPDEFS)),) + CPPDEFS += -Duse_LARGEFILE + endif +endif + +ifdef COVERAGE +ifdef BUILDROOT +PROF_DIR=-prof-dir=$(BUILDROOT) +endif +CFLAGS += $(CFLAGS_COVERAGE) $(PROF_DIR) +FFLAGS += $(FFLAGS_COVERAGE) $(PROF_DIR) +LDFLAGS += $(LDFLAGS_COVERAGE) $(PROF_DIR) +endif + +LDFLAGS += $(LIBS) +#--------------------------------------------------------------------------- +# you should never need to change any lines below. + +# see the MIPSPro F90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .opt create an optimization report +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source +# make .i create a preprocessed file (for .F) +# make .i90 create a preprocessed file (for .F90) + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh -f +TMPFILES = .*.m *.B *.L *.i *.i90 *.l *.s *.mod *.opt + +.SUFFIXES: .F .F90 .H .L .T .f .f90 .h .i .i90 .l .o .s .opt .x + +.f.L: + $(FC) $(FFLAGS) -c -listing $*.f +.f.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f +.f.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f +.f.T: + $(FC) $(FFLAGS) -c -cif $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -S $*.f +.f.x: + $(FC) $(FFLAGS) -o $*.x $*.f *.o $(LDFLAGS) +.f90.L: + $(FC) $(FFLAGS) -c -listing $*.f90 +.f90.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f90 +.f90.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f90 +.f90.T: + $(FC) $(FFLAGS) -c -cif $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -S $*.f90 +.f90.x: + $(FC) $(FFLAGS) -o $*.x $*.f90 *.o $(LDFLAGS) +.F.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F +.F.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F +.F.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F +.F.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F +.F.f: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F > $*.f +.F.i: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F +.F.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F +.F.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F *.o $(LDFLAGS) +.F90.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F90 +.F90.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F90 +.F90.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F90 +.F90.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F90 +.F90.f90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F90 > $*.f90 +.F90.i90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F90 *.o $(LDFLAGS) diff --git a/MOM_code/bin/mkmf.template.hpcs.intel b/MOM_code/bin/mkmf.template.hpcs.intel new file mode 100644 index 0000000..c7c6136 --- /dev/null +++ b/MOM_code/bin/mkmf.template.hpcs.intel @@ -0,0 +1,167 @@ +# template for the Intel fortran compiler +# typical use with mkmf +# mkmf -t template.ifc -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include +############ +# commands # +############ +FC = ifort +CC = icc +LD = ifort +######### +# flags # +######### +DEBUG = +REPRO = +VERBOSE = +OPENMP = + +MAKEFLAGS += --jobs=8 + +FPPFLAGS := -fpp -Wp,-w + +FFLAGS := -fno-alias -stack_temps -safe_cray_ptr -ftz -i_dynamic -assume byterecl -i4 -r8 -nowarn -g +FFLAGS_OPT = -O2 +FFLAGS_REPRO = -fltconsistency +FFLAGS_DEBUG = -O0 -check -check noarg_temp_created -check nopointer -warn -warn noerrors -debug variable_locations -fpe0 -traceback -ftrapuv +FFLAGS_OPENMP = -openmp +FFLAGS_VERBOSE = -v -V -what + + +CFLAGS := -D__IFC +CFLAGS_OPT = -O2 +CFLAGS_OPENMP = -openmp +CFLAGS_DEBUG = -O0 -g -ftrapuv -traceback + +LDFLAGS := +LDFLAGS_OPENMP := -openmp +LDFLAGS_VERBOSE := -Wl,-V,--verbose,-cref,-M + +ifneq ($(REPRO),) +CFLAGS += $(CFLAGS_REPRO) +FFLAGS += $(FFLAGS_REPRO) +endif +ifneq ($(DEBUG),) +CFLAGS += $(CFLAGS_DEBUG) +FFLAGS += $(FFLAGS_DEBUG) +else +CFLAGS += $(CFLAGS_OPT) +FFLAGS += $(FFLAGS_OPT) +endif + +ifneq ($(OPENMP),) +CFLAGS += $(CFLAGS_OPENMP) +FFLAGS += $(FFLAGS_OPENMP) +LDFLAGS += $(LDFLAGS_OPENMP) +endif + +ifneq ($(VERBOSE),) +CFLAGS += $(CFLAGS_VERBOSE) +FFLAGS += $(FFLAGS_VERBOSE) +LDFLAGS += $(LDFLAGS_VERBOSE) +endif + +ifeq ($(NETCDF),3) + # add the use_LARGEFILE cppdef + ifneq ($(findstring -Duse_netCDF,$(CPPDEFS)),) + CPPDEFS += -Duse_LARGEFILE + endif +endif + +ifneq ($(findstring netcdf-4.0.1,$(LOADEDMODULES)),) + LIBS := -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lz +else + LIBS := -lnetcdf +endif + +LIBS += -lmpi -lsma +LDFLAGS += $(LIBS) + +#--------------------------------------------------------------------------- +# you should never need to change any lines below. + +# see the MIPSPro F90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .opt create an optimization report +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source +# make .i create a preprocessed file (for .F) +# make .i90 create a preprocessed file (for .F90) + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh -f +TMPFILES = .*.m *.B *.L *.i *.i90 *.l *.s *.mod *.opt + +.SUFFIXES: .F .F90 .H .L .T .f .f90 .h .i .i90 .l .o .s .opt .x + +.f.L: + $(FC) $(FFLAGS) -c -listing $*.f +.f.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f +.f.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f +.f.T: + $(FC) $(FFLAGS) -c -cif $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -S $*.f +.f.x: + $(FC) $(FFLAGS) -o $*.x $*.f *.o $(LDFLAGS) +.f90.L: + $(FC) $(FFLAGS) -c -listing $*.f90 +.f90.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f90 +.f90.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f90 +.f90.T: + $(FC) $(FFLAGS) -c -cif $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -S $*.f90 +.f90.x: + $(FC) $(FFLAGS) -o $*.x $*.f90 *.o $(LDFLAGS) +.F.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F +.F.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F +.F.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F +.F.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F +.F.f: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F > $*.f +.F.i: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F +.F.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F +.F.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F *.o $(LDFLAGS) +.F90.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F90 +.F90.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F90 +.F90.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F90 +.F90.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F90 +.F90.f90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F90 > $*.f90 +.F90.i90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F90 *.o $(LDFLAGS) diff --git a/MOM_code/bin/mkmf.template.ia64 b/MOM_code/bin/mkmf.template.ia64 new file mode 100644 index 0000000..e30cbf3 --- /dev/null +++ b/MOM_code/bin/mkmf.template.ia64 @@ -0,0 +1,106 @@ +# template for the Intel fortran compiler +# typical use with mkmf +# mkmf -t template.ifc -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include +CPPFLAGS = +FFLAGS_BASE = -v -V -what -fpp -fno-alias -stack_temps -safe_cray_ptr -ftz -i_dynamic -assume byterecl -g -i4 -r8 -Wp,-w +FFLAGS_REPRO = -fltconsistency +FFLAGS_DEBUG = -check -check noarg_temp_created -check nopointer -warn -warn noerrors -debug variable_locations -inline_debug_info -fpe0 -traceback -ftrapuv +FFLAGS = $(FFLAGS_BASE) -O2 -nowarn +FC = ifort +CC = icc +CFLAGS_BASE = -g -D__IFC +CFLAGS_DEBUG = -ftrapuv -traceback +CFLAGS = $(CFLAGS_BASE) -O2 +LD = ifort +LDFLAGS = -Wl,-V,--verbose,-cref,-Map linker.map -lnetcdf -lmpi -lsma +MAKEFLAGS+=--jobs=8 + +#--------------------------------------------------------------------------- +# you should never need to change any lines below. + +# see the MIPSPro F90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .opt create an optimization report +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source +# make .i create a preprocessed file (for .F) +# make .i90 create a preprocessed file (for .F90) + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh -f +TMPFILES = .*.m *.B *.L *.i *.i90 *.l *.s *.mod *.opt + +.SUFFIXES: .F .F90 .H .L .T .f .f90 .h .i .i90 .l .o .s .opt .x + +.f.L: + $(FC) $(FFLAGS) -c -listing $*.f +.f.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f +.f.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f +.f.T: + $(FC) $(FFLAGS) -c -cif $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -S $*.f +.f.x: + $(FC) $(FFLAGS) -o $*.x $*.f *.o $(LDFLAGS) +.f90.L: + $(FC) $(FFLAGS) -c -listing $*.f90 +.f90.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f90 +.f90.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f90 +.f90.T: + $(FC) $(FFLAGS) -c -cif $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -S $*.f90 +.f90.x: + $(FC) $(FFLAGS) -o $*.x $*.f90 *.o $(LDFLAGS) +.F.L: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -listing $*.F +.F.opt: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F +.F.l: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $(LIST) $*.F +.F.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -cif $*.F +.F.f: + $(FC) $(CPPDEFS) $(CPPFLAGS) -EP $*.F > $*.f +.F.i: + $(FC) $(CPPDEFS) $(CPPFLAGS) -P $*.F +.F.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -S $*.F +.F.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -o $*.x $*.F *.o $(LDFLAGS) +.F90.L: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -listing $*.F90 +.F90.opt: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F90 +.F90.l: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $(LIST) $*.F90 +.F90.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -cif $*.F90 +.F90.f90: + $(FC) $(CPPDEFS) $(CPPFLAGS) -EP $*.F90 > $*.f90 +.F90.i90: + $(FC) $(CPPDEFS) $(CPPFLAGS) -P $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -S $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -o $*.x $*.F90 *.o $(LDFLAGS) diff --git a/MOM_code/bin/mkmf.template.ia64_flt b/MOM_code/bin/mkmf.template.ia64_flt new file mode 100644 index 0000000..e30db39 --- /dev/null +++ b/MOM_code/bin/mkmf.template.ia64_flt @@ -0,0 +1,106 @@ +# template for the Intel fortran compiler +# typical use with mkmf +# mkmf -t template.ifc -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include +CPPFLAGS = +FFLAGS_BASE = -v -V -what -fpp -fno-alias -stack_temps -safe_cray_ptr -ftz -i_dynamic -assume byterecl -g -i4 -r8 -Wp,-w +FFLAGS_REPRO = -fltconsistency +FFLAGS_DEBUG = -check -check noarg_temp_created -check nopointer -warn -warn noerrors -debug variable_locations -inline_debug_info -fpe0 -traceback -ftrapuv +FFLAGS = $(FFLAGS_BASE) $(FFLAGS_REPRO) -O2 -nowarn +FC = ifort +CC = icc +CFLAGS_BASE = -g -D__IFC +CFLAGS_DEBUG = -ftrapuv -traceback +CFLAGS = $(CFLAGS_BASE) -O2 +LD = ifort +LDFLAGS = -Wl,-V,--verbose,-cref,-Map linker.map -lnetcdf -lmpi -lsma +MAKEFLAGS+=--jobs=8 + +#--------------------------------------------------------------------------- +# you should never need to change any lines below. + +# see the MIPSPro F90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .opt create an optimization report +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source +# make .i create a preprocessed file (for .F) +# make .i90 create a preprocessed file (for .F90) + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh -f +TMPFILES = .*.m *.B *.L *.i *.i90 *.l *.s *.mod *.opt + +.SUFFIXES: .F .F90 .H .L .T .f .f90 .h .i .i90 .l .o .s .opt .x + +.f.L: + $(FC) $(FFLAGS) -c -listing $*.f +.f.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f +.f.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f +.f.T: + $(FC) $(FFLAGS) -c -cif $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -S $*.f +.f.x: + $(FC) $(FFLAGS) -o $*.x $*.f *.o $(LDFLAGS) +.f90.L: + $(FC) $(FFLAGS) -c -listing $*.f90 +.f90.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f90 +.f90.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f90 +.f90.T: + $(FC) $(FFLAGS) -c -cif $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -S $*.f90 +.f90.x: + $(FC) $(FFLAGS) -o $*.x $*.f90 *.o $(LDFLAGS) +.F.L: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -listing $*.F +.F.opt: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F +.F.l: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $(LIST) $*.F +.F.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -cif $*.F +.F.f: + $(FC) $(CPPDEFS) $(CPPFLAGS) -EP $*.F > $*.f +.F.i: + $(FC) $(CPPDEFS) $(CPPFLAGS) -P $*.F +.F.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -S $*.F +.F.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -o $*.x $*.F *.o $(LDFLAGS) +.F90.L: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -listing $*.F90 +.F90.opt: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F90 +.F90.l: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $(LIST) $*.F90 +.F90.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -cif $*.F90 +.F90.f90: + $(FC) $(CPPDEFS) $(CPPFLAGS) -EP $*.F90 > $*.f90 +.F90.i90: + $(FC) $(CPPDEFS) $(CPPFLAGS) -P $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -S $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -o $*.x $*.F90 *.o $(LDFLAGS) diff --git a/MOM_code/bin/mkmf.template.ia64_flt_hdf b/MOM_code/bin/mkmf.template.ia64_flt_hdf new file mode 100644 index 0000000..51a416d --- /dev/null +++ b/MOM_code/bin/mkmf.template.ia64_flt_hdf @@ -0,0 +1,106 @@ +# template for the Intel fortran compiler +# typical use with mkmf +# mkmf -t template.ifc -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include +CPPFLAGS = +FFLAGS_BASE = -v -V -what -fpp -fno-alias -stack_temps -safe_cray_ptr -ftz -i_dynamic -assume byterecl -g -i4 -r8 -Wp,-w +FFLAGS_REPRO = -fltconsistency +FFLAGS_DEBUG = -check -check noarg_temp_created -check nopointer -warn -warn noerrors -debug variable_locations -inline_debug_info -fpe0 -traceback -ftrapuv +FFLAGS = $(FFLAGS_BASE) $(FFLAGS_REPRO) -O2 -nowarn +FC = ifort +CC = icc +CFLAGS_BASE = -g -D__IFC +CFLAGS_DEBUG = -ftrapuv -traceback +CFLAGS = $(CFLAGS_BASE) -O2 +LD = ifort +LDFLAGS = -Wl,-V,--verbose,-cref,-Map linker.map -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lz -lmpi -lsma +MAKEFLAGS+=--jobs=8 + +#--------------------------------------------------------------------------- +# you should never need to change any lines below. + +# see the MIPSPro F90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .opt create an optimization report +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source +# make .i create a preprocessed file (for .F) +# make .i90 create a preprocessed file (for .F90) + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh -f +TMPFILES = .*.m *.B *.L *.i *.i90 *.l *.s *.mod *.opt + +.SUFFIXES: .F .F90 .H .L .T .f .f90 .h .i .i90 .l .o .s .opt .x + +.f.L: + $(FC) $(FFLAGS) -c -listing $*.f +.f.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f +.f.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f +.f.T: + $(FC) $(FFLAGS) -c -cif $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -S $*.f +.f.x: + $(FC) $(FFLAGS) -o $*.x $*.f *.o $(LDFLAGS) +.f90.L: + $(FC) $(FFLAGS) -c -listing $*.f90 +.f90.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f90 +.f90.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f90 +.f90.T: + $(FC) $(FFLAGS) -c -cif $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -S $*.f90 +.f90.x: + $(FC) $(FFLAGS) -o $*.x $*.f90 *.o $(LDFLAGS) +.F.L: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -listing $*.F +.F.opt: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F +.F.l: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $(LIST) $*.F +.F.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -cif $*.F +.F.f: + $(FC) $(CPPDEFS) $(CPPFLAGS) -EP $*.F > $*.f +.F.i: + $(FC) $(CPPDEFS) $(CPPFLAGS) -P $*.F +.F.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -S $*.F +.F.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -o $*.x $*.F *.o $(LDFLAGS) +.F90.L: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -listing $*.F90 +.F90.opt: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F90 +.F90.l: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $(LIST) $*.F90 +.F90.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -cif $*.F90 +.F90.f90: + $(FC) $(CPPDEFS) $(CPPFLAGS) -EP $*.F90 > $*.f90 +.F90.i90: + $(FC) $(CPPDEFS) $(CPPFLAGS) -P $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -S $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -o $*.x $*.F90 *.o $(LDFLAGS) diff --git a/MOM_code/bin/mkmf.template.ibm b/MOM_code/bin/mkmf.template.ibm new file mode 100644 index 0000000..b279544 --- /dev/null +++ b/MOM_code/bin/mkmf.template.ibm @@ -0,0 +1,13 @@ +# Template for IBM xlf and xlc compilers +#typical use with netCDF: +# mkmf -t template.ibm -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include +FC = mpxlf90_r +LD = mpxlf90_r +CC = mpcc_r +#CC was xlc_r +FFLAGS = -qsuffix=f=f90:cpp=F90 -qarch=auto -qmaxmem=-1 -qdpc -qrealsize=8 -qintsize=4 -qstrict -O3 -q64 +CFLAGS = -q64 +#LDFLAGS = -brename:.flush,.flush_ -brename:.mld_id_,.mld_id $(LIBS) +LDFLAGS = -q64 -brename:.flush,.flush_ -brename:.mld_id_,.mld_id $(LIBS) +# LIBS will need site-specific customization +LIBS = -L /usr/local/lib -lnetcdf -lmass diff --git a/MOM_code/bin/mkmf.template.ibm.xlf b/MOM_code/bin/mkmf.template.ibm.xlf new file mode 100644 index 0000000..97cd20d --- /dev/null +++ b/MOM_code/bin/mkmf.template.ibm.xlf @@ -0,0 +1,15 @@ +# Template for IBM xlf and xlc compilers +#typical use with netCDF: +# mkmf -t template.ibm -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include +FC = mpxlf90_r +LD = mpxlf90_r +CC = mpcc_r + CPPFLAGS = + NETCDF = /usr/local + FFLAGS = $(CPPFLAGS) -I$(NETCDF)/include -O2 -qalias_size=1207959552 -qmaxmem=256000 -g -d -qsuffix=cpp=F90 -qintsize=4 -qrealsize=8 -qdpc -qextname=flush -qextname=mld_id -qsmp=omp:noauto -qnohot -qsimd=noauto -qnoipa + GFLAGS = $(CPPFLAGS) -I$(NETCDF)/include -O2 -qalias_size=1207959552 -qmaxmem=256000 -g -d -qsuffix=cpp=F90 -qintsize=4 -qrealsize=8 -qdpc -qextname=flush -qextname=mld_id -qsmp=omp:noauto -qnohot -qsimd=noauto + PFLAGS = $(CPPFLAGS) -I$(NETCDF)/include -O0 -qalias_size=1207959552 -qmaxmem=256000 -g -d -qsuffix=cpp=F90 -qintsize=4 -qrealsize=8 -qdpc -qextname=flush -qextname=mld_id -qsmp=omp:noauto -qnohot -qsimd=noauto + QFLAGS = $(CPPFLAGS) -I$(NETCDF)/include -O2 -qalias_size=1207959552 -qmaxmem=256000 -g -d -qsuffix=cpp=F90 -qintsize=4 -qrealsize=8 -qdpc -qextname=flush -qextname=mld_id -qsmp=omp:noauto -qnohot -qsimd=noauto -qfixed + CFLAGS = -I$(NETCDF)/include + LDFLAGS = -L$(NETCDF)/lib -lnetcdf -lmass -qsmp + diff --git a/MOM_code/bin/mkmf.template.ifc b/MOM_code/bin/mkmf.template.ifc new file mode 100644 index 0000000..9694526 --- /dev/null +++ b/MOM_code/bin/mkmf.template.ifc @@ -0,0 +1,21 @@ +# template for the Intel fortran compiler version 8 +# typical use with mkmf +# mkmf -t template.ifc -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include + +# -traceback +# +INCL := $(shell pkg-config --cflags-only-I netcdf-fortran) +LIBS := $(shell pkg-config --libs netcdf) +LIBS += $(shell pkg-config --libs netcdf-fortran) +#LIBS += -L/scratch/usr/mvkthne2/libs/hdf5/1.8.20/skl/intel.18.0.3/lib +#LIBS += -L/scratch/usr/mvkthne2/libs/szip/2.1/skl/intel.18.0.3/lib +LFLAGS := -Wl,-rpath,$(shell pkg-config --variable=libdir netcdf) +#LFLAGS += -Wl,-rpath,/scratch/usr/mvkthne2/libs/hdf5/1.8.20/skl/intel.18.0.3/lib +#LFLAGS += -Wl,-rpath,/scratch/usr/mvkthne2/libs/szip/2.1/skl/intel.18.0.3/lib +FFLAGS := -O3 -xCORE-AVX512 -qopt-zmm-usage=high -r8 -fp-model precise -align array64byte ${INCL} +CPPFLAGS := ${INCL} +FC = mpiifort +LD = mpiifort +LDFLAGS := ${LIBS} ${LFLAGS} +CC = mpiicc + diff --git a/MOM_code/bin/mkmf.template.nci b/MOM_code/bin/mkmf.template.nci new file mode 100644 index 0000000..a26b0c4 --- /dev/null +++ b/MOM_code/bin/mkmf.template.nci @@ -0,0 +1,146 @@ +# Template for the NCI (nf.nci.org.au) machines. Uses intel compiler and OpenMPI. +# typical use with mkmf +# mkmf -t template.ifc -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include +############ +# commands # +############ +FC = mpif90 +CC = icc +LD = mpif90 +######### +# flags # +######### +DEBUG = +REPRO = on +VERBOSE = + +MAKEFLAGS += --jobs=4 + +INCLUDE = -I$(NETCDF_ROOT)/include + +FPPFLAGS := -fpp -Wp,-w $(INCLUDE) +FFLAGS := -fno-alias -safe-cray-ptr -ftz -assume byterecl -i4 -r8 -nowarn +FFLAGS_OPT = -O3 -debug minimal -fp-model precise +FFLAGS_DEBUG = -g -O0 -check -check noarg_temp_created -check nopointer -warn -warn noerrors -fpe0 -traceback -ftrapuv +FFLAGS_REPRO = -O2 -debug minimal -no-vec -fp-model precise +FFLAGS_VERBOSE = -v -V -what + +CFLAGS := -D__IFC $(INCLUDE) +CFLAGS_OPT = -O2 -debug minimal -no-vec +CFLAGS_DEBUG = -O0 -g -ftrapuv -traceback + +LDFLAGS := +LDFLAGS_VERBOSE := -Wl,-V,--verbose,-cref,-M + +ifneq ($(REPRO),) +CFLAGS += $(CFLAGS_REPRO) +FFLAGS += $(FFLAGS_REPRO) +endif +ifneq ($(DEBUG),) +CFLAGS += $(CFLAGS_DEBUG) +FFLAGS += $(FFLAGS_DEBUG) +else +CFLAGS += $(CFLAGS_OPT) +FFLAGS += $(FFLAGS_OPT) +endif + +ifneq ($(VERBOSE),) +CFLAGS += $(CFLAGS_VERBOSE) +FFLAGS += $(FFLAGS_VERBOSE) +LDFLAGS += $(LDFLAGS_VERBOSE) +endif + +LIBS := -L$(NETCDF_ROOT)/lib -lnetcdf -lnetcdff -L$(HDF5_ROOT)/lib -lhdf5_hl -lhdf5 -lcurl -L$(ZLIB_ROOT)/lib -lz + +LIBS += $(OPENMPI_F90LIBS) -lpthread +LDFLAGS += $(LIBS) + +#--------------------------------------------------------------------------- +# you should never need to change any lines below. + +# see the MIPSPro F90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .opt create an optimization report +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source +# make .i create a preprocessed file (for .F) +# make .i90 create a preprocessed file (for .F90) + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh -f +TMPFILES = .*.m *.B *.L *.i *.i90 *.l *.s *.mod *.opt + +.SUFFIXES: .F .F90 .H .L .T .f .f90 .h .i .i90 .l .o .s .opt .x + +.f.L: + $(FC) $(FFLAGS) -c -listing $*.f +.f.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f +.f.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f +.f.T: + $(FC) $(FFLAGS) -c -cif $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -S $*.f +.f.x: + $(FC) $(FFLAGS) -o $*.x $*.f *.o $(LDFLAGS) +.f90.L: + $(FC) $(FFLAGS) -c -listing $*.f90 +.f90.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f90 +.f90.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f90 +.f90.T: + $(FC) $(FFLAGS) -c -cif $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -S $*.f90 +.f90.x: + $(FC) $(FFLAGS) -o $*.x $*.f90 *.o $(LDFLAGS) +.F.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F +.F.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F +.F.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F +.F.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F +.F.f: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F > $*.f +.F.i: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F +.F.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F +.F.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F *.o $(LDFLAGS) +.F90.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F90 +.F90.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F90 +.F90.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F90 +.F90.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F90 +.F90.f90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F90 > $*.f90 +.F90.i90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F90 *.o $(LDFLAGS) diff --git a/MOM_code/bin/mkmf.template.ncrc1.intel b/MOM_code/bin/mkmf.template.ncrc1.intel new file mode 100644 index 0000000..3cc0a6c --- /dev/null +++ b/MOM_code/bin/mkmf.template.ncrc1.intel @@ -0,0 +1,183 @@ +# template for the Intel fortran compiler +# typical use with mkmf +# mkmf -t template.ifc -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include +############ +# commands # +############ +FC = ftn +CC = cc +LD = ftn +######### +# flags # +######### +DEBUG = +REPRO = +VERBOSE = +OPENMP = + +############################################## +# Need to use at least GNU Make version 3.81 # +############################################## +need := 3.81 +ok := $(filter $(need),$(firstword $(sort $(MAKE_VERSION) $(need)))) +ifneq ($(need),$(ok)) +$(error Need at least make version $(need). Load module gmake/3.81) +endif + +MAKEFLAGS += --jobs=2 + +NETCDF_ROOT = $(NETCDF_DIR) +MPI_ROOT = $(MPICH_DIR) +INCLUDE = -I$(NETCDF_ROOT)/include + +FPPFLAGS := -fpp -Wp,-w $(INCLUDE) + +FFLAGS := -fno-alias -automatic -safe-cray-ptr -ftz -assume byterecl -i4 -r8 -nowarn +FFLAGS_OPT = -O3 -debug minimal -fp-model precise -override-limits +FFLAGS_DEBUG = -g -O0 -check -check noarg_temp_created -check nopointer -warn -warn noerrors -fpe0 -traceback -ftrapuv +FFLAGS_REPRO = -O2 -debug minimal -fp-model precise -override-limits +FFLAGS_OPENMP = -openmp +FFLAGS_VERBOSE = -v -V -what + +CFLAGS := -D__IFC +CFLAGS_OPT = -O2 -debug minimal +CFLAGS_OPENMP = -openmp +CFLAGS_DEBUG = -O0 -g -ftrapuv -traceback + +LDFLAGS := +LDFLAGS_OPENMP := -openmp +LDFLAGS_VERBOSE := -Wl,-V,--verbose,-cref,-M + +# start with blank LIBS +LIBS := + +ifneq ($(REPRO),) +CFLAGS += $(CFLAGS_REPRO) +FFLAGS += $(FFLAGS_REPRO) +else ifneq ($(DEBUG),) +CFLAGS += $(CFLAGS_DEBUG) +FFLAGS += $(FFLAGS_DEBUG) +else +CFLAGS += $(CFLAGS_OPT) +FFLAGS += $(FFLAGS_OPT) +endif + +ifneq ($(OPENMP),) +CFLAGS += $(CFLAGS_OPENMP) +FFLAGS += $(FFLAGS_OPENMP) +LDFLAGS += $(LDFLAGS_OPENMP) +# to correct a loader bug on gaea: envars below set by module load intel +LIBS += -L$(INTEL_PATH)/$(INTEL_MAJOR_VERSION)/$(INTEL_MINOR_VERSION)/lib/intel64 -lifcoremt +endif + +ifneq ($(VERBOSE),) +CFLAGS += $(CFLAGS_VERBOSE) +FFLAGS += $(FFLAGS_VERBOSE) +LDFLAGS += $(LDFLAGS_VERBOSE) +endif + +ifeq ($(NETCDF),3) + # add the use_LARGEFILE cppdef + ifneq ($(findstring -Duse_netCDF,$(CPPDEFS)),) + CPPDEFS += -Duse_LARGEFILE + endif +endif + +ifneq ($(findstring netcdf-4.0.1,$(LOADEDMODULES)),) + LIBS += -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lz +else + LIBS += -lnetcdf +endif + +LIBS += +LDFLAGS += $(LIBS) + +#--------------------------------------------------------------------------- +# you should never need to change any lines below. + +# see the MIPSPro F90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .opt create an optimization report +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source +# make .i create a preprocessed file (for .F) +# make .i90 create a preprocessed file (for .F90) + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh -f +TMPFILES = .*.m *.B *.L *.i *.i90 *.l *.s *.mod *.opt + +.SUFFIXES: .F .F90 .H .L .T .f .f90 .h .i .i90 .l .o .s .opt .x + +.f.L: + $(FC) $(FFLAGS) -c -listing $*.f +.f.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f +.f.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f +.f.T: + $(FC) $(FFLAGS) -c -cif $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -S $*.f +.f.x: + $(FC) $(FFLAGS) -o $*.x $*.f *.o $(LDFLAGS) +.f90.L: + $(FC) $(FFLAGS) -c -listing $*.f90 +.f90.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f90 +.f90.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f90 +.f90.T: + $(FC) $(FFLAGS) -c -cif $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -S $*.f90 +.f90.x: + $(FC) $(FFLAGS) -o $*.x $*.f90 *.o $(LDFLAGS) +.F.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F +.F.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F +.F.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F +.F.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F +.F.f: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F > $*.f +.F.i: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F +.F.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F +.F.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F *.o $(LDFLAGS) +.F90.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F90 +.F90.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F90 +.F90.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F90 +.F90.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F90 +.F90.f90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F90 > $*.f90 +.F90.i90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F90 *.o $(LDFLAGS) diff --git a/MOM_code/bin/mkmf.template.ncrc2.gnu b/MOM_code/bin/mkmf.template.ncrc2.gnu new file mode 100644 index 0000000..035b81e --- /dev/null +++ b/MOM_code/bin/mkmf.template.ncrc2.gnu @@ -0,0 +1,177 @@ +# $Id: mkmf.template.ncrc2.gnu,v 1.1.2.1 2013/12/18 17:47:55 Niki.Zadeh Exp $ +# template for the Intel fortran compiler +# typical use with mkmf +# mkmf -t template.ifc -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include +############ +# commands # +############ +FC = ftn +CC = cc +LD = ftn $(MAIN_PROGRAM) +######### +# flags # +######### +DEBUG = +REPRO = +VERBOSE = +OPENMP = + +MAKEFLAGS += --jobs=2 + +FPPFLAGS := + +FFLAGS := -fcray-pointer -fdefault-real-8 -fdefault-double-8 -Waliasing -ffree-line-length-none -fno-range-check +FFLAGS_OPT = -O2 -fno-expensive-optimizations +FFLAGS_REPRO = +FFLAGS_DEBUG = -O0 -g -W -fbounds-check +FFLAGS_OPENMP = -fopenmp +FFLAGS_VERBOSE = + +CFLAGS := -D__IFC +CFLAGS_OPT = -O2 +CFLAGS_OPENMP = -fopenmp +CFLAGS_DEBUG = -O0 -g + +# Optional Testing compile flags. Mutually exclusive from DEBUG, REPRO, and OPT +# *_TEST will match the production if no new option(s) is(are) to be tested. +FFLAGS_TEST = -O2 +CFLAGS_TEST = -O2 + +LDFLAGS := +LDFLAGS_OPENMP := -fopenmp +LDFLAGS_VERBOSE := + +ifneq ($(REPRO),) +CFLAGS += $(CFLAGS_REPRO) +FFLAGS += $(FFLAGS_REPRO) +endif +ifneq ($(DEBUG),) +CFLAGS += $(CFLAGS_DEBUG) +FFLAGS += $(FFLAGS_DEBUG) +else ifneq ($(TEST),) +CFLAGS += $(CFLAGS_TEST) +FFLAGS += $(FFLAGS_TEST) +else +CFLAGS += $(CFLAGS_OPT) +FFLAGS += $(FFLAGS_OPT) +endif + +ifneq ($(OPENMP),) +CFLAGS += $(CFLAGS_OPENMP) +FFLAGS += $(FFLAGS_OPENMP) +LDFLAGS += $(LDFLAGS_OPENMP) +endif + +ifneq ($(VERBOSE),) +CFLAGS += $(CFLAGS_VERBOSE) +FFLAGS += $(FFLAGS_VERBOSE) +LDFLAGS += $(LDFLAGS_VERBOSE) +endif + +ifeq ($(NETCDF),3) + # add the use_LARGEFILE cppdef + ifneq ($(findstring -Duse_netCDF,$(CPPDEFS)),) + CPPDEFS += -Duse_LARGEFILE + endif +endif + +LIBS := + +ifneq ($(findstring netcdf,$(LOADEDMODULES)),) + LIBS += -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lz +else + LIBS += -lnetcdf +endif + +LIBS += +LDFLAGS += $(LIBS) + +#--------------------------------------------------------------------------- +# you should never need to change any lines below. + +# see the MIPSPro F90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .opt create an optimization report +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source +# make .i create a preprocessed file (for .F) +# make .i90 create a preprocessed file (for .F90) + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh -f +TMPFILES = .*.m *.B *.L *.i *.i90 *.l *.s *.mod *.opt + +.SUFFIXES: .F .F90 .H .L .T .f .f90 .h .i .i90 .l .o .s .opt .x + +.f.L: + $(FC) $(FFLAGS) -c -listing $*.f +.f.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f +.f.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f +.f.T: + $(FC) $(FFLAGS) -c -cif $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -S $*.f +.f.x: + $(FC) $(FFLAGS) -o $*.x $*.f *.o $(LDFLAGS) +.f90.L: + $(FC) $(FFLAGS) -c -listing $*.f90 +.f90.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f90 +.f90.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f90 +.f90.T: + $(FC) $(FFLAGS) -c -cif $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -S $*.f90 +.f90.x: + $(FC) $(FFLAGS) -o $*.x $*.f90 *.o $(LDFLAGS) +.F.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F +.F.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F +.F.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F +.F.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F +.F.f: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F > $*.f +.F.i: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F +.F.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F +.F.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F *.o $(LDFLAGS) +.F90.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F90 +.F90.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F90 +.F90.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F90 +.F90.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F90 +.F90.f90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F90 > $*.f90 +.F90.i90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F90 *.o $(LDFLAGS) diff --git a/MOM_code/bin/mkmf.template.ncrc2.intel b/MOM_code/bin/mkmf.template.ncrc2.intel new file mode 100644 index 0000000..bac5674 --- /dev/null +++ b/MOM_code/bin/mkmf.template.ncrc2.intel @@ -0,0 +1,183 @@ +# template for the Intel fortran compiler +# typical use with mkmf +# mkmf -t template.ifc -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include +############ +# commands # +############ +FC = ftn +CC = cc +LD = ftn +######### +# flags # +######### +DEBUG = +REPRO = on +VERBOSE = +OPENMP = + +############################################## +# Need to use at least GNU Make version 3.81 # +############################################## +need := 3.81 +ok := $(filter $(need),$(firstword $(sort $(MAKE_VERSION) $(need)))) +ifneq ($(need),$(ok)) +$(error Need at least make version $(need). Load module gmake/3.81) +endif + +MAKEFLAGS += --jobs=2 + +NETCDF_ROOT = $(NETCDF_DIR) +MPI_ROOT = $(MPICH_DIR) +INCLUDE = -I$(NETCDF_ROOT)/include + +FPPFLAGS := -fpp -Wp,-w $(INCLUDE) + +FFLAGS := -fno-alias -automatic -safe-cray-ptr -ftz -assume byterecl -i4 -r8 -nowarn +FFLAGS_OPT = -O3 -debug minimal -fp-model precise -override-limits +FFLAGS_DEBUG = -g -O0 -check -check noarg_temp_created -check nopointer -warn -warn noerrors -fpe0 -traceback -ftrapuv +FFLAGS_REPRO = -O2 -debug minimal -fp-model precise -override-limits -g -traceback +FFLAGS_OPENMP = -openmp +FFLAGS_VERBOSE = -v -V -what + +CFLAGS := -D__IFC +CFLAGS_OPT = -O2 -debug minimal +CFLAGS_OPENMP = -openmp +CFLAGS_DEBUG = -O0 -g -ftrapuv -traceback + +LDFLAGS := +LDFLAGS_OPENMP := -openmp +LDFLAGS_VERBOSE := -Wl,-V,--verbose,-cref,-M + +# start with blank LIBS +LIBS := + +ifneq ($(REPRO),) +CFLAGS += $(CFLAGS_REPRO) +FFLAGS += $(FFLAGS_REPRO) +else ifneq ($(DEBUG),) +CFLAGS += $(CFLAGS_DEBUG) +FFLAGS += $(FFLAGS_DEBUG) +else +CFLAGS += $(CFLAGS_OPT) +FFLAGS += $(FFLAGS_OPT) +endif + +ifneq ($(OPENMP),) +CFLAGS += $(CFLAGS_OPENMP) +FFLAGS += $(FFLAGS_OPENMP) +LDFLAGS += $(LDFLAGS_OPENMP) +# to correct a loader bug on gaea: envars below set by module load intel +LIBS += -L$(INTEL_PATH)/$(INTEL_MAJOR_VERSION)/$(INTEL_MINOR_VERSION)/lib/intel64 -lifcoremt +endif + +ifneq ($(VERBOSE),) +CFLAGS += $(CFLAGS_VERBOSE) +FFLAGS += $(FFLAGS_VERBOSE) +LDFLAGS += $(LDFLAGS_VERBOSE) +endif + +ifeq ($(NETCDF),3) + # add the use_LARGEFILE cppdef + ifneq ($(findstring -Duse_netCDF,$(CPPDEFS)),) + CPPDEFS += -Duse_LARGEFILE + endif +endif + +ifneq ($(findstring netcdf-4.0.1,$(LOADEDMODULES)),) + LIBS += -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lz +else + LIBS += -lnetcdf +endif + +LIBS += +LDFLAGS += $(LIBS) + +#--------------------------------------------------------------------------- +# you should never need to change any lines below. + +# see the MIPSPro F90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .opt create an optimization report +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source +# make .i create a preprocessed file (for .F) +# make .i90 create a preprocessed file (for .F90) + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh -f +TMPFILES = .*.m *.B *.L *.i *.i90 *.l *.s *.mod *.opt + +.SUFFIXES: .F .F90 .H .L .T .f .f90 .h .i .i90 .l .o .s .opt .x + +.f.L: + $(FC) $(FFLAGS) -c -listing $*.f +.f.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f +.f.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f +.f.T: + $(FC) $(FFLAGS) -c -cif $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -S $*.f +.f.x: + $(FC) $(FFLAGS) -o $*.x $*.f *.o $(LDFLAGS) +.f90.L: + $(FC) $(FFLAGS) -c -listing $*.f90 +.f90.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f90 +.f90.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f90 +.f90.T: + $(FC) $(FFLAGS) -c -cif $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -S $*.f90 +.f90.x: + $(FC) $(FFLAGS) -o $*.x $*.f90 *.o $(LDFLAGS) +.F.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F +.F.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F +.F.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F +.F.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F +.F.f: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F > $*.f +.F.i: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F +.F.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F +.F.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F *.o $(LDFLAGS) +.F90.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F90 +.F90.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F90 +.F90.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F90 +.F90.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F90 +.F90.f90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F90 > $*.f90 +.F90.i90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F90 *.o $(LDFLAGS) diff --git a/MOM_code/bin/mkmf.template.nec b/MOM_code/bin/mkmf.template.nec new file mode 100644 index 0000000..6d842d0 --- /dev/null +++ b/MOM_code/bin/mkmf.template.nec @@ -0,0 +1,87 @@ + + + +# Makefile template for SX cross compiler +#typical use with netCDF: +# mkmf -t template.nec -c"-Duse_libMPI -Duse_netCDF" path_names /opt/sx/netcdf/include +FC = sxmpif90 +LD = sxmpif90 +CC = sxmpic++ +TOTALVIEW = +NETCDF = /SX/opt/netcdf +CPPFLAGS = -D__SX +FFLAGS = -Wf"-A idbl4" -R2 -ts. -Chopt -I$(NETCDF)/include +CFLAGS = -Xa +LDFLAGS = $(LIBS) +LIST = -R2 +# LIBS needs to be customized per site +LIBS = $(TOTALVIEW) -L$(NETCDF)/lib -lnetcdf + +# you should never need to change any lines below. + +# see the SX F90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .T create a CIF file +# make .L create a compiler listing +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh +TMPFILES = *.L i.* *.s *.mod + +.SUFFIXES: .F .F90 .L .T .f .f90 .h .o .s .x + +.f.L: + $(FC) $(FFLAGS) -c $(LIST) $*.f +.f.T: + $(FC) $(FFLAGS) -c -cif $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -S $*.f +.f.x: + $(FC) $(FFLAGS) -o $*.x $*.f *.o $(LDFLAGS) +.f90.L: + $(FC) $(FFLAGS) -c $(LIST) $*.f90 +.f90.T: + $(FC) $(FFLAGS) -c -cif $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -S $*.f90 +.f90.x: + $(FC) $(FFLAGS) -o $*.x $*.f90 *.o $(LDFLAGS) +.F.L: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $(LIST) $*.F +.F.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -cif $*.F +.F.f: + $(CPP) $(CPPDEFS) $(CPPFLAGS) $*.F > $*.f +.F.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -S $*.F +.F.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -o $*.x $*.F *.o $(LDFLAGS) +.F90.L: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $(LIST) $*.F90 +.F90.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -cif $*.F90 +.F90.f90: + $(CPP) $(CPPDEFS) $(CPPFLAGS) $*.F90 > $*.f90 +.F90.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -S $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -o $*.x $*.F90 *.o $(LDFLAGS) + diff --git a/MOM_code/bin/mkmf.template.pgi b/MOM_code/bin/mkmf.template.pgi new file mode 100644 index 0000000..2572e48 --- /dev/null +++ b/MOM_code/bin/mkmf.template.pgi @@ -0,0 +1,110 @@ +# template for the PGI compiler +# typical use with mkmf +# mkmf -t mkmf.template.pgi -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include +# next two definitions are site-dependent, set by environment +NETCDF_ROOT = $(NETCDF_DIR) +MPI_ROOT = $(MPICH_DIR) +VERBOSE = -v +INCLUDE = -I$(NETCDF_ROOT)/include +CPPFLAGS = # -Wp,-C,$(VERBOSE) +CFLAGS = $(INCLUDE) $(VERBOSE) +FFLAGS_OPT = -O2 -fast -Mcray=pointer +FFLAGS_DEBUG = -g -traceback $(VERBOSE) +# use that -D flag to detect if we can use 03 allocatable in fms_platform.h +FFLAGS = $(INCLUDE) -i4 -r8 -byteswapio -Ktrap=fp -Mallocatable=03 -D_F2000 $(FFLAGS_OPT) $(FFLAGS_DEBUG) +FC = ftn +CC = cc +#CFLAGS = -D__IFC +LD = $(FC) +#LDFLAGS = -byteswapio -lpathfortran -L$(NETCDF_ROOT)/lib -lnetcdf -L$(MPI_ROOT)/lib -lmpich +LDFLAGS = $(VERBOSE) -byteswapio -L$(NETCDF_ROOT)/lib -lnetcdf + +#--------------------------------------------------------------------------- +# you should never need to change any lines below. + +# see the MIPSPro F90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .opt create an optimization report +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source +# make .i create a preprocessed file (for .F) +# make .i90 create a preprocessed file (for .F90) + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh -f +TMPFILES = .*.m *.B *.L *.i *.i90 *.l *.s *.mod *.opt + +.SUFFIXES: .F .F90 .H .L .T .f .f90 .h .i .i90 .l .o .s .opt .x + +.f.L: + $(FC) $(FFLAGS) -c -listing $*.f +.f.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f +.f.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f +.f.T: + $(FC) $(FFLAGS) -c -cif $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -S $*.f +.f.x: + $(FC) $(FFLAGS) -o $*.x $*.f *.o $(LDFLAGS) +.f90.L: + $(FC) $(FFLAGS) -c -listing $*.f90 +.f90.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f90 +.f90.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f90 +.f90.T: + $(FC) $(FFLAGS) -c -cif $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -S $*.f90 +.f90.x: + $(FC) $(FFLAGS) -o $*.x $*.f90 *.o $(LDFLAGS) +.F.L: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -listing $*.F +.F.opt: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F +.F.l: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $(LIST) $*.F +.F.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -cif $*.F +.F.f: + $(FC) $(CPPDEFS) $(CPPFLAGS) -EP $*.F > $*.f +.F.i: + $(FC) $(CPPDEFS) $(CPPFLAGS) -P $*.F +.F.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -S $*.F +.F.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -o $*.x $*.F *.o $(LDFLAGS) +.F90.L: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -listing $*.F90 +.F90.opt: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F90 +.F90.l: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $(LIST) $*.F90 +.F90.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -cif $*.F90 +.F90.f90: + $(FC) $(CPPDEFS) $(CPPFLAGS) -EP $*.F90 > $*.f90 +.F90.i90: + $(FC) $(CPPDEFS) $(CPPFLAGS) -P $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -S $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -o $*.x $*.F90 *.o $(LDFLAGS) diff --git a/MOM_code/bin/mkmf.template.pscale b/MOM_code/bin/mkmf.template.pscale new file mode 100644 index 0000000..48c68f7 --- /dev/null +++ b/MOM_code/bin/mkmf.template.pscale @@ -0,0 +1,112 @@ +# template for the pathscale compiler +# typical use with mkmf +# mkmf -t mkmf.template.pscale -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include +# next two definitions are site-dependent, set by environment +NETCDF_ROOT = $(NETCDF_DIR) +MPI_ROOT = $(MPICH_DIR) +VERBOSE = -v +INCLUDE = -I$(NETCDF_ROOT)/include +CPPFLAGS = # -Wp,-C,$(VERBOSE) +CFLAGS = $(INCLUDE) $(VERBOSE) +FFLAGS_OPT = -O0 # -O2 -OPT:Ofast +FFLAGS_DEBUG = -g -trapuv $(VERBOSE) +FFLAGS = $(INCLUDE) -i4 -r8 -byteswapio -fno-second-underscore -OPT:IEEE_arith=2 $(FFLAGS_OPT) $(FFLAGS_DEBUG) +FC = ftn +CC = cc +#CFLAGS = -D__IFC + +# pathscale wants main program outside libraries, do +# setenv MAIN_PROGRAM coupler_main.o or something before make +LD = $(FC) $(MAIN_PROGRAM) +#LDFLAGS = -byteswapio -lpathfortran -L$(NETCDF_ROOT)/lib -lnetcdf -L$(MPI_ROOT)/lib -lmpich +LDFLAGS = $(VERBOSE) -byteswapio -L$(NETCDF_ROOT)/lib -lnetcdf + +#--------------------------------------------------------------------------- +# you should never need to change any lines below. + +# see the MIPSPro F90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .opt create an optimization report +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source +# make .i create a preprocessed file (for .F) +# make .i90 create a preprocessed file (for .F90) + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh -f +TMPFILES = .*.m *.B *.L *.i *.i90 *.l *.s *.mod *.opt + +.SUFFIXES: .F .F90 .H .L .T .f .f90 .h .i .i90 .l .o .s .opt .x + +.f.L: + $(FC) $(FFLAGS) -c -listing $*.f +.f.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f +.f.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f +.f.T: + $(FC) $(FFLAGS) -c -cif $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -S $*.f +.f.x: + $(FC) $(FFLAGS) -o $*.x $*.f *.o $(LDFLAGS) +.f90.L: + $(FC) $(FFLAGS) -c -listing $*.f90 +.f90.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f90 +.f90.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f90 +.f90.T: + $(FC) $(FFLAGS) -c -cif $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -S $*.f90 +.f90.x: + $(FC) $(FFLAGS) -o $*.x $*.f90 *.o $(LDFLAGS) +.F.L: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -listing $*.F +.F.opt: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F +.F.l: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $(LIST) $*.F +.F.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -cif $*.F +.F.f: + $(FC) $(CPPDEFS) $(CPPFLAGS) -EP $*.F > $*.f +.F.i: + $(FC) $(CPPDEFS) $(CPPFLAGS) -P $*.F +.F.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -S $*.F +.F.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -o $*.x $*.F *.o $(LDFLAGS) +.F90.L: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -listing $*.F90 +.F90.opt: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F90 +.F90.l: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $(LIST) $*.F90 +.F90.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -cif $*.F90 +.F90.f90: + $(FC) $(CPPDEFS) $(CPPFLAGS) -EP $*.F90 > $*.f90 +.F90.i90: + $(FC) $(CPPDEFS) $(CPPFLAGS) -P $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -S $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -o $*.x $*.F90 *.o $(LDFLAGS) diff --git a/MOM_code/bin/mkmf.template.sgi b/MOM_code/bin/mkmf.template.sgi new file mode 100644 index 0000000..e14a172 --- /dev/null +++ b/MOM_code/bin/mkmf.template.sgi @@ -0,0 +1,112 @@ +# Makefile template for SGI MIPSpro f90 + +FC = f90 +CPPFLAGS = -macro_expand +FFLAGS = -64 -mips4 -i4 -r8 -d8 -woff134,200,787,1670 -ansi -O2 -OPT:Olimit=0 #optimized +# FFLAGS = -64 -mips4 -i4 -r8 -d8 -woff134,200,787,1670 -ansi -DEBUG:conform_check=YES:subscript_check=ON:trap_uninitialized=ON:verbose_runtime=ON -g #for debugging +LIST = -listing + +#to debug shmem codes, you need the dbfork library +#TOTALVIEW = -L/opt/totalview/4.1.0-3/irix6-mips/lib -ldbfork_n64 +#TOTALVIEW = -ldbfork_n64 +#TOTALVIEW = -L/sw/mel/totalview/lib -ldbfork_n64 + +LD = f90 +# LDFLAGS = -64 -mips4 -v -show $(LIBS) # this is verbose +LDFLAGS = -64 -mips4 -dont_warn_unused $(LIBS) +#LIBS must be customized for your site +LIBS = $(TOTALVIEW) -L/usr/local/lib -lnetcdf -lmpi -lsma -lexc -lscs + +#--------------------------------------------------------------------------- +# you should never need to change any lines below. + +# see the MIPSPro F90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .T create a CIF file +# make .L create a compiler listing +# make .l create an assembler listing +# make .w2f create an flist listing +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source + +# make .i create a preprocessed file (only for .F and .F90 +# extensions) + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh +TMPFILES = .*.m *.B *.L *.i *.l *.s *.mod *.w2f + +.SUFFIXES: .F .F90 .H .L .T .f .f90 .h .i .l .o .s .w2f .x + +.f.L: + $(FC) $(FFLAGS) -c -listing $*.f +.f.w2f: + $(FC) $(FFLAGS) -c -FLIST:ftn_file=$*.w2f $*.f +.f.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f +.f.T: + $(FC) $(FFLAGS) -c -cif $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -S $*.f +.f.x: + $(FC) $(FFLAGS) -o $*.x $*.f *.o $(LDFLAGS) +.f90.L: + $(FC) $(FFLAGS) -c -listing $*.f90 +.f90.w2f: + $(FC) $(FFLAGS) -c -FLIST:ftn_file=$*.w2f $*.f90 +.f90.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f90 +.f90.T: + $(FC) $(FFLAGS) -c -cif $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -S $*.f90 +.f90.x: + $(FC) $(FFLAGS) -o $*.x $*.f90 *.o $(LDFLAGS) +.F.L: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -listing $*.F +.F.w2f: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -FLIST:ftn_file=$*.w2f $*.F +.F.l: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $(LIST) $*.F +.F.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -cif $*.F +.F.f: + $(CPP) $(CPPDEFS) $(CPPFLAGS) $*.F > $*.f +.F.i: + $(FC) $(CPPDEFS) $(CPPFLAGS) -P $*.F +.F.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -S $*.F +.F.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -o $*.x $*.F *.o $(LDFLAGS) +.F90.L: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -listing $*.F90 +.F90.w2f: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -FLIST:ftn_file=$*.w2f $*.F90 +.F90.l: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $(LIST) $*.F90 +.F90.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -cif $*.F90 +.F90.f90: + $(CPP) $(CPPDEFS) $(CPPFLAGS) $*.F90 > $*.f90 +.F90.i: + $(FC) $(CPPDEFS) $(CPPFLAGS) -P $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -S $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -o $*.x $*.F90 *.o $(LDFLAGS) diff --git a/MOM_code/bin/mkmf.template.t3e b/MOM_code/bin/mkmf.template.t3e new file mode 100644 index 0000000..8b9b8d9 --- /dev/null +++ b/MOM_code/bin/mkmf.template.t3e @@ -0,0 +1,79 @@ +# Makefile template for t3e + +FC = f90 +LD = f90 +CPPFLAGS = -F +FFLAGS = -dp -O2,unroll2 +LDFLAGS = -Wl"-Dpreset=nan;streams=on;permok=yes -Xm $(LIBS)" +LIST = -O negmsgs -rs + +# you should never need to change any lines below. + +# see the CF90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .T create a CIF file +# make .lst create a compiler listing +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source + +# make .i create a preprocessed file (only for .F and .F90 +# extensions) + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh +TMPFILES = .*.m *.T *.TT *.i *.lst *.s + +.SUFFIXES: .F .F90 .H .T .f .F90 .h .i .lst .o .s .x + +.f.T: + $(FC) $(FFLAGS) -c -Ca $*.f +.f.lst: + $(FC) $(FFLAGS) $(LIST) -c $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -eS $*.f +.f.x: + $(FC) $(FFLAGS) $(LDFLAGS) -o $*.x $*.f +.f90.T: + $(FC) $(FFLAGS) -c -Ca $*.f90 +.f90.lst: + $(FC) $(FFLAGS) $(LIST) -c $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -eS $*.f90 +.f90.x: + $(FC) $(FFLAGS) $(LDFLAGS) -o $*.x $*.f90 +.F.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -Ca $*.F +.F.i: + $(FC) $(CPPDEFS) $(CPPFLAGS) -eP $*.F +.F.lst: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) $(LIST) -c $*.F +.F.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -eS $*.F +.F.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) $(LDFLAGS) -o $*.x $*.F +.F90.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -Ca $*.F90 +.F90.i: + $(FC) $(CPPDEFS) $(CPPFLAGS) -eP $*.F90 +.F90.lst: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) $(LIST) -c $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -eS $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) $(LDFLAGS) -o $*.x $*.F90 diff --git a/MOM_code/bin/mkmf.template.t90 b/MOM_code/bin/mkmf.template.t90 new file mode 100644 index 0000000..5acf6a9 --- /dev/null +++ b/MOM_code/bin/mkmf.template.t90 @@ -0,0 +1,86 @@ +# Makefile template for t90 + +FC = f90 +LD = f90 +CPPFLAGS = -F +FFLAGS = -O2 +LDFLAGS = -Wl"-Dpreset=nan $(LIBS)" +LIST = -O negmsgs -rs + +# you should never need to change any lines below. + +# see the CF90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .T create a CIF file +# make .lst create a compiler listing +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source + +# make .i create a preprocessed file (only for .F and .F90 +# extensions) + +# make .hpm produce hpm output from .x +# make .proc produce procstat output from .x + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh +TMPFILES = .*.m *.T *.TT *.hpm *.i *.lst *.proc *.s + +.SUFFIXES: .F .F90 .H .T .f .F90 .h .hpm .i .lst .proc .o .s .x + +.f.T: + $(FC) $(FFLAGS) -c -Ca $*.f +.f.lst: + $(FC) $(FFLAGS) $(LIST) -c $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -eS $*.f +.f.x: + $(FC) $(FFLAGS) $(LDFLAGS) -o $*.x $*.f +.f90.T: + $(FC) $(FFLAGS) -c -Ca $*.f90 +.f90.lst: + $(FC) $(FFLAGS) $(LIST) -c $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -eS $*.f90 +.f90.x: + $(FC) $(FFLAGS) $(LDFLAGS) -o $*.x $*.f90 +.F.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -Ca $*.F +.F.i: + $(FC) $(CPPDEFS) $(CPPFLAGS) -eP $*.F +.F.lst: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) $(LIST) -c $*.F +.F.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -eS $*.F +.F.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) $(LDFLAGS) -o $*.x $*.F +.F90.T: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -Ca $*.F90 +.F90.i: + $(FC) $(CPPDEFS) $(CPPFLAGS) -eP $*.F90 +.F90.lst: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) $(LIST) -c $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) -c -eS $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FFLAGS) $(LDFLAGS) -o $*.x $*.F90 +.x.proc: + procstat -R $*.proc $*.x +.x.hpm: + hpm -r -o $*.hpm $*.x diff --git a/MOM_code/bin/mkmf.template.workstation.gfort b/MOM_code/bin/mkmf.template.workstation.gfort new file mode 100644 index 0000000..a8118c6 --- /dev/null +++ b/MOM_code/bin/mkmf.template.workstation.gfort @@ -0,0 +1,18 @@ +# template for the Gnu Fortran (gfortran) compiler version (GCC) 4.4.0 20090514 when using libMPI +# this template was tested with FRE on the workstation nnz on 10/06/2010 +# typical use with mkmf +# mkmf -t template.ifc -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include +# +#We need to locate the netcdf.mod that was compiled with gfort and pass it BEFORE any other location that might have a netcdf.mod +NETCDF_MOD_FILE_LOCATION = /home/nnz/local/include/gfort +MPICH_LOCATION = /net2/nnz/opt/mpich2-1.3_gfort44 +#MPICH_LOCATION = /usr/local/mpich +# +FFLAGS_BASE = -fcray-pointer -g -fdefault-real-8 -O2 -Waliasing -ffree-line-length-none -fno-range-check +FFLAGS = $(FFLAGS_BASE) +CPPFLAGS = -I/usr/include -I$(MPICH_LOCATION)/include -I$(NETCDF_MOD_FILE_LOCATION) -I/usr/local/netcdf4/include +FC = gfortran44 +LD = gfortran44 $(MAIN_PROGRAM) +LDFLAGS = -L/usr/local/netcdf4/lib -lnetcdf -L/usr/local/hdf5/lib -lhdf5_hl -lhdf5 -lz -L$(MPICH_LOCATION)/lib -lmpich -lpthread -lmpl +CFLAGS = -D__IFC + diff --git a/MOM_code/bin/mkmf.template.workstation.intel b/MOM_code/bin/mkmf.template.workstation.intel new file mode 100644 index 0000000..47bc3de --- /dev/null +++ b/MOM_code/bin/mkmf.template.workstation.intel @@ -0,0 +1,182 @@ +# template for the Intel fortran compiler +# typical use with mkmf +# mkmf -t template.ifc -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include +############ +# commands # +############ +FC = ifort +CC = icc +LD = ifort +######### +# flags # +######### +DEBUG = +REPRO = on +VERBOSE = +OPENMP = + +############################################## +# Need to use at least GNU Make version 3.81 # +############################################## +need := 3.81 +ok := $(filter $(need),$(firstword $(sort $(MAKE_VERSION) $(need)))) +ifneq ($(need),$(ok)) +$(error Need at least make version $(need). Load module gmake/3.81) +endif + +MAKEFLAGS += --jobs=2 + +NETCDF_ROOT = /home/nnz/local/build/netcdf-4.1.1_ifort11_HDF +MPICH_ROOT = /home/nnz/local/build/mpich2-1.3_ifort11 +#MPICH_ROOT = /usr/local/mpich +HDF5_ROOT = /home/nnz/local/build/hdf5-1.8.5-patch1_zlib-1.2.5_ifort11/lib +ZLIB_ROOT = /home/nnz/local/build/zlib-1.2.5 +INCLUDE = -I$(NETCDF_ROOT)/include -I$(MPICH_ROOT)/include + + +FPPFLAGS := -fpp -Wp,-w $(INCLUDE) + +FFLAGS := -fno-alias -automatic -safe-cray-ptr -ftz -assume byterecl -i4 -r8 -nowarn +FFLAGS_OPT = -O3 -debug minimal -fp-model precise -override-limits +FFLAGS_DEBUG = -g -O0 -check -check noarg_temp_created -check nopointer -warn -warn noerrors -fpe0 -traceback -ftrapuv +FFLAGS_REPRO = -O2 -debug minimal -no-vec -fp-model precise -override-limits +FFLAGS_OPENMP = -openmp +FFLAGS_VERBOSE = -v -V -what + + +CFLAGS := -D__IFC $(INCLUDE) +CFLAGS_OPT = -O2 -debug minimal -no-vec +CFLAGS_OPENMP = -openmp +CFLAGS_DEBUG = -O0 -g -ftrapuv -traceback + +LDFLAGS := +LDFLAGS_VERBOSE := -Wl,-V,--verbose,-cref,-M + +ifneq ($(REPRO),) +CFLAGS += $(CFLAGS_REPRO) +FFLAGS += $(FFLAGS_REPRO) +endif +ifneq ($(DEBUG),) +CFLAGS += $(CFLAGS_DEBUG) +FFLAGS += $(FFLAGS_DEBUG) +#else +#CFLAGS += $(CFLAGS_OPT) +#FFLAGS += $(FFLAGS_OPT) +endif + +ifneq ($(OPENMP),) +CFLAGS += $(CFLAGS_OPENMP) +FFLAGS += $(FFLAGS_OPENMP) +endif + +ifneq ($(VERBOSE),) +CFLAGS += $(CFLAGS_VERBOSE) +FFLAGS += $(FFLAGS_VERBOSE) +LDFLAGS += $(LDFLAGS_VERBOSE) +endif + +ifeq ($(NETCDF),3) + # add the use_LARGEFILE cppdef + ifneq ($(findstring -Duse_netCDF,$(CPPDEFS)),) + CPPDEFS += -Duse_LARGEFILE + endif +endif + +ifneq ($(findstring netcdf-4.0.1,$(LOADEDMODULES)),) + LIBS := -L$(NETCDF_ROOT)/lib -lnetcdf -L$(HDF5_ROOT)/lib -lhdf5_hl -lhdf5 -lcurl -L$(ZLIB_ROOT)/lib -lz +else + LIBS := -L$(NETCDF_ROOT)/lib -lnetcdf +endif + +LIBS += -L$(MPICH_ROOT)/lib -lmpich -lpthread -lmpl +LDFLAGS += $(LIBS) + +#--------------------------------------------------------------------------- +# you should never need to change any lines below. + +# see the MIPSPro F90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .opt create an optimization report +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source +# make .i create a preprocessed file (for .F) +# make .i90 create a preprocessed file (for .F90) + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +SHELL = /bin/csh -f +TMPFILES = .*.m *.B *.L *.i *.i90 *.l *.s *.mod *.opt + +.SUFFIXES: .F .F90 .H .L .T .f .f90 .h .i .i90 .l .o .s .opt .x + +.f.L: + $(FC) $(FFLAGS) -c -listing $*.f +.f.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f +.f.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f +.f.T: + $(FC) $(FFLAGS) -c -cif $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -S $*.f +.f.x: + $(FC) $(FFLAGS) -o $*.x $*.f *.o $(LDFLAGS) +.f90.L: + $(FC) $(FFLAGS) -c -listing $*.f90 +.f90.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f90 +.f90.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f90 +.f90.T: + $(FC) $(FFLAGS) -c -cif $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -S $*.f90 +.f90.x: + $(FC) $(FFLAGS) -o $*.x $*.f90 *.o $(LDFLAGS) +.F.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F +.F.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F +.F.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F +.F.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F +.F.f: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F > $*.f +.F.i: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F +.F.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F +.F.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F *.o $(LDFLAGS) +.F90.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F90 +.F90.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F90 +.F90.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F90 +.F90.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F90 +.F90.f90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F90 > $*.f90 +.F90.i90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F90 *.o $(LDFLAGS) diff --git a/MOM_code/bin/mppnccombine.gfdl_ws_64.intel b/MOM_code/bin/mppnccombine.gfdl_ws_64.intel new file mode 100755 index 0000000..c6388f0 Binary files /dev/null and b/MOM_code/bin/mppnccombine.gfdl_ws_64.intel differ diff --git a/MOM_code/bin/prepare_pubrel.csh b/MOM_code/bin/prepare_pubrel.csh new file mode 100755 index 0000000..73fadab --- /dev/null +++ b/MOM_code/bin/prepare_pubrel.csh @@ -0,0 +1,119 @@ +#!/bin/csh +# +#These are the notes on how to make the MOM4p1 public release. +#The notes are intended only for the GFDL people responsible for making the MOM4p1 public release. +# +set FMS_RELEASE=tikal +set MOM_RELEASE=tikal +set PUB_RELEASE=mom5_pubrel_December2013 +mkdir src +cd src + +#check outs +cvs co -r $MOM_RELEASE mom5 +cvs co -r $FMS_RELEASE shared ocean_shared +cvs co -r $FMS_RELEASE ice_sis ice_param +cvs co -r $FMS_RELEASE land_lad land_null land_param land_lad2 +cvs co -r $FMS_RELEASE atmos_param_am3 +cvs co -r $FMS_RELEASE atmos_bgrid atmos_coupled atmos_ebm atmos_fv_dynamics +cvs co -r $FMS_RELEASE atmos_null atmos_shared atmos_spectral +cvs co -r $FMS_RELEASE coupler + +cvs co -r $FMS_RELEASE postprocessing preprocessing tools + +#cut and nullify some stuff +\rm -rf atmos_param/qe_moist_convection atmos_param/two_stream_gray_rad atmos_param/shallow_physics +\rm -rf atmos_param/lin_cloud_microphys/* atmos_param/clubb/* +cvs co -r nullify_rab_nnz atmos_param/lin_cloud_microphys/lin_cloud_microphys.F90 atmos_param/clubb/CLUBB_driver_SCM.F90 atmos_param/clubb/MG_microp_3D.F90 + +#The following file is not needed +\rm -rf mom5/drivers/coupler_types.* + +\rm -rf tools/xmlDoc tools/fremetar tools/fbrowser + + +cvs up -r mom5_pubrel_dec2013_nnz mom5/doc +mv mom5/doc ../ + +#No pdf,ps,html +find . -name '*.pdf' -exec rm -f {} \; +find . -name '*.ps' -exec rm -f {} \; +find . -name '*.html' -exec rm -f {} \; + +#bin/ and exp/ + +cvs co -r mom5_pubrel_dec2013_nnz mom5/utils/ +mv mom5/utils/bin ../ +mv mom5/utils/exp ../ +\rm -rf mom5/utils + +#Date tag (sticky) the whole thing +#cvs tag $(PUB_RELEASE)_nnz * + +exit +#The following cleanups is done after tagging. +#No www.gfdl.noaa.gov +foreach file ( `grep -l -r noaa.gov .` ) +foreach? sed '/.*www.*.noaa.gov.*/d' -i $file +foreach? end + +#No work emails +foreach file ( `grep -l -r @noaa.gov .`) +foreach? sed 's/@noaa.gov/@no.gov/g' -i $file +foreach? end + +foreach file ( `grep -l -r @gfdl.noaa.gov .`) +foreach? sed 's/@gfdl.noaa.gov/@no.gov/g' -i $file +foreach? end + +foreach file ( `grep -l -r EMAIL .`) +sed 's/EMAIL=.*.gov/EMAIL="GFDL.Climate.Model.Info@noaa.gov/g' -i $file +end + +foreach file ( `grep -l -r @no.gov .` ) +foreach? sed 's/@.*no.gov//g' -i $file +foreach? end + +exit + +#update the htmls for some major files +#The following is too big to be included +cvs co -r xmlDoc_clean_sdu tools/xmlDoc + + +setenv XMLDOC_ROOT ${PWD}/tools/xmlDoc + +foreach file ( coupler shared/diag_manager shared/mpp shared/time_manager shared/data_override preprocessing shared/field_manager mom5 ) +${PWD}/tools/xmlDoc/bin/xmlDoc --dir $file +end + +#GNUize all F90 and c files +#Some files are checked in without write permission +#chmod -R +w . +#/home/nnz/bin/GNULicense.pl -f --dir=. --recursive +#This will touch ALL code, so you have to test, test, test! +# cvs ci or not ci , I wouldn't do it GNU!! + +# +#tar up +# +cd ../ + + +tar cvf $PUB_RELEASE.tar $PUB_RELEASE/src +tar rvf $PUB_RELEASE.tar $PUB_RELEASE/bin +tar rvf $PUB_RELEASE.tar $PUB_RELEASE/exp +gzip $PUB_RELEASE.tar + +#Documentation +#cvs co -r $MOM_RELEASE mom5/doc +#cd mom5/doc +##Work on the doc/README check it in and move it up +##Work on the doc/quickstart_guide.xml and MOM_practice.xml +##Generate the html and pdf from xml +#/home/nnz/bin/mkdocbk quickstart_guide.xml +#/home/nnz/bin/mkdocbk MOM_practice.xml +#Run Seth's tool to produce .html files for time_manager.html field_manager.html diag_manager.html mpp.html mpp_io.html coupler_main.html +#and move them in doc/ +#cvs ci README quickstart_guide.xml quickstart_guide.html MOM_practice.xml MOM_practice.html time_manager.html field_manager.html diag_manager.html mpp.html mpp_io.html coupler_main.html +#mv README ../ diff --git a/MOM_code/bin/time_stamp.csh b/MOM_code/bin/time_stamp.csh new file mode 100755 index 0000000..4843718 --- /dev/null +++ b/MOM_code/bin/time_stamp.csh @@ -0,0 +1,122 @@ +#!/bin/csh -f +unalias * + +set argv = (`getopt Hbehmsf:t: $*`) + +#----------------------------------------------------------------------- + + set sep = + set format = standard + + set rec = tail + set help = 0 + + set hours = 0 + set minutes = 0 + set seconds = 0 + +#----------------------------------------------------------------------- + +while ("$argv[1]" != "--") + switch ($argv[1]) + case -H: + set help = 1; breaksw + case -b: + set rec = 2; breaksw + case -e: + set rec = 1; breaksw + case -h: + set hours = 1; breaksw + case -m: + set hours = 1; set minutes = 1; breaksw + case -s: + set hours = 1; set minutes = 1; set seconds = 1; breaksw + case -f: + set format = $argv[2]; shift argv; breaksw + case -t: + set sep = $argv[2]; shift argv; breaksw + endsw + shift argv +end +shift argv + +# --- help output --- + + if ( $help ) then + cat << END + time_stamp.csh [ -behms -f format -t separator ] + + -H help (no execution) + -b beginning date + -e ending date (default) + -h hours + -m hours,minutes + -s hours,minutes,seconds + -f format=standard(default),european,digital + -t separator (default=blank) + +END + exit + endif + +# --- check format --- + + if ( $format != "standard" && \ + $format != "european" && $format != "digital" ) then + echo ERROR invalid format + exit (4) + endif + + set hsep = $sep + if ( $format == "standard" || $format == "european" ) set hsep = h + +#----------------------------------------------------------------------- + + if ( -e time_stamp.out ) then + set time_stamp = `tail -$rec time_stamp.out` + + set month_name = `echo $time_stamp[7] | tr "[A-Z]" "[a-z]"` + set month_num = `printf "%.2d" $time_stamp[2]` + +# ---- day can have more than 2 digits ---- + + set day_num = `printf "%.2d" $time_stamp[3]` + if ( $month_name == "day" && $format == "standard" ) \ + set day_num = `printf "%.4d" $time_stamp[3]` + +# ---- hours,min,sec can have only 2 digits ---- + + set hour_num = `printf "%.2d" $time_stamp[4]` + set min_num = `printf "%.2d" $time_stamp[5]` + set sec_num = `printf "%.2d" $time_stamp[6]` + +# ---- pad ISO years to 4 digits ---- + if ( $format == "digital" ) then + set year = `printf %.4d $time_stamp[1]` # will work even if year>9999 + endif + +# ---- create date label ---- + + set date_name + + if ( $format == "standard" ) then + if ( $month_name != "day" ) set date_name = $time_stamp[1] + set date_name = $date_name$month_name$day_num + else if ( $format == "european" ) then + set date_name = $day_num$month_name$time_stamp[1] + else if ( $format == "digital" ) then + set date_name = $year$sep$month_num$sep$day_num + endif + + if ( $hours ) set date_name = $date_name$hsep$hour_num + if ( $minutes ) set date_name = $date_name$sep$min_num + if ( $seconds ) set date_name = $date_name$sep$sec_num + + else +# --- dummy values --- + set month_name = "xxx" + set date_name = "no_time_stamp" + endif + + echo $date_name + diff --git a/MOM_code/build b/MOM_code/build new file mode 100755 index 0000000..bacc8b4 --- /dev/null +++ b/MOM_code/build @@ -0,0 +1,15 @@ +#!/bin/csh + + +# hack weil pkg-config nicht funktioniert, variable nicht gesetzt +# hier: netcdf-cxx4.pc netcdf-fortran.pc netcdf.pc +#setenv PKG_CONFIG_PATH '/sw/dataformats/netcdf/4.6.1/skl/intel.18.0.3/lib/pkgconfig' +#setenv PKG_CONFIG_PATH '/scratch/usr/mvkthne2/libs/netcdf/4.6.1/skl/intel.18.0.3/lib/pkgconfig' +# hier: ompi-c.pc ompi-cxx.pc ompi-f77.pc ompi-f90.pc ompi-fort.pc ompi.pc orte.pc +#setenv PKG_CONFIG_PATH ${PKG_CONFIG_PATH}:/sw/comm/openmpi/3.1.2/skl/intel/lib/pkgconfig + +cp ERGOM/pocNP_Kcdom/generic_ERGOM.F90 src/ocean_shared/generic_tracers/generic_ERGOM.F90 +cd exp/ +./MOM_compile.csh +cd ../.. + diff --git a/MOM_code/doc/web/config.json b/MOM_code/doc/web/config.json new file mode 100644 index 0000000..763ae1b --- /dev/null +++ b/MOM_code/doc/web/config.json @@ -0,0 +1,23 @@ +{ + "project_heading": "Modular Ocean Model (MOM)", + "project_title": "MOM", + "tags": [{"tag": "5.0.2", "commit": "8e524daedf27c1aaa35b4069efb38abc7575b4b5"}, + {"tag": "5.0.1", "commit": "2534bdc3b4bce6d08424174abda7b1ab6be0c29d"}, + {"tag": "5.0.1-beta0", "commit": "09cae4e1bd838efcb862d45bfc61ff074f849f9b"}, + {"tag": "5.0.0", "commit": "305729e4f67c239802d38eb2446c3cee8fc5276a"}, + {"tag": "5.0.0-beta0", "commit": "7ffd65ae4dd6a4a6c06ebff910326c1bc35c8f01"} + ], + "project_desc": "MOM is a numerical ocean model based on the hydrostatic primitive equations. MOM development is funded by NOAA and led by scientists at NOAA/GFDL in collaboration with scientists worldwide. Version 5 of MOM (MOM5) is an open source project released under the GPL license.", + "project_about": "The Modular Ocean Model (MOM) is a hydrostatic generalized level coordinate numerical ocean code with mass conserving non-Boussinesq or volume conserving Boussinesq kinematics. The model equations are discretized with generalized horizontal coordinates on the sphere using either an Arakawa B-grid or C-grid. MOM has a broad suite of physical parameterizations, diagnostic features, test cases, and documentation. It has been utilized for research and operations from the coasts to the globe. MOM is institutionally sanctioned by NOAA’s Geophysical Fluid Dynamics Laboratory (GFDL), where development is centered. Additional development and use occurs through hundreds of international scientists and engineers comprising the MOM community. MOM is free software distributed under GPLv2 and it is part of an open source community.", + "google_groups": "mom-users", + "docs": [{"file": "quickstart", "title": "Quickstart"}, + {"file": "user_guide", "title": "User Guide"}], + "pdfs": [{"file": "MOM5_elements", "title": "Elements of MOM 5"}, + {"file": "MOM4_guide", "title": "MOM 4 Technical Guide"}, + {"file": "testcase_atl_regional", "title": "Test Case: Atlantic"}, + {"file": "testcase_baltic", "title": "Test Case: Baltic"}, + {"file": "testcase_ICCM", "title": "Test Case: ICCM"}, + {"file": "testcase_ocean_cpld", "title": "Test Case: Coupled Ocean"}, + {"file": "testcase_ocean_solo", "title": "Test Case: Solo Ocean"} + ] +} diff --git a/MOM_code/doc/web/quickstart.md b/MOM_code/doc/web/quickstart.md new file mode 100644 index 0000000..3e95e72 --- /dev/null +++ b/MOM_code/doc/web/quickstart.md @@ -0,0 +1,97 @@ +# MOM Quickstart Guide + +Brief instructions for running MOM5 experiments + +Author: Niki Zadeh (Niki.Zadeh@@noaa.gov) + + +## Where to start? + +A good place to start is the online [User Guide](http://www.mom-ocean.org/web/docs/project/user_guide), which gives full details on all the steps involved in running a complete experiment. + +This document gives a short outline of how to get a very basic example experiment running. + +## How to get the source code and scripts + +You can access the source code by following these [download instructions](http://www.mom-ocean.org/web/downloads) + +In the sections below, `TEST_CASE` is a generic name referring to the name of a specific experiment you are working on. After you clone the repository from github you will have a directory called `mom/` in your working directory, which will be referred to as `$root_dir` in this guide. + +## How to compile and run the MOM tests + +MOM requires that NetCDF and MPI libraries be installed on users' platform. + +Ensure that you have the right environment variable for your platform in the file `bin/environs.PLATFORM_ID`. `PLATFORM_ID` could be any string that identifies your platform. The file `bin/environs.PLATFORM_ID` gets sourced at the beginning of all compile and run scripts and is there to make sure all compile and run time library paths are found. + +There are a few types of test models provided for this release all using the GFDL shared infrastructure (FMS) but have different FMS component models for atmosphere and/or land. +We refer to these types as `MODEL_TYPE` in this guide: + + +* `MOM_solo`: stand alone MOM ocean model. +* `MOM_SIS`: MOM coupled with GFDL ice model (SIS) besides null versions of atmosphere and land models. +* `EBM`: `MOM_SIS` coupled with `land_lad` and energy balanced atmosphere model +* `ICCM`: `MOM_SIS` coupled with `land_lad` and `bgrid` atmosphere model in low resolution setup. +* `CM2M`: GFDL CM2.1 model which is `MOM_SIS` coupled with `land_lad` and finite volume atmosphere model (with `am2` physics). +* `ESM2M`: GFDL Earth System Model which is `MOM_SIS` coupled with `land_lad2` and finite volume atmosphere model (with `am2` physics). + +### To compile the models: + +Find out what `MODEL_TYPE` you want to work on and what is `PLATFORM_ID` then + + $ cd $root_dir/exp + $ ./MOM_compile.csh --platform PLATFORM_ID --type MODEL_TYPE + +NOTE: The Energy Balanced Model (`EBM`) cannot be compiled by the above procedure and a separate compile script is provided for it. + +### To run an experiment + +Make sure you have a large enough working directory (`WORKDIR`) and made a symbolic link to it called `work` in your top directory, i.e., + + $ cd $root_dir + $ ln -s WORKDIR work + +Find out what test cases are available for a particular `MODEL_TYPE` + + $ cd $root_dir/exp + $ ./MOM_run.csh --platform PLATFORM_ID --type MODEL_TYPE -h + +To run a `TEST_CASE` + + $ ./MOM_run.csh --platform PLATFORM_ID --type MODEL_TYPE --experiment TEST_CASE + +If you do not have the right input data in the `WORKDIR` for the `TEST_CASE` the above command would ask you to download it and try again. You may need to specify the number of processor for the `TEST_CASE`, in that case the above command errors out with the right info. Note: The script `exp/preprocessing.csh` is called by the `MOM_run.csh` to modify the mom4p1 namelists of these old test cases to make them compatible with MOM5. The results go into `WORKDIR`. + +### Notes + +* The scripts have been tested fully only with Intel Fortran and PGI compilers on ia64 platform. They are partially tested with pathscale compiler on x86\_64 and also gfortran4.3 compiler on Core2Duo processor. +* Some of these test cases require a large disk space to save the input data. Choose a partition with enough space (1-2 G) to untar the code and data bundels. +* IBM platform users might want to add the following line to the top of the run scripts + + + setenv LDR_CNTRL MAXDATA=0xD0000000@DSA + + +* The compile script provides the basic capability with dynamic memory allocation. To use static memory allocation which might be faster on some platforms you need to adjust the values of domain bounds properly according to the number of processors and layout. +* The compile script use netcdf3 by default. If you want to use netcdf4 libraries instead you can do so by deleting the `-Duse_netCDF3` from the CPPs in compile script and then recompile. + +## How to prepare input data + +The input data needed to run the selected experiments (tests) that are included in this release are available in the `data/` directory. + +Note that data in `ASCII/`, `HISTORY/`, `RESTART/` directories are NOT needed for running experiments. They are the outputs of the experiments and are provided for the purpose of comparing your results with results produced at GFDL. Tools are provided so that users can create data from scratch for their own experiments. For more details refer to `src/preprocessing`. + + +## Examine the output + +To keep the runscript simple all output files of a model run will be in the work directory. There are three types of output files: + +* ascii file with `.fms.out` extension: the description of the setup of the run and verbose comments printed out during the run. +* restart files in `RESTART` directory: the model fields necessary to initialize future runs of the model. +* history files with `.nc.tar` extension: output of the model, both averaged over specified time intervals and snapshots. + +The ascii file contains everything written to the screen during model execution. The total time for model execution as well as the times of separate modules are reported here. All `.tar` files should be decompressed for viewing. The decompress command is: + + tar -xvf filename.tar + +Users will see result files in NetCDF format. Postprocessing tools such as Ferret, ncview, grads or matlab can be used to view data in these files. +The outputs of the selected experiments are available in the `data/` directory for the purpose of comparing your results with results produced at GFDL. diff --git a/MOM_code/doc/web/user_guide.md b/MOM_code/doc/web/user_guide.md new file mode 100644 index 0000000..d96e0a1 --- /dev/null +++ b/MOM_code/doc/web/user_guide.md @@ -0,0 +1,596 @@ +# The MOM User Guide + +Authors: + +* Stephen Griffies - Stephen.Griffies@noaa.gov +* Niki Zadeh - Niki.Zadeh@noaa.gov + +## Introduction + +The purpose of this section is to provide an overview of MOM and the contents of this web page. + +### What is MOM? + +The Modular Ocean Model (MOM) is a numerical representation of the ocean's hydrostatic primitive equations. It is designed primarily as a tool for studying the global ocean climate system, as well as capabilities for regional and coastal applications. The latest release of MOM occurred in 2012, and is named MOM5. This code has origins that date back to the pioneering work of Kirk Bryan and Mike Cox in the 1960s-1980s. It is developed and supported by researchers at NOAA's [Geophysical Fluid Dynamics Laboratory](http://gfdl.noaa.gov/) (GFDL), with critical contributions also provided by researchers worldwide who comprise the MOM community. The purpose of this web guide is to provide general information about MOM, and particular information for how to download and run the code. Here is a table summarizing the algorithmic history of MOM. + +### MOM Releases + +MOM has had the following releases (note that MOM4p1 releases are distinguished by release dates). + +* MOM4p0a: January 2004 +* MOM4p0b: March 2004 +* MOM4p0c: August 2004 +* MOM4p0d: May 2005 +* MOM4p1: 28 September 2007 +* MOM4p1: 28 December 2007 +* MOM4p1: Dec 2009 +* MOM5: 2012 + +For each release, we aim to update MOM by enhancing features and documentation, and correcting bugs. Each version is generally compatible with the previous versions. However, as updates are made, we cannot guarantee that all features will bitwise agree across releases. Nonetheless, we do maintain a small selection of "bitwise-legacy" code to allow for certain modules to bitwise agreement across versions. As the maintenance of bitwise-legacy features represents an onerous task (e.g., bits change when A+B is altered to B+A), we recommend that researchers beginning new projects start with the most recent version, and that researchers with mature projects carefully test the new code prior to moving forward. + +### MOM email list + +Email concerning MOM should be directed to the [MOM mailing list](https://groups.google.com/forum/#!forum/mom-users). All questions, comments, and suggestions are to be referred to this list. + +### The MOM community + +There is a sizable user community for MOM. This community has proven to be a great resource, especially for new users, and those with portability questions, some of which are beyond the abilities of GFDL scientists to answer. + +### Efficiency and Portability + +The MOM team aims to provide code that is efficient, flexible, and transparent for use across a broad range of computer platforms. Balancing these aims is not always simple. For example, some of the most efficient code is also the least transparent. The MOM developers are scientists whose main concern is to support MOM as a tool for science research. This focus then leads us to weight transparency and portability over efficiency. However, we readily make efficiency modifications that are of a general nature, so please do feel free to volunteer any such changes. + +Given the above aims, we have continued to support one avenue for code efficiency involving the allocation of arrays. MOM can be compiled in two ways: with static allocation of arrays or dynamic allocation. Static allocation is enabled at compile time via the cpp-preprocessor option `MOM_STATIC_ARRAYS`. At GFDL, we have generally found that static allocation executables are faster than dynamic, since compilers like to know before-hand the size of the model arrays. Work on the SGI machines at GFDL has reduced the difference in efficiency between these two compilations. However, details of the model configuration strongly impact the differences in model speed. Additionally, we understand that on some platforms, the dynamic allocation results in faster code than static. Consequently, we have decided to maintain both the static and dynamic options, given the ambiguous results across platforms, compilers, model configurations, etc. + +## An Outline of MOM + +The purpose of this section is to outline certain features of MOM. + +### Documentation + +In addition to this online user guide, documentation for MOM is provided by the following LaTeX generated PDF documents: + +* [A Technical Guide to MOM4](http://www.mom-ocean.org/web/docs/project/MOM4_guide.pdf) by Stephen.Griffies@noaa.gov, Matthew.Harrison@noaa.gov, Ronald.Pacanowski@noaa.gov, and Tony.Rosati@noaa.gov. This is the primary reference for MOM4p0. It contains details about some of the numerical algorithms and diagnostics. Reference to MOM4p0 in the literature should refer to this document: + + + A Technical Guide to MOM4 + GFDL Ocean Group Technical Report No. 5 + S.M. Griffies, M.J. Harrison, R.C. Pacanowski, and A. Rosati + NOAA/Geophysical Fluid Dynamics Laboratory + August 2004 + Available on-line at http://www.mom-ocean.org/web/docs + + +* [Elements of MOM](http://www.mom-ocean.org/web/docs/project/MOM5_elements.pdf) by Stephen.Griffies@noaa.gov is the primary reference for MOM4p1 and MOM5. It contains details about some of the numerical algorithms and diagnostics. Reference to MOM in the literature should refer to this document: + + + Elements of the Modular Ocean Model (MOM) + GFDL Ocean Group Technical Report No. 7 + Stephen M. Griffies + NOAA/Geophysical Fluid Dynamics Laboratory + June 2012 + 620 + xiii pages + Available on-line at http://www.mom-ocean.org/web/docs + + +A theoretical rationalization of ocean climate models is provided by [Fundamentals of Ocean Climate Models](http://www.amazon.com/Fundamentals-Climate-Models-Stephen-Griffies/dp/0691118922). This book by Stephen.Griffies@noaa.gov was published by Princeton University Press in August 2004. + +### Embedded Documentation + +The documentation of most Fortran modules in FMS is inserted right in the source code to enable consistency between the code and documentation. A Perl software tool is used to extract documentation from the source code to create a corresponding html module. For example, documentation for `shared/diag_manager/diag_manager.F90 module` is `shared/diag_manager/diag_manager.html`. In general, the embedded documentation is a good starting point to understand the Fortran module, though ultimately the Fortran code is the final source for information. + +### MOM5 Characteristics + +Although MOM5 shares much in common with earlier versions of MOM, it possesses a number of computational, numerical, and physical characteristics that are noteworthy. The main characteristics of MOM5 can be found in the introduction to [Elements of MOM](http://www.mom-ocean.org/web/docs/project/MOM5_elements.pdf). + +### MOM and FMS + +MOM has been coded within GFDL's [Flexible Modeling System](http://gfdl.noaa.gov/fms) (FMS). Doing so allows for MOM developers to use numerous FMS infrastructure and superstructure modules that are shared amongst various atmospheric, ocean, sea ice, land, vegetative, etc. models. Common standards and shared software tools facilitate the development of high-end earth system models, which necessarily involves a wide variety of researchers working on different computational platforms. Such standards also foster efficient input from computational scientists and engineers as they can more readily focus on common computational issues. + +The following list represents a sample of the FMS shared modules used by MOM. + +* time manager: keeps model time and sets time dependent flags +* coupler: used to couple MOM to other component models +* I/O: to read and write data in either NetCDF, ASCII, or native formats +* parallelization tools: for passing messages across parallel processors +* diagnostic manager: to register and send fields to be written to a file for later analysis +* field manager: for integrating multiple tracers and organizing their names, boundary conditions, and advection schemes + +The FMS infrastructure (the "Siena" version) forms the basis for the 2012 release of MOM. + +The Flexible Modeling System (FMS), including MOM, is free software; you can redistribute it and/or modify it and are expected to follow the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. + +FMS is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along with MOM; if not, write to: + + Free Software Foundation, Inc. + 59 Temple Place, Suite 330 + Boston, MA 02111-1307 + USA + +### MOM test cases + +MOM is distributed with a suite of test cases, with these tests detailed in [Elements of MOM](http://www.mom-ocean.org/web/docs/project/MOM5_elements.pdf). + +Many of the test cases are NOT sanctioned for their physical relevance. They are instead provided for the user to learn how to run MOM, and to verify the numerical and/or computational integrity of the code. PLEASE do not assume that the experiments will run for more than the short time selected in the sample runscripts. + +## Contributing to MOM + +MOM developers aim to provide the international climate research community with a repository for robust and well documented methods to simulate the ocean climate system. Consequently, we encourage interested researchers to contribute to MOM by commenting on code features, and providing new modules that enhance simulation integrity (e.g., a new physical parameterization or new advection scheme) or increase the model's functionality. + +The [Model Development Lab](http://www.mom-ocean.org) (MDL) provides infrastructure to facilitate contributions from the MOM community. + +## Source code and data sets + +The purpose of this section is to outline methods required to obtain the source code and associated datasets. + +### Obtaining source code and data sets + +The source code and test case data sets for MOM are hosted on [github](https://github.com/BreakawayLabs/mom). Follow [these instructions](http://www.mom-ocean.org/web/downloads) to download the code and (optionally) the test case data sets. + +### Description of the data sets + +There are many datasets provided with the various MOM test cases. All datasets released with MOM are in [NetCDF](http://www.unidata.ucar.edu/software/netcdf/) format, since this format is widely used in the community. A number of useful tools are available as part of the [NCO](http://nco.sourceforge.net/) suite that allow the user to perform some necessary operations (editting attributes, merging, etc.) on a NetCDF file. + +## Setting up an experiment with MOM + +MOM is distributed with code used to generate model grids, initial conditions, and boundary conditions. Each step must be performed prior to running the ocean model. The steps used during this experimental setup stage are generally termed "preprocessing", and the code used for these purposes is under the `preprocessing/` directory in the MOM distribution. The purpose of this section of the User Guide is to outline this code and its usage. Further details of usage and algorithms can be found in the internal documentation within the various preprocessing code modules. + +### General comments + +We start this section with some general comments regarding the setup of a model experiment. + +* Setting up an experiment is critical part to the success of a research or development project with MOM. It is important that the user take some time to understand each of the many steps, and scrutinize the output from this code. We have endeavored over the years to provide tools facilitating the ready setup of a new experiment. However, we remain unable to provide code that does everything possible under the sun. Additionally, all features that are provided here may not be fully tested. For these reasons, the preprocessing code continues to evolve as use and functionality evolve. We sincerely appreciate ALL comments about code and documentation, especially comments regarding clarity, completeness, and correctness. Your input is essential for the improvement of the code and documentation. + +* Many steps in idealized experiments that were formerly performed while running earlier MOM versions have been extracted from MOM and placed into preprocessing. Hence, even if you are running an idealized experiment, it is likely that you will need to perform some if not all of the preprocessing steps discussed here. + +* If you have a problem that is not addressed here, then please feel free to query the [MOM mailing list](https://groups.google.com/forum/#!forum/mom-users). No question is too silly, so please ask! + +* All code used to setup an experiment with MOM is written in Fortran 90/95 except `make_xgrids`, which is written in C. Most code is dependent on FMS shared code for the purpose of parallization and interpolation. In addition to the documentation provided here, there are comments within the code to help users debug and to make modifications to suit their purpose. + +* Some users make nontrivial changes of general use. With your support, assistance, and maintenance, we will endeavour to include your changes in future releases. + +### Creation of the ocean/ice grid (mosaics) + +Mosaics is the name given to a general framework to define structured grids at GFDL. The details of this scheme are being incorporated by others outside of GFDL as well. Most of the recent global models developed at GFDL employ the conventions of Mosaic. However, MOM is backwards compatible, so that it still supports grids generated with older software. + +### Creation of the ocean/ice grid (pre-mosaics) + +Within GFDL FMS, ocean and ice are assumed to share the same grid. This means that the two models read in the same grid specification file. Even so, the domain decomposition on parallel systems may be different, and indeed they generally are due to different load balance issues between the two models. + +Even though the ocean and ice models read the same grid specification file, they use the information from the grid file in a slightly different manner when setting up the respective model's tracer grid. In particular, the ocean model reads the tracer location directly from the arrays (`x_T/geolon_t`, `y_T/geolat_t`) written in the grid specification file. In contrast, the GFDL ice model reads (`x_vert_T/geolon_vert_t`, `y_vert_T/geolat_vert_t`) from the grid specification file and then averages these four vertex locations to get the tracer location used in the ice model. The result is that diagnostics output from the two models have ocean and ice fields at slightly different locations for cases such as the tripolar grid when the grid is not spherical. + +The ocean/ice grid specification file is generated by executing the `ocean_grid_generator` utility. The `ocean_grid_generator` utility generates the horizontal grid, vertical grid, and topography. A C-shell script is provided to compile relevant code to generate and run the executable to produce the grid file. To create the desired grid and topography, setting namelist options within the runscript is needed. + +The horizontal grid can be conventional lon-lat spherical grid or a reprojected rotated tripolar grid (R. Murray, [Explicit generation of orthogonal grids for ocean models](http://www.sciencedirect.com/science/article/pii/S0021999196901369), 1996, J.Comp.Phys., v. 126, p. 251-273.). The choice is controlled by the namelist option `tripolar grid` (true for tripolar grid and false for lon-lat spherical grid). Note that Cartesian beta-plane and f-plane geometries are set up within MOM, not within the grid generation preprocessing steps discussed here (see `ocean_core/ocean_grids.F90` for beta-plane and f-plane namelist options). + +The `grid_spec` file contains the following horizontal grid information: geographic location of T, E, C and N-cell (Tracer, East, Corner, and North cells), half and full cell lengths (in meters), rotation information between logical (i.e., grid oriented) and geographic east of cell. The complete description of the horizontal grid and namelist option is available in hgrid + +The vertical grid information includes depth of tracer points and tracer boundaries. The complete description of namelist option is available in vgrid + +The topography can be idealized (various examples are provided and others can be easily added through emulating those provided) or remapped from a source topography dataset. The type of topography is specified by the namelist variable `topography`. Namelist `topog_depend_on_vgrid` specifies if the topography will depend on the vertical grid or not. To generate a grid for MOM, `topog_depend_on_vgrid` should always be true. A useful option for those upgrading older models to MOM is `adjust_topo`. If this option is set to false, there will be no adjustments made to the topography. See topog for further details about topography namelist options. + +### The exchange grid for coupled models + +"Exchange grid" information is required for coupled models (i.e., ocean/ice coupled to land and/or atmosphere) that employ the GFDL coupler technology. The exchange grid is defined by taking the union of the ocean/ice grid with the atmosphere and land grids. This union is then used to compute area integrals to allow for conservative mapping of fluxes between the component models. + +### The Sutherland-Hodgman polygon clipping algorithm for model cell interaction calculation + +The exchange grid information is generated by executing the `make_xgrids` utility. The execution of the `make_xgrids` utility will generate a netcdf file with the name `grid_spec.nc`. The `grid_spec.nc` contains the component model grids as well as the exchange grid information. In particular, the utility `make_xgrids` generates two exchange grids used by the FMS coupler: one grid for surface fluxes and another for runoff. `make_xgrids` is created by compiling its C source: + + cc -O -o make_xgrids make_xgrids.c -I/usr/local/include -L/usr/local/lib -lnetcdf -lm + +creates the `make_xgrids` executable from C source and the netCDF and standard math libraries. It is executed with the command + + make_xgrids -o ocean_grid.nc -a atmos_grid.nc -l land_grid.nc + +This execution produces a `grid_spec.nc` file (input files containing grid information for the ocean/sea-ice, atmosphere and land component models are indicated by the `-o`, `-a` and `-l` flags, respectively). The grid files `ocean_grid.nc`, `atmosphere_grid.nc`, and `land_grid.nc` all can be generated separately through the `ocean_grid_generator` utility. Normally at GFDL we select the same atmosphere and land model grid, but such is not necessary. When the land and atmosphere grids are the same, then we can reduce the execute command to + + make_xgrids -o ocean_grid.nc -a atmos_grid.nc + +If you further decide to choose same ocean, atmosphere and land grid, the execute command will be + + make_xgrids -o ocean_grid.nc -a ocean_grid.nc + +`make_xgrids` expects a netCDF format input specification for each of the component model grid files. For the ice/ocean grid (`ocean_grid.nc`), the following three fields are required: + +* `wet` - a 2D array of double precision numbers set to 1.0 where the ice and ocean models are active and 0.0 elsewhere. `wet` has `im` indices in the `i`-direction (pseudo east-west) and `jm` indices in the `j`-direction (pseudo north-south). These correspond to the size of the global arrays of temperature, salinity and ice thickness in the coupled climate model. +* `x_vert_T` and `y_vert_T` - 3D double precision arrays (dimensioned `im * jm * 4`) that contain the longitudes and latitudes (respectively) of the four corners of T- cells. The numbers are in degrees. + +For the netCDF format input specification for the atmosphere and land grid (`atmos_grid.nc` and/or `land_grid.nc`), `x_vert_T` and `y_vert_T` are required. + +`make_xgrids` copies all fields of the ice/ocean grid specification file to its output file, `grid_spec.nc`, and then appends fields that specify the atmosphere and land model grids and then the surface and runoff exchange grids. + +Using the Sutherland-Hodgman polygon clipping algorithm (reference in next paragraph) for model cell interaction calculation, `make_xgrids` takes care that the land and ocean grids perfectly tile the sphere. The land model's domain is defined as that part of the sphere not covered by ocean (where `wet=0` on the ocean grid). To accomplish this, the land cells must be modified to remove the ocean parts. This is done in `make_xgrids` by first taking the intersections of atmosphere and land cells. The overlap area between these cells and active ocean cells are then subtracted. Finally, the modified atmosphere/land intersections are aggregated into land cell areas and atmosphere/land exchange cell areas. + +Model cell intersections are calculated using the Sutherland-Hodgman polygon clipping algorithm (Sutherland, I. E. and G. W. Hodgman, 1974: [Reentrant polygon clipping](http://dl.acm.org/citation.cfm?id=360767.360802), CACM, 17(1), 32-42.). This algorithm finds the intersection of a convex and arbitrary polygon by successively removing the portion of the latter that is "outside" each boundary of the former. It can be found in many computer graphics text books (e.g., Foley, J. D., A. van Dam, S. K. Feiner, and J. F. Hughes, 1990: [Computer graphics: principles and practice](http://books.google.com.au/books/about/Computer_Graphics.html?id=-4ngT05gmAQC&redir_esc=y), second edition. Addison Wesley, 1174 pp.). The implementation in `make_xgrids` is particularly simple because the clipping polygon is always a rectangle in longitude/latitude space. For the purpose of finding the line intersections in the clipping operations, the cell boundaries are assumed to be straight lines in longitude/latitude space. This treatment is only perfectly accurate for cells bounded by lines of longitude and latitude. + +Spherical areas are calculated by taking the integral of the negative sine of latitude around the boundary of a polygon (Jones, P. W., 1999: [First- and second-order conservative remapping schemes for grids in spherical coordinates](http://journals.ametsoc.org/doi/pdf/10.1175/1520-0493(1999)127%3C2204%3AFASOCR%3E2.0.CO%3B2). Monthly Weather Review, 127, 2204-2210.). The integration pathways are again straight lines in longitude/latitude space. `make_xgrids` checks that the sphere and the individual cells of the atmosphere and ocean grids are tiled by the surface exchange cells. The fractional tiling errors are reported. + +### Initial and Boundary Conditions + +After generating the model grid, it is time to generate the initial and boundary conditions (ICs and BCs). These conditions are specific to the details of the model grid, so it is necessary to have the grid specificiation file in hand before moving to the IC and BC generation. + +There are two options for ICs and BCs. + +* Idealized Conditions. These conditions are based on subroutines that design idealized setups for either initial conditions (e.g., exponential temperature profile) or boundary conditions (e.g., cosine zonal wind stress). Code for these purposes is found in the `src/preprocessing/mom4_prep/idealized_ic` and `src/preprocessing/mom4_prep/idealized_bc` directories in the MOM distribution. Details of available namelist choices are in the documentation file `idealized_ic.html` as well as the comments within the source code itself. Users can readily incorporate their favorite idealized IC or BC into the MOM idealized preprocessing step by emulating the code provided. +* Realistic Conditions. These ICs and BCs generally result from a regridding routine to bring, say, the Levitus analysis onto the model grid for initializing a model, or for mapping surface fluxes onto the grid for boundary conditions. Code enabling the regridding functions is found in the `preprocessing/regrid_2d`, `preprocessing/regrid_3d` and `preprocessing/regrid` directories in the MOM distribution. + +In the remainder of this section, we detail code to generate the ICs and BCs of use for MOM. + +### 2d Regridding: the common approach + +It is typical for air-sea fluxes of momentum, heat, and mosture to live on a grid distinct from the ocean model grid. In particular, most analysis are placed on a spherical latitude-longitude grid, whereas most global ocean models configured from MOM are run with tripolar grids. + +When running an ocean or ocean-ice model, it is useful to map the boundary fluxes onto the ocean model grid prior to the experiment. This preprocessing step saves computational time that would otherwise be needed if the fluxes were mapped each time step of a running experiment. To enable this regridding, one should access code in the `preprocessing/regrid_2d` directory. The original data must be on a latitude-longitude grid to use `regrid_2d`. The target/destination grid can be either latitude-longitude with arbitrary resolution, or tripolar with arbitrary resolution. + +### 2d Regridding: the less common approach + +In some cases, one may wish to take a set of forcing fields from one tripolar MOM experiment and regrid them onto another tripolar MOM experiment with different grid resolution. In this case, it is necessary to regrid before running the experiment. + +As of the MOM4p0d distribution, there is a regridding tool within the `preprocessing/regrid` directory that enables one to regrid fields on one tripolar grid to another tripolar grid. Indeed, one can regrid source data from any logically rectangular grid (e.g., latitude-longitude grid or tripolar grid) to a target/destination grid that is any logically rectangular grid. + +Note that this is new code, and so has been tested only for particular cases. So the user should be extra careful to scrutinize the results. + +### Setting the `on_grid` logical in the `data_table` + +The `on_grid` logical in the `data_table` indicates whether an input file is on the grid of the model or not. + +`on_grid=.true.` means that the input file is on the same grid as the ocean model. This is the recommended setting for models running with specified atmospheric forcing from data or an analysis product. + +`on_grid=.false.` means the input file has data on a grid differing from the ocean model. This feature is allowed ONLY if the input data lives on a spherical grid. This is a relevant setting if one wishes to keep the input data on their native spherical grid. If the input data is non-spherical, then `on_grid=.false.` is NOT supported. Instead, it is necessary to preprocess the data onto the ocean model grid. + +### Regridding river runoff data + +The tool `preprocessing/runoff_regrid` is of use to grid river runoff data onto the ocean model grid. In this case, runoff is moved to a nearest ocean/land boundary point on the new grid. Note that the source runoff dataset must be on a spherical latitude-longitude grid, whereas the target/destination grid can be spherical or tripolar. The regridding algorithm is conservative. + +The conservative regridding scheme used in `runoff_regrid` is an area average scheme, which is similiar to the algorithm used in coupler flux exchange. If any land point has runoff data, after remapping runoff data onto destination grid, the runoff value of that land point will be moved to the nearest ocean point. Before using this tool, you must use `make_xgrids` to generate exchange grid information between the source grid and destination grid. The complete description can be found in `runoff_regrid.html`. + +### Two ways to specify surface boundary fluxes + +There are two ways to specify surface boundary fluxes when using the coupler feature of FMS. One is through flux exchange, and this employs a conservative algorithm as appropriate for running a coupled ocean-atmosphere model. It is assumed that the atmospheric model grid is spherical with arbitrary resolution. The other method is through data override, and this uses a non-conservative scheme. Data override is of use to selectively remove, say, one of the fluxes coming from an atmospheric model and replace this flux with that from data. GFDL modelers have found this feature to be very useful in diagnosing problems with a coupled model. + +### 3d Regridding for initial conditions or sponges + +When generating realistic initial conditions for an ocean experiment, one generally requires the gridding of temperature and salinity, such as from the Levitus analysis product, onto the model's grid. For this purpose, we are in need of vertical grid information in addition to horizontal 2d information required for the surface boundary conditions. Hence, we use the `preprocessing/regrid_3d`. A similar procedure is required to develop sponge data. + +The original data must be on a spherical grid in order to use `regrid_3d`. If the original data is on a tripolar grid, we should use `preprocessing/regrid`, which can map data from any logical rectangular grid onto any logical rectangular grid. + +### Comments on the regridding algorithms + +For `preprocessing/regrid_3d`, `preprocessing/regrid_2d` and `preprocessing/regrid`, regridding is accomplished non-conservatively using a nearest neighbor distance weighting algorithm, or bilinear interpolation. The interpolation algorithm is controlled through the namelist option `interp_method`. + +Bilinear interpolation is recommanded for most cases since it provides a smooth interpolation when regridding from coarse grid to fine grid (the usual situation with model destination grids typically having resolution more refined than source data products), and it is more efficient. Efficiency can become a particularly important issue when developing initial and boundary conditions for a refined resolution model. + +If the original data is on a tripolar grid, nearest neighbor distance weighting interpolation found in `preprocessing/regrid` must be used, since bilinear interpolation assumes the original data is on a latitude-longitude grid. For `preprocessing/regrid_2d`, `preprocessing/regrid_3d` and `preprocessing/regrid` using the nearest neighbor distance weighting algorithm, a maximum distance (in radians) can be selected using the namelist value `max_dist`. Namelist option `num_nbrs` can be adjusted for speed, although for most applications this refinement is not necessary. + +The complete namelist description for these algorithms can be found in `regrid_2d.html`, `regrid_3d.html` and `regrid.html`. + +### Acceptable data formats + +When the input data is on a latitude-longitude grid, `preprocessing/regrid_2d` and `preprocessing/regrid_3d` can be used. + +When the input data is on a tripolar grid or a latitude-longitude grid, `postprocessing/regrid` can be used. + +For sponge generation, acceptable input data sets must have NetCDF format with [COARDS](http://ferret.wrc.noaa.gov/noaa_coop/coop_cdf_profile.html)-compliance. + +### Time-related issues in forcing files + +There are many ways that data can be formatted in time. The FMS tools used to read in time information, and to time interpolate, are quite sophisticated and flexible. Nonetheless, these tools cannot do everything, nor can they know a priori what the modeler intends. It is therefore necessary to maintain certain conventions when preparing the time information for datasets. This section aims to outline some of the common issues involved with time, and to provide a guide for resolving possible problems. + +### How it works and what to do if it fails + +Previous versions of MOM used IEEE binary formats and MOM-specific headers to process forcing data. As of MOM4, data are stored in portable formats (NetCDF currently), and contain standardized metadata per the CF1.0 convention. Understading the functions of Fortran modules that handle metadata and time-related problems will be very helpful in identifying some user's problems. Some of the most frequently used modules are listed below: + +* `mpp_io_mod`: Low level I/O (open, close file, write, read,...) +* `axis_utils_mod`: process metadata: identify cartesian axis information (X/Y/Z/T) +* `time_manager_mod`: basic time operations, calendar, increment/decrement time +* `time_interp_mod`: Computes a weight for linearly interpolating between two dates +* `time_interp_external_mod`: top level routines for requesting data +* `data_override_mod`: top level routines for requesting data + +### Test your forcing files before use + +It is likely that you will encounter an error using "off-the-shelf" NetCDF files to force your ocean model. This could be due to inadequate metadata in the forcing files, mis-specification of the DataTable, or errors in the parsing of the axis information by `axis_utils` or `get_cal_time`. You'll need some tools to help you diagnose problems and apply the required fix. + +The first thing you should do to setup a new forcing file is use the test program: `time_interp_external_mod:test_time_interp_external`. This test program calls `time_interp_external` at user-specified model times and returns information on how the times were decoded and the resulting interpolation indices and weights. It is STRONGLY suggested that you pass your forcing files through this program before including them in your model configuration. As you gain familiarity with the metadata requirements, you will more easily be able to identify errors and save a lot of time debugging. + +The forcing test program is located in `src/preprocessing/test_time_interp_ext`. There is a csh version and a Perl version. Compilation + + mkmf -m Makefile -p test_time_interp_ext.exe -t $TEMPLATE -c -Dtest_time_interp_external -x shared/{time_manager,fms,mpp,clocks,time_interp,axis_utils,platform,horiz_interp,constants,memutils} + +running csh version + +namelist options: + + filename='foo.nc' ! name of forcing file + fieldname='foo' ! name of variable in file + year0=[integer] ! initial year to start model calendar + month0=[integer] ! initial month to start model calendar + day0=[integer] ! initial day to start model calendar + days_inc=[integer] ! increment interval for model calendar + ntime=[integer] ! number of model "timesteps" + cal_type=['julian','noleap','360day'] ! model calendar + +running perl version + + test_time_interp_ext.pl -f 'foo.nc' -v 'foo' [--nt [int] --year0 [int] --month0 [int] --day0 [int] --inc_days [int] --cal_type [char]] + +Modifying the file metadata should hopefully prove straightforward. The NCO operators need to be installed on your platform. The utility `ncatted` is most useful for modifying or adding metadata. If for some reason, you are unable to install the NCO operators, you can use the NetCDF utilities `ncgen` and `ncdump` which come with the NetCDF package. + +### Common metadata problems + +Can't identify cartesian axis information: axis_utils_mod:get_axis_cart should return the cartesian information. If this fails, you will get a somewhat cryptic error message: `file/fieldname could not recognize axis atts in time_interp_external`. The best solution is to add the `cartesian_axis` attribute to the axes, e.g. `ncatted -a cartesian_axis,axis_name,c,c,"X" foo.nc`. + +Calendar attribute does not exist: This is a required attribute. `time_manager_mod:get_cal_time` converts time units appropriate to the specified calendar to the model time representation. If the `calendar` attribute does not exist, an error message appears "get_cal_time: calendar attribute required. Check your dataset to make sure calendar attribute exists " Use a ncatted command such as: + + ncatted -a calendar,time_axis_name,c,c,"julian" foo.nc + +Currently, the FMS time_manager does not support the Gregorian calendar. So, for instance if you have forcing data that are encoded using the Gregorian calendar which has an average year length of 365.2425 days compared with the Julian calendar with an average year length of 365.25 days, assuming Julian calendar encoding will result in a drift of 0.75 days/100 years. If your forcing times are referenced to an early date such as "0001-01-01" your times will drift by 15 days by the year 2000. Until the Gregorian calendar is implemented in the FMS code, the recommended solution is to change the reference date in the forcing dataset using an application such as [Ferret](http://ferret.pmel.noaa.gov/Ferret/home). + +## Scalability of MOM code + +Scalability of a complex model like MOM is the correlation between the number of processing elements (PE) and the run time. One would expect that run time decreases as the number of PEs increases. It is important, however, to note that there are a number of important factors that can affect scalability considerably. The reader is referred to the paper "[A benchmark for the parallel code used in FMS and MOM4](http://www.sciencedirect.com/science/article/pii/S1463500306001107)" Ocean Modelling, Volume 17, Issue 1, 2007, Pages 49-67, Martin Schmidt. + +MOM test cases are designed for testing the code integrity, they are not set for scalability study or "production" purpose. Changes should be made if one wants to study scalability of the code. + +`diag_step` set the time steps at which numerical diagnostics (e.g., energy, tracer budgets) are computed. The user needs to set this value to be equal to the time step at the end of the experiment, so that only a single instance of the diagnostics is evaluated. For example, if time step is 1 hour and run length is 4 days, `diag_step` (or `diag_freq` in MOM4p0) should be set to 96. + +`diag_table` contains all fields that will be saved in history files. The frequency of saving and number of fields can afect the total run time greatly. So when testing performance, it is recommended that the researcher reduce the output of history files. + +Scalability is also dependent on the configuration of the computing platform: Ethernet card, interconnect between PEs, implementation of MPI, memory hierarchy, version of compiler, ... + + +In examining the total run time the overheads due to initialization and termination should be extracted from total runtime for scalability study since they contain a lot of I/O activities. + + +### Minimizing idle processors + + +When running an ocean-ice model with atmospheric data forcing, it may happen that some ocean-ice tasks contain only land points, in which case these processors stand idle. FMS provides a feature to mask land-only tasks and to thus run the model without allocating a processor for these land-only domains. For example, if a processor domain layout 30x50 is specified, but say 500 subdomains are land only, you may run the model with 1500-500=1000 MPI tasks only. Note that you do not get your results faster when eliminating land-only processors, but compute costs may be reduced. + +In the following example, an "x" represents a land-only subdomain, whereas a dot indicates a domain with a nonzero number of "wet" ocean points: + + + x . x + x . . + . . . + + +In this example, three idle processors could be left out (two in the northern-most row, and one in the second row) since there are no wet ocean points on these "x" domains. The ocean-ice model may thus be run with only 6 MPI tasks rather than nine. To enable this feature of FMS, the following variables in the namelist `coupler_nml` must be specified. + + + coupler_nml + ... + do_atmos = .false. + .... + n_mask = 3 + layout_mask = 3, 3 + mask_list = 1,2, 1,3, 3,3 + +If a mask list is specified, the domain layout of the ocean and the ice model is automatically the same, as specified with `layout_mask`. Running the model, only 6 MPI tasks need to be started. + +For large and complex model topography, it is very tedious to specify the mask list by hand. To simplify this task, the preprocessing tool `check_mask` can be used after the model grid and topography are specified, i.e., when `grid_spec.nc` is generated. To do so requires adding the following to `topog_nml` during the preprocessing stage + + + topog_nml + ... + check_mask=.true. + + +The preprocessing code prints out a number of proposals for possible domain layouts, number of land-only subdomains, and templates for setting the `mask_list`. You may copy these layouts to `coupler_nml`, but note that you must replace spaces by a comma in `mask_list`. + +You may configure `check_mask` from the namelist `check_mask_nml`. There are two variables `max_pe` and `halo` required to perform the mask checking. The default settings are + + max_pe = 128 + halo = 1 + +If you intend to employ more processors, then increase `max_pe`. If you want to use higher order advection schemes, then increase `halo` to `halo=2` or even `halo=3`. Otherwise, the halo information of masked domains may leak into ocean domains, in which case the model will fail, with errors reporting land values at ocean points. + +In the postprocessing step, the single netCDF-output files from the MPI tasks can be combined into one file using the tool `mppnccombine`. The latest version adds "missing" values at the location of land-only domains. Hence, the only remaining trace of masking out land-only processors is in your account files, where some compute time is saved. + +## Postprocessing regrid tool + +### Introduction to postprocessing + +For many analysis applications, it is sufficient, and often preferable, to have output on the model's native grid (i.e., the grid used to run the simulation). Accurate computation of budgets, for example, must be done on the model's native grid, preferably online during integration. MOM provides numerous online diagnostics for this purpose. + +Many applications, such as model comparison projects, require results on a common latitude-longitude spherical grid. Such facilitates the development of difference maps. For this purpose, we have developed a tool to regrid scalar and vector fields from a tripolar grid to a spherical grid. In principle, this tool can be used to regrid any logically rectangular gridded field onto a spherical grid. However, applications at GFDL have been limited to the tripolar to spherical regrid case. + +In general, regridding is a difficult task to perform accurately and without producing noise or spurious results. The user should carefully examine regridding results for their physical integrity. Problems occur, in particular, with fields near MOM's partial bottom step topography in the presence of realistic topography and land/sea geometry. Indeed, we were unable to find a simple algorithm to handle regridding in the vertical that did not produce egregious levels of noise. Hence, the regridding tool provided with MOM only handles horizontal regridding. The regridded data will thus be on the source vertical grid. + +Model comparisons should ideally be performed only after regridding output using the same regridding algorithm. Unfortunately, such is not generally the case since there is no standard regridding algorithm used in the modeling community. + + +### How to use the regridding tool + +The regridding algorithm provided with the MOM distribution is located in the directory `postprocessing/regrid`. + +The algorithm accepts data from any logically rectangular grid (e.g., tripolar or latitude-longitude) and regrids to a spherical latitude-longitude grid. When the data is on the tracer cell (T-cell), the regridding interpolation is conservative. Thus, total heat, salt, and passive tracer remain the same on the two grids. However, when data is located at another position: + +* corner or C-cell as for a B-grid horizontal velocity component +* east or E-cell as for an eastward tracer flux +* north or N-cell as for a northward tracer flux + +then regridding is accomplished non-conservatively using a nearest neighbor distance weighting algorithm. It is for this reason that computationally accurate results are only available when working on the model's native grids. The regridding tool reads grids information from a netcdf file, specified by the namelist `grid_spec_file`. `grid_spec_file` contains source grid, destination grid and exchange grid information. + +* source grid: `src_grid.nc`. This is the model's native grid. It results from running preprocessing grid generation code. +* destination grid: `dst_grid.nc`. This is the spherical latitude-lontitude grid. This grid can also be obtained from running preprocessing grid generation code. Be sure that the tripolar option is set to false to ensure that `dst_grid.nc` is spherical. +* exchange grid: `grid_spec.nc`. This is the union of the source grid and destination grid. The exchange grid is needed for conservative regridding. The same conservative regridding algorithm is used for coupled models with FMS. The tool to construct the exchange grid is know as `make_xgrids`. It is located in the `preprocessing/` directory. After `grid_spec.nc` is generated, it should be passed to the `regrid` tool through namelist `grid_spec_file` (No need to pass `src_grid.nc` and `dst_grid.nc` to the `regrid` tool). + +To create the exchange grid, execute the command + + make_xgrids -o src_grid.nc -a dst_grid.nc + +The exchange grid creates a file `grid_spec.nc`. It has new fields with names: + + AREA_ATMxOCN, DI_ATMxOCN, DJ_ATMxOCN, I_ATM_ATMxOCN, J_ATM_ATMxOCN, + I_OCN_ATMxOCN, J_OCN_ATMxOCN, AREA_ATMxLND, DI_ATMxLND, DJ_ATMxLND, + I_ATM_ATMxLND, J_ATM_ATMxLND, I_LND_ATMxLND, J_LND_ATMxLND, + AREA_LNDxOCN, DI_LNDxOCN, DJ_LNDxOCN, I_LND_LNDxOCN, J_LND_LNDxOCN, + I_OCN_LNDxOCN, J_OCN_LNDxOCN, xba, yba, xta, yta, AREA_ATM, xbl, ybl, + xtl, ytl, AREA_LND, AREA_LND_CELL, xto, yto, AREA_OCN + +It is critical that `src_grid.nc` DO NOT already have any of the above new exchange grid fields. If they do, then these fields should be removed using netcdf tools such as `ncks`. After the `grid_spec.nc` file is generated, it is passed into the `regrid` program through the nml option `grid_spec_file`. + +The `regrid` program reads model data from a netcdf file, which is specfied by the namelist variable `src_data`. Again, `src_data` fields are gridded according to `src_grid.nc`. The number of fields to be regridded is specified by `num_flds`. The name of the fields (e.g., `temp`, `salt`) to be regridded is specified by the namelist variable `fld_name`. Each field can be a scalar or vector. If a vector, then specify by `vector_fld`. Vector fields should always be paired together (e.g., u,v components to the horizontal current). The output file is a netcdf file specified by the namelist variable `dst_data`. + +The complete namelist option description is available in `regrid.html` or the code itself. + +## Preparing the runscript + +### The runscript + +A runscript is provided in each test case directory (`exp/$test_case`) for each test case. Details can be found in [quickstart guide](http://www.mom-ocean.org/web/docs/project/quickstart). + +Incorporated in the FMS infrastructure is MPP (Massively Parallel Processing), which provides a uniform message-passing API interface to the different message-passing libraries. If MPICH is installed, the user can compile the MOM source code with MPI. If the user does not have MPICH or the communications library, the MOM source code can be compiled without MPI by omitting the `CPPFLAGS` value `-Duse_libMPI` in the example runscript. + +### The diagnostics table + +The diagnostics table allows users to specify the sampling rates and choose the output fields prior to executing the MOM source code. It is included in the input directory for each test case (`exp/$test_case/input`). A portion of a sample MOM diagnostic table is displayed below. Reference `diag_manager.html` for detailed information on the use of `diag_manager`. + + + "Diagnostics for MOM test case" + 1980 1 1 0 0 0 + #output files + "ocean_month",1,"months",1,"hours","Time" + "ocean_snap",1,"days",1,"hours","Time" + #####diagnostic field entries#### + #=============================================================== + # ocean model grid quantities (static fields and so not time averaged)) + "ocean_model","geolon_t","geolon_t","ocean_month" "all",.false.,"none",2 + "ocean_model","geolat_t","geolat_t","ocean_month","all",.false.,"none",2 + #================================================================ + # prognostic fields + "ocean_model","temp","temp","ocean_month","all", "max", "none",2 + "ocean_model","age_global","age_global","ocean_month","all","min","none",2 + #================================================================ + # diagnosing tracer transport + "ocean_model","temp_xflux_sigma","temp_xflux_sigma","ocean_month","all",.true.,"none",2 + "ocean_model","temp_yflux_sigma","temp_yflux_sigma","ocean_month","all",.true.,"none",2 + #================================================================ + # surface forcing + "ocean_model","sfc_hflux","sfc_hflux","ocean_month","all",.true.,"none",2 + "ocean_model","sfc_hflux_adj","sfc_hflux_adj","ocean_month","all",.true.,"none",2 + #================================================================ + # ice model fields + "ice_model", "FRAZIL", "FRAZIL", "ice_month", "all", .true., "none", 2, + "ice_model", "HI", "HI", "ice_month", "all", .true., "none", 2 + #----------------------------------------------------------------- + + +The diagnostics manager module, `diag_manager_mod`, is a set of simple calls for parallel diagnostics on distributed systems. It provides a convenient set of interfaces for writing data to disk in NetCDF format. The diagnostics manager is packaged with the MOM source code. The FMS diagnostic manager can handle scalar fields as well as arrays. For more information on the diagnostics manager, reference `diag_manager.html`. + + +### The field table + +The MOM field table is used to specify tracers and their advection schemes, cross-land tracer mixing, cross-land insertion, and other options. The field table is included in the runscript as a namelist and is written to an output file upon execution of the runscript. + + "prog_tracers","ocean_mod","temp" + + horizontal-advection-scheme = quicker + vertical-advection-scheme = quicker + restart_file = ocean_temp_salt.res.nc + / + + "prog_tracers","ocean_mod","salt" + + horizontal-advection-scheme = mdfl_sweby + vertical-advection-scheme = mdfl_sweby + restart_file = ocean_temp_salt.res.nc + / + + "tracer_packages","ocean_mod","ocean_age_tracer" + + names = global + horizontal-advection-scheme = mdfl_sweby + vertical-advection-scheme = mdfl_sweby + restart_file = ocean_age.res.nc + min_tracer_limit=0.0 + / + + "namelists","ocean_mod","ocean_age_tracer/global" + + slat = -90.0 + nlat = 90.0 + wlon = 0.0 + elon = 360.0 + / + + "xland_mix","ocean_mod","xland_mix" + "xland","Gibraltar","ixland_1=274,ixland_2=276,jxland_1=146,jxland_2=146,kxland_1=1,kxland_2=28,vxland=0.55e6" + "xland","Gibraltar","ixland_1=274,ixland_2=276,jxland_1=147,jxland_2=147,kxland_1=1,kxland_2=28,vxland=0.55e6" + "xland","Black-Med","ixland_1=305,ixland_2=309,jxland_1=151,jxland_2=152,kxland_1=1,kxland_2=6,vxland=0.01e6" + "xland","Black-Med","ixland_1=306,ixland_2=309,jxland_1=151,jxland_2=153,kxland_1=1,kxland_2=6,vxland=0.01e6"/ + + "xland_insert","ocean_mod","xland_insert" + "xland","Gibraltar","ixland_1=274,ixland_2=276,jxland_1=146,jxland_2=146,kxland_1=1,kxland_2=18,tauxland=86400.0" + "xland","Gibraltar","ixland_1=274,ixland_2=276,jxland_1=147,jxland_2=147,kxland_1=1,kxland_2=18,tauxland=86400.0" + "xland","Black-Med","ixland_1=305,ixland_2=309,jxland_1=151,jxland_2=152,kxland_1=1,kxland_2=6,tauxland=86400.0" + "xland","Black-Med","ixland_1=306,ixland_2=309,jxland_1=151,jxland_2=153,kxland_1=1,kxland_2=6,tauxland=86400.0"/ + + "diff_cbt_enhance","ocean_mod","diff_cbt_enhance" + "diffcbt","Gibraltar","itable=274,jtable=146,ktable_1=1,ktable_2=18,diff_cbt_table=0.01" + "diffcbt","Gibraltar","itable=276,jtable=146,ktable_1=1,ktable_2=18,diff_cbt_table=0.01" + "diffcbt","Gibraltar","itable=274,jtable=147,ktable_1=1,ktable_2=18,diff_cbt_table=0.01" + "diffcbt","Gibraltar","itable=276,jtable=147,ktable_1=1,ktable_2=18,diff_cbt_table=0.01" + "diffcbt","Black-Med","itable=305,jtable=151,ktable_1=1,ktable_2=6,diff_cbt_table=0.01" + "diffcbt","Black-Med","itable=309,jtable=152,ktable_1=1,ktable_2=6,diff_cbt_table=0.01" + "diffcbt","Black-Med","itable=306,jtable=151,ktable_1=1,ktable_2=6,diff_cbt_table=0.01" + "diffcbt","Black-Med","itable=309,jtable=153,ktable_1=1,ktable_2=6,diff_cbt_table=0.01"/ + +In the first section of the field table, the user can specify tracers to be used in the simulation. Although there is no limit to the number of tracers specified, temperature (temp) and salinity (salt) must be included. The user may also define the horizontal and vertical tracer advection schemes. For more information on the field manager, reference `field_manager.html`. + +In climate modeling, it is often necessary to allow water masses that are separated by land to exchange tracer and surface height properties. This situation arises in models when the grid mesh is too coarse to resolve narrow passageways that in reality provide crucial connections between water masses. The cross-land mixing and cross-land insertion establishes communication between bodies of water separated by land. The communication consists of mixing tracers and volume between non-adjacent water columns. Momentum is not mixed. The scheme conserves total tracer content, total volume, and maintains compatibility between the tracer and volume budgets. The grid points where this exchange takes place, and the rates of the exchange, are specified in the field table. + +For some cases, it is necessary to set a large vertical tracer diffusivity at a specified point in the model, say next to a river mouth to ensure fresh water is mixed vertically. These diffusivities are specified in the field table. + +For a technical description of cross-land tracer mixing and insertion, please reference [A Technical Guide to MOM4](http://www.mom-ocean.org/web/docs/project/MOM4_guide.pdf). + +### `mppnccombine` + +Running MOM in a parallel processing environment will produce one output NetCDF diagnostic file per processor. `mppnccombine` joins together an arbitrary number of data files containing chunks of a decomposed domain into a unified NetCDF file. If the user is running the model on one processor, the domain is not decomposed and there is only one data file. `mppnccombine` will still copy the full contents of the data file, but this is inefficient and `mppnccombine` should not be used in this case. Executing `mppnccombine` is automated through the runscripts. The data files are NetCDF format for now, but IEEE binary may be supported in the future. + +`mppnccombine` requires decomposed dimensions in each file to have a `domain_decomposition` attribute. This attribute contains four integer values: + +* starting value of the entire non-decomposed dimension range (usually 1) +* ending value of the entire non-decomposed dimension range +* starting value of the current chunk's dimension range +* ending value of the current chunk's dimension range. + +`mppnccombine` also requires that each file have a `NumFilesInSet` global attribute which contains a single integer value representing the total number of chunks (i.e., files) to combine. + +The syntax of `mppnccombine` is: + + mppnccombine [-v] [-a] [-r] output.nc [input ...] + + -v print some progress information + + -a append to an existing NetCDF file + + -r remove the '.####' decomposed files after a successful run + +An output file must be specified and it is assumed to be the first filename argument. If the output file already exists, then it will not be modified unless the option is chosen to append to it. If no input files are specified, their names will be based on the name of the output file plus the extensions '.0000', '.0001', etc. If input files are specified, they are assumed to be absolute filenames. A value of 0 is returned if execution is completed successfully and a value of 1 indicates otherwise. + +The source of `mppnccombine` is packaged with the MOM module in the postprocessing directory. `mppnccombine.c` should be compiled on the platform where the user intends to run the FMS MOM source code so the runscript can call it. A C compiler and NetCDF library are required for compiling `mppnccombine.c`: + + cc -O -o mppnccombine -I/usr/local/include -L/usr/local/lib mppnccombine.c -lnetcdf + +## Examining the output + +### Sample model output + +Sample MOM model output data files are available in the `data/` directory. Output files are classified into three subdirectories: + +* `ascii/`: the description of the setup of the run and verbose comments printed out during the run. +* `restart/`: the model fields necessary to initialize future runs of the model. +* `history/`: output of the model, both averaged over specified time intervals and snapshots. + +Note that these output files are compressed using `tar`. All `.tar` files should be decompressed for viewing. The decompress command is: + + tar -xvf filename.tar + +### Analysis tools + +There are several graphical packages available to display the model output. These packages vary widely depending on factors, such as the number of dimensions, the amount and complexity of options available and the output data format. The data will first have to be put into a common format that all the packages can read. FMS requires the data to be stored in NetCDF format since it is so widely supported for scientific visualization. The graphical package is also dependent upon the computing environment. For ocean modeling, [ncview](http://meteora.ucsd.edu/~pierce/ncview_home_page.html), [Ferret](http://ferret.pmel.noaa.gov/Ferret/home) and [GrADS](http://www.iges.org/grads/) are most commonly used. diff --git a/MOM_code/exp/FMS_compile.csh b/MOM_code/exp/FMS_compile.csh new file mode 100644 index 0000000..5465fd0 --- /dev/null +++ b/MOM_code/exp/FMS_compile.csh @@ -0,0 +1,108 @@ +# Build the shared FMS component library +# The list of source files that should be compiled for this component. + +set pathnames_shared = $code_dir/path_names_shared # path to file containing list of source paths + +cat > $pathnames_shared < 1 +# if ( ! -f $mppnccombine ) then +# cc -O -o $mppnccombine -I/usr/local/include -L/usr/local/lib $code_dir/postprocessing/mppnccombine/mppnccombine.c -lnetcdf +# endif + +set mkmf_lib = "$mkmf -f -m Makefile -a $code_dir -t $mkmfTemplate" +set lib_include_dirs = "$root/include $code_dir/shared/include $code_dir/shared/mpp/include" + +source ./FMS_compile.csh +if ( $status ) exit $status + +cd $root/exp +source ./ocean_compile.csh +if ( $status ) exit $status + +if( $type != MOM_solo) then + cd $root/exp + source ./ice_compile.csh + if ( $status ) exit $status +endif +if( $type == MOM_SIS) then + cd $root/exp + source ./land_null_compile.csh + if ( $status ) exit $status + + cd $root/exp + source ./atmos_null_compile.csh + if ( $status ) exit $status +endif +if( $type == EBM) then + cd $root/exp + source ./atmos_ebm_compile.csh + if ( $status ) exit $status +endif +if( $type == CM2M | $type == ESM2M | $type == ICCM ) then + cd $root/exp + source ./atmos_phys_compile.csh + if ( $status ) exit $status +endif +if( $type == CM2M | $type == ESM2M ) then + cd $root/exp + source ./atmos_fv_compile.csh + if ( $status ) exit $status +endif +if( $type == CM2M | $type == ICCM | $type == EBM ) then + cd $root/exp + source ./land_lad_compile.csh + if ( $status ) exit $status +endif +if( $type == ESM2M ) then + cd $root/exp + source ./land_lad2_compile.csh + if ( $status ) exit $status +endif +if( $type == ICCM ) then + cd $root/exp + source ./atmos_bg_compile.csh + if ( $status ) exit $status +endif + +# Build the executable +set mkmf_exec = "$mkmf -f -m Makefile -a $code_dir -t $mkmfTemplate -p $executable:t" +mkdir -p $executable:h +cd $executable:h +if( $type == MOM_solo ) then + set srcList = ( mom5/drivers ) + set includes = "-I$executable:h:h/lib_FMS -I$executable:h:h/lib_ocean" + set libs = "$executable:h:h/lib_ocean/lib_ocean.a $executable:h:h/lib_FMS/lib_FMS.a" +else if( $type == MOM_SIS ) then + set srcList = ( coupler ) + set includes = "-I$executable:h:h/lib_FMS -I$executable:h:h/lib_ocean -I$executable:h:h/lib_ice -I$executable:h:h/lib_atmos_null -I$executable:h:h/lib_land_null" + set libs = "$executable:h:h/lib_ocean/lib_ocean.a $executable:h:h/lib_ice/lib_ice.a $executable:h:h/lib_atmos_null/lib_atmos_null.a $executable:h:h/lib_land_null/lib_land_null.a $executable:h:h/lib_FMS/lib_FMS.a" +else if( $type == EBM ) then + set srcList = ( coupler ) + set includes = "-I$executable:h:h/lib_FMS -I$executable:h:h/lib_ocean -I$executable:h:h/lib_ice -I$executable:h:h/lib_atmos_ebm -I$executable:h:h/lib_land_lad" + set libs = "$executable:h:h/lib_ocean/lib_ocean.a $executable:h:h/lib_ice/lib_ice.a $executable:h:h/lib_atmos_ebm/lib_atmos_ebm.a $executable:h:h/lib_land_lad/lib_land_lad.a $executable:h:h/lib_FMS/lib_FMS.a" +else if( $type == CM2M ) then + set srcList = ( coupler ) + set includes = "-I$executable:h:h/lib_FMS -I$executable:h:h/lib_ocean -I$executable:h:h/lib_ice -I$executable:h:h/lib_atmos_fv -I$executable:h:h/lib_atmos_phys -I$executable:h:h/lib_land_lad" + set libs = "$executable:h:h/lib_ocean/lib_ocean.a $executable:h:h/lib_ice/lib_ice.a $executable:h:h/lib_atmos_fv/lib_atmos_fv.a $executable:h:h/lib_atmos_phys/lib_atmos_phys.a $executable:h:h/lib_land_lad/lib_land_lad.a $executable:h:h/lib_FMS/lib_FMS.a" +else if( $type == ESM2M ) then + set srcList = ( coupler ) + set includes = "-I$executable:h:h/lib_FMS -I$executable:h:h/lib_ocean -I$executable:h:h/lib_ice -I$executable:h:h/lib_atmos_fv -I$executable:h:h/lib_atmos_phys -I$executable:h:h/lib_land_lad2" + set libs = "$executable:h:h/lib_ocean/lib_ocean.a $executable:h:h/lib_ice/lib_ice.a $executable:h:h/lib_atmos_fv/lib_atmos_fv.a $executable:h:h/lib_atmos_phys/lib_atmos_phys.a $executable:h:h/lib_land_lad2/lib_land_lad2.a $executable:h:h/lib_FMS/lib_FMS.a" +else if( $type == ICCM ) then + set srcList = ( coupler ) + set includes = "-I$executable:h:h/lib_FMS -I$executable:h:h/lib_ocean -I$executable:h:h/lib_ice -I$executable:h:h/lib_atmos_bg -I$executable:h:h/lib_atmos_phys -I$executable:h:h/lib_land_lad" + set libs = "$executable:h:h/lib_ocean/lib_ocean.a $executable:h:h/lib_ice/lib_ice.a $executable:h:h/lib_atmos_bg/lib_atmos_bg.a $executable:h:h/lib_atmos_phys/lib_atmos_phys.a $executable:h:h/lib_land_lad/lib_land_lad.a $executable:h:h/lib_FMS/lib_FMS.a" +endif +$mkmf_exec -o "$includes" -l "$libs" $srcList +make +if( $status ) then + echo "Make failed to create the $type executable" + exit 1 +endif + +exit diff --git a/MOM_code/exp/MOM_run.csh b/MOM_code/exp/MOM_run.csh new file mode 100755 index 0000000..2a7329c --- /dev/null +++ b/MOM_code/exp/MOM_run.csh @@ -0,0 +1,319 @@ +#!/bin/csh -f +# Minimal runscript for MOM experiments + +set type = MOM_solo # type of the experiment +set name = box1 +set platform = ncrc2.intel # A unique identifier for your platform +set npes = 8 # number of processor + # Note: If you change npes you may need to change + # the layout in the corresponding namelist +set valid_npes = 0 +set help = 0 +set download = 0 +set argv = (`getopt -u -o h -l type: -l platform: -l npes: -l experiment: -l debug -l help -l download_input_data -- $*`) +while ("$argv[1]" != "--") + switch ($argv[1]) + case --type: + set type = $argv[2]; shift argv; breaksw + case --platform: + set platform = $argv[2]; shift argv; breaksw + case --npes: + set npes = $argv[2]; shift argv; breaksw + case --experiment: + set name = $argv[2]; shift argv; breaksw + case --debug: + set debug = 1; breaksw + case --help: + set help = 1; breaksw + case -h: + set help = 1; breaksw + case --download_input_data: + set download = 1; breaksw + endsw + shift argv +end +shift argv + +if ( $help ) then + echo "The optional arguments are:" + echo "--type followed by the type of the experiment, currently one of the following:" + echo " MOM_solo : solo ocean model" + echo " MOM_SIS : ocean-seaice model" + echo " CM2M : ocean-seaice-land-atmosphere coupled climate model" + echo " ESM2M : ocean-seaice-land-atmosphere coupled climate model with biogeochemistry, EarthSystemModel" + echo " ICCM : ocean-seaice-land-atmosphere coupled model" + echo + echo "--experiment followed by the name of the experiment of the specified type" + echo " To see the list of available experiments for each type use -h --type type_name" + if ( $type == MOM_solo ) then + echo " Available expeiments for MOM_solo:" + echo " box1, box_channel1, bowl1, dome1, gyre1, iom1, mk3p51, symmetric_box1, torus1, dome_bates_blobs1" + endif + if ( $type == MOM_SIS ) then + echo " Available expeiments for MOM_SIS:" + echo " om3_core1, om3_core3, MOM_SIS_TOPAZ, MOM_SIS_BLING, atlantic1" + endif + if ( $type == CM2M ) then + echo " Available expeiments for CM2M:" + echo " CM2.1p1, CM2M_coarse_BLING" + endif + if ( $type == ESM2M ) then + echo " Available expeiments for ESM2M:" + echo " ESM2M_pi-control_C2" + endif + if ( $type == ICCM ) then + echo " Available expeiments for ICCM:" + echo " ICCMp1" + endif + if ( $type == EBM ) then + echo " Available expeiments for EBM:" + echo " mom4p1_ebm1" + endif + echo + echo + echo "--platform followed by the platform name that has a corresponfing environ file in the ../bin dir, default is ncrc.intel" + echo + echo "--npes followed by the number of pes to be used for this experiment" + echo + echo Note that the executable for the run should have been built before calling this script. This could be done by calling the appropriate compile script for this experiment \"type\" beforehand. + echo + echo + exit 0 +endif + +set root = $cwd:h # The directory in which you checked out src +set code_dir = $root/src # source code directory +set workdir = $root/work # where the model is run and model output is produced + # This is recommended to be a link to the $WORKDIR of the platform. +set expdir = $workdir/$name +set inputDataDir = $expdir/INPUT # This is path to the directory that contains the input data for this experiment. + # You should have downloaded and untared this directory from MOM4p1 FTP site. +set diagtable = $inputDataDir/diag_table # path to diagnositics table +set datatable = $inputDataDir/data_table # path to the data override table. +set fieldtable = $inputDataDir/field_table # path to the field table +set namelist = $inputDataDir/input.nml # path to namelist file + +set executable = $root/exec/$platform/$type/fms_$type.x # executable created after compilation + +#set archive = $ARCHIVE/$type #Large directory to host the input and output data. + + + +#=========================================================================== +# The user need not change any of the following +#=========================================================================== + +# +# Users must ensure the correct environment file exists for their platform. +# +source $root/bin/environs.$platform # environment variables and loadable modules + +set mppnccombine = $root/bin/mppnccombine.$platform # path to executable mppnccombine +set time_stamp = $root/bin/time_stamp.csh # path to cshell to generate the date + +# Check if the user has extracted the input data + if ( ! -d $inputDataDir ) then + + if( $download ) then + cd $workdir + wget ftp.gfdl.noaa.gov:/perm/MOM4/mom4p1_pubrel_dec2009/exp/$name.input.tar.gz + tar zxvf $name.input.tar.gz + else + + echo "ERROR: the experiment directory '$inputDataDir' does not exist or does not contain input and preprocessing data directories!" + echo "Please download and extract the tar ball corresponding to this experiment from GFDL anonymous ftp site!" + echo " cd $workdir" + echo " wget ftp.gfdl.noaa.gov:/perm/MOM4/mom5_pubrel_dec2013/exp/$name.input.tar.gz" + echo " tar zxvf $name.input.tar.gz" + echo "Then rerun this script." + echo "Or use the --download option to do this automatically" + exit 1 + + endif + endif + +set echo + +# setup directory structure + if ( ! -d $expdir ) mkdir -p $expdir + if ( ! -d $expdir/RESTART ) mkdir -p $expdir/RESTART + +# +#Check the existance of essential input files +# +# if ( ! -e $inputDataDir/grid_spec.nc ) then +# echo "ERROR: required input file does not exist $inputDataDir/grid_spec.nc " +# exit 1 +# endif +# if ( ! -e $inputDataDir/ocean_temp_salt.res.nc ) then +# echo "ERROR: required input file does not exist $inputDataDir/ocean_temp_salt.res.nc " +# exit 1 +# endif + + + +# --- make sure executable is up to date --- + set makeFile = Make_$type + cd $executable:h + make -f $makeFile + if ( $status != 0 ) then + unset echo + echo "ERROR: make failed" + exit 1 + endif +#------------------------------------------- + +#Change to expdir + + cd $expdir + +# Create INPUT directory. Make a link instead of copy +# +if ( ! -d $expdir/INPUT ) mkdir -p $expdir/INPUT + + if ( ! -e $namelist ) then + echo "ERROR: required input file does not exist $namelist " + exit 1 + endif + if ( ! -e $datatable ) then + echo "ERROR: required input file does not exist $datatable " + exit 1 + endif + if ( ! -e $diagtable ) then + echo "ERROR: required input file does not exist $diagtable " + exit 1 + endif + if ( ! -e $fieldtable ) then + echo "ERROR: required input file does not exist $fieldtable " + exit 1 + endif + + cp $namelist input.nml + cp $datatable data_table + cp $diagtable diag_table + cp $fieldtable field_table + +#Preprocessings + $root/exp/preprocessing.csh + +if ( $type == CM2M & $npes != 45 ) then + set valid_npes = 45 +endif + +if ( $type == ESM2M & $npes != 90 ) then + set valid_npes = 90 +endif +if ( $type == ICCM & $npes != 54 ) then + set valid_npes = 54 +endif +if ( $name == atlantic1 & $npes != 24) then + set valid_npes = 24 +endif +if ( $name == mom4p1_ebm1 & $npes != 17) then + set valid_npes = 17 +endif +set runCommand = "$mpirunCommand $npes $executable >fms.out" +echo "About to run the command $runCommand" + +if ( $valid_npes ) then + echo "ERROR: This experiment is designed to run on $valid_npes pes. Please specify --npes $valid_npes " + echo "Note: In order to change the default npes for an expeiment the user may need to edit the values of layouts and atmos_npes and ocean_npes in the input.nml and run the mpi command manually in the working dir" + exit 0 +endif + +# --- run the model --- + +$runCommand + +#---------------------------------------------------------------------------------------------- +# generate date for file names --- + set begindate = `$time_stamp -bf digital` + if ( $begindate == "" ) set begindate = tmp`date '+%j%H%M%S'` + set enddate = `$time_stamp -ef digital` + if ( $enddate == "" ) set enddate = tmp`date '+%j%H%M%S'` + if ( -f time_stamp.out ) rm -f time_stamp.out +#---------------------------------------------------------------------------------------------- +# get a tar restart file + cd RESTART + cp $expdir/input.nml . + cp $expdir/*_table . +# combine netcdf files + if ( $npes > 1 ) then + #Concatenate blobs restart files. mppnccombine would not work on them. + ncecat ocean_blobs.res.nc.???? ocean_blobs.res.nc + rm ocean_blobs.res.nc.???? + set file_previous = "" + set multires = (`ls *.nc.????`) + foreach file ( $multires ) + if ( $file:r != $file_previous:r ) then + set input_files = ( `ls $file:r.????` ) + if ( $#input_files > 0 ) then + $mppnccombine $file:r $input_files + if ( $status != 0 ) then + echo "ERROR: in execution of mppnccombine on restarts" + exit 1 + endif + rm $input_files + endif + else + continue + endif + set file_previous = $file + end + endif + + cd $expdir + mkdir history + mkdir ascii +#---------------------------------------------------------------------------------------------- +# rename ascii files with the date + foreach out (`ls *.out`) + mv $out ascii/$begindate.$out + end + +#---------------------------------------------------------------------------------------------- +# combine netcdf files + if ( $npes > 1 ) then + #Don't combine blobs history files. They need special handling. + mv ocean_blobs.nc.???? history/ + set file_previous = "" + set multires = (`ls *.nc.????`) + foreach file ( $multires ) + if ( $file:r != $file_previous:r ) then + set input_files = ( `ls $file:r.????` ) + if ( $#input_files > 0 ) then + $mppnccombine $file:r $input_files + if ( $status != 0 ) then + echo "ERROR: in execution of mppnccombine on restarts" + exit 1 + endif + rm $input_files + endif + else + continue + endif + set file_previous = $file + end + endif + +#---------------------------------------------------------------------------------------------- +# rename nc files with the date + foreach ncfile (`/bin/ls *.nc`) + mv $ncfile history/$begindate.$ncfile + end + + unset echo + + +echo end_of_run +echo "NOTE: Natural end-of-script." + +#Archive the results + +#cd $workdir +#tar cvf $name.output.tar --exclude=data_table --exclude=diag_table --exclude=field_table --exclude=fms_$type.x --exclude=input.nml --exclude=INPUT $name +#gzip $name.output.tar +#mv $name.output.tar.gz $archive/ + +exit 0 + diff --git a/MOM_code/exp/atmos_null_compile.csh b/MOM_code/exp/atmos_null_compile.csh new file mode 100644 index 0000000..c7654e4 --- /dev/null +++ b/MOM_code/exp/atmos_null_compile.csh @@ -0,0 +1,15 @@ +# Build the null atmos library + +set srcList = ( atmos_null atmos_param/diag_integral atmos_param/monin_obukhov ) + +set lib_name = "lib_atmos_null" + +mkdir -p $executable:h:h/$lib_name +cd $executable:h:h/$lib_name +$mkmf_lib -p $lib_name.a -c "$cppDefs" -o "-I$executable:h:h/lib_FMS" $srcList $lib_include_dirs +make + +if( $status ) then + echo "Make failed to create $lib_name.a" + exit 1 +endif diff --git a/MOM_code/exp/ice_compile.csh b/MOM_code/exp/ice_compile.csh new file mode 100644 index 0000000..daa5e26 --- /dev/null +++ b/MOM_code/exp/ice_compile.csh @@ -0,0 +1,16 @@ +# Build the Ice library +# The list of source files that should be compiled for this component. + +set srcList = ( ice_sis ice_param ) + +set lib_name = "lib_ice" + +mkdir -p $executable:h:h/$lib_name +cd $executable:h:h/$lib_name +$mkmf_lib -p $lib_name.a -c "$cppDefs" -o "-I$executable:h:h/lib_FMS" $srcList $lib_include_dirs +make + +if( $status ) then + echo "Make failed to create $lib_name.a" + exit 1 +endif diff --git a/MOM_code/exp/land_null_compile.csh b/MOM_code/exp/land_null_compile.csh new file mode 100644 index 0000000..6894663 --- /dev/null +++ b/MOM_code/exp/land_null_compile.csh @@ -0,0 +1,15 @@ +# Build the null land library + +set srcList = ( land_null ) + +set lib_name = "lib_land_null" + +mkdir -p $executable:h:h/$lib_name +cd $executable:h:h/$lib_name +$mkmf_lib -p $lib_name.a -c "$cppDefs" -o "-I$executable:h:h/lib_FMS" $srcList $lib_include_dirs +make + +if( $status ) then + echo "Make failed to create $lib_name.a" + exit 1 +endif diff --git a/MOM_code/exp/mom5_ebm_compile.csh b/MOM_code/exp/mom5_ebm_compile.csh new file mode 100755 index 0000000..fe34d56 --- /dev/null +++ b/MOM_code/exp/mom5_ebm_compile.csh @@ -0,0 +1,423 @@ +#!/bin/csh -f +# Minimal compile script for mom4p1 solo experiments + +set echo +set platform = ncrc2.intel # A unique identifier for your platform + # This corresponds to the mkmf templates in $root/bin dir. +# +# User does not need to change anything below! +# +set type = EBM # Name of the experiment +set root = $cwd:h # The directory you created when you checkout +set code_dir = $root/src # source code directory +set executable = $root/exec/$platform/$type/fms_$type.x # executable created after compilation +set pathnames = $code_dir/path_names_$type # path to file containing list of source paths +set mppnccombine = $root/bin/mppnccombine.$platform # path to executable mppnccombine +set mkmfTemplate = $root/bin/mkmf.template.$platform # path to template for your platform +set mkmf = $root/bin/mkmf # path to executable mkmf +set cppDefs = ( "-Duse_netCDF -Duse_netCDF3 -Duse_libMPI -DLAND_BND_TRACERS -DOVERLOAD_C8 -DOVERLOAD_C4 -DOVERLOAD_R4" ) + +# +# Users must ensure the correct environment file exists for their platform. +# +source $root/bin/environs.$platform # environment variables and loadable modules + +# setup directory structure + if ( ! -d $executable:h ) mkdir -p $executable:h + +# +# compile mppnccombine.c, needed only if $npes > 1 +#NOTE: On some platforms you may need to specify the location for netcdf.h and libnetcdf.a +# by modifying the following -I and -L + if ( ! -f $mppnccombine ) then + cc -O -o $mppnccombine -I/usr/local/include -L/usr/local/lib $code_dir/postprocessing/mppnccombine/mppnccombine.c -lnetcdf + endif + + + +# The list of source files that should be compiled for this experiment. +cat > $pathnames < + Fix for NetCDF files that do not have a time dimension. + V2.2.4: Tushar.Mohan + Round memory footprint to ceiling integral value. + + V2.2.3: Tushar.Mohan + Fixed handling of -k when -x is set. + Print memory estimate in MB when -x is used without -v. + Fixed help message for -k and -x. + If user sets blocking factor > # records (nrecs), set bf to nrecs + + V2.2.2: Tushar.Mohan + Added a -x option to print estimate resident memory footprint and exit + Changed default blocking factor 1, so the combine behaves as the + combine of the past if no "-k" option is set. This is useful + for low-memory nodes. + + V2.2.1: Do not bail out when we cannot write variables to output file. + Instead, issue a warning and set an error condition. Continue + processing. + Fixed bug in allocation of memory for decomposed variables that + only showed up in certain rare input conditions. + Added -M to show memory usage statistics. + Added -V to print version information. + + V2.2: Added record blocking (see, the -k option) to the memory buffering + code. This significantly improves performance, by buffering multiple + records of decomposed variables in memory. Output I/O performance + improves, due to reduced seeks and larger contiguous writes. We also + reduce the number of file open/close operations in the input files + (by the blocking factor), thus we can expect better performance on + file-systems with expensive metadata operations (such as Lustre). + This performance improvement comes at the cost of increased resident + memory size (by the blocking factor). For questions regarding these + changes, contact: Tushar Mohan (Tushar.Mohan) 08/03/2011. + Also added fixes to the following bugs: + - flush_decomp ignored errors, when it was not able to + write variables to the output file. We now exit on such errors. + - when -n and -e are used and files are not present then + the message of the number of files remaining was misleading. + - when a range is specified, and not all files are present, + then the -r option was deleting files properly only when + NumInFiles in set was correct. That may occasionally be + be wrongly set in the input. We now correctly remove files, + nevertheless. + V2.1.7: Added option to initialize output variables with a missing_value + from the variables of the first input file as suggested by + Martin Schmidt (martin.schmidt@io-warnemuende.de) and + Franz Tauber (franz.tauber@io-warnemuende.de). + V2.1.6: Bug fixes for greater than 4GB record sizes. Does not contain + V2.1.5 modifications which were a special case. + V2.1.5: Supports running in an MPI environment. Reads arguments from a + configuration file instead of from the command line; this is needed + to work around a bug in Cray's aprun. + V2.1.4: Fixed a bug with file cleanup and the debugging messages. + V2.1.3: Fixed a run-time segmentation fault with some compilers; changed + ncinfile allocation in process_file function. + V2.1.2: Fixed a bug with input files that have decomposed dimensions + defined after the variables that use them. + V2.1.1: Added option (-64) for creating output files with 64-bit offset + format requiring NetCDF 3.6.x. + V2.1: Added an option (-h) to pad the output file's header with empty space. + Added an option (-e #) to specify an ending number to a range of input + filename extensions. It no longer aborts on missing input files, but + gives error messages at the end of all the processing. + V2.0: Substantial rewrite; memory buffering increases speed several times. + V1.2: Added support for specifying the start number in filename extensions. + V1.1.1: Added a fix for dimensions that are not also variables. + V1.1: Changed loop order for increased I/O efficiency; records are now the + innermost loop then the variables loop. + V1.0: Original release. + + Written by Hans Vahlenkamp (Hans.Vahlenkamp) + Geophysical Fluid Dynamics Laboratory / NOAA + Princeton Forrestal Campus +*/ + +/* Algorithm: + there are k records in a block + + for block b: 1 .. N + for file f: 1 .. n + for record r: 1 .. k + Read rec (r) from file (f) + for var v: 1 .. nvars + If var is undecomposed write to output + if var (v) is decomposed: + IF not allocated, allocate memory for var (v), record (r) + write variable (v) into memory buffer + done var + done record + done file + for record r: 1 .. k + for var: 1..nvars + if decomposed variable, flush variable v for rec r to output + done + done + free memory for all variables for all records in block + done block + */ + +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#ifndef MAX_BF +# define MAX_BF 1024 /* maximum blocking factor */ +#endif +#ifndef DEFAULT_BF /* default blocking factor, if none set */ +# define DEFAULT_BF 1 +#endif + +#define NEW_CACHE_SIZE 128000000 +#define NEW_CACHE_NELEMS 2 +#define NEW_CACHE_PREEMPTION .75 + +/* Information structure for a file */ +struct fileinfo + { + int ncfid; /* ID of the input netCDF file */ + int ndims; /* Number of dimensions */ + int nvars; /* Number of variables */ + int ngatts; /* Number of global attributes */ + int recdim; /* ID of the record dimensions */ + char varname[MAX_NC_VARS][MAX_NC_NAME]; /* Names of the variables */ + nc_type datatype[MAX_NC_VARS]; /* Data types of the variables */ + int varndims[MAX_NC_VARS]; /* Number of dimensions for each variable */ + int vardim[MAX_NC_VARS][MAX_NC_DIMS]; /* Dimensions for each variable */ + int natts[MAX_NC_VARS]; /* Number of attributes for each variable */ + unsigned char vardecomp[MAX_NC_VARS]; /* Is the variable decomposed */ + char dimname[MAX_NC_DIMS][MAX_NC_NAME]; /* Names of the dimensions */ + long dimsize[MAX_NC_DIMS]; /* Sizes of the dimensions (decomposed) */ + long dimfullsize[MAX_NC_DIMS]; /* Full sizes of the dimensions */ + long dimstart[MAX_NC_DIMS]; /* Start positions within full dimensions */ + long dimend[MAX_NC_DIMS]; /* End positions within full dimensions */ + unsigned char varmiss[MAX_NC_VARS]; /* Does variable have missing_value */ + unsigned char varmissval[MAX_NC_VARS][8]; /* missing_value per variable */ + }; + +/* Auxiliary function prototypes */ +void usage(); +int process_file(char *, unsigned char, struct fileinfo *, char *, int *, + int *, int *, int*, int, int, int, unsigned char, + unsigned char, int); +int process_vars(struct fileinfo *, struct fileinfo *, unsigned char, int *, + int *, int*, int, int, int, unsigned char, unsigned char); +int flush_decomp(struct fileinfo *, int, int, int, unsigned char); +void print_debug(struct fileinfo *, unsigned char); +char *nc_type_to_str(nc_type); + +static void ***varbuf = NULL; /* Buffers for multiple records of decomposed var */ + +struct rusage ruse; /* structure used to store values from getrusage() */ +static unsigned long maxrss = 0; /* maximum memory used so far in kilobytes */ +static int print_mem_usage = 0; +static unsigned long mem_allocated = 0; /* memory allocated so far */ + +static const char version[] = "2.2.5"; +static const char last_updated[] = "Mar-02-2012"; + +static unsigned long estimated_maxrss = 0; /* see option: -x */ +static int mem_dry_run = 0; /* set if -x option is used */ + +static inline void check_mem_usage(void) { + static long prev_rss = 0; + static long PAGE_SIZE = 0; + long rss = 0; + if (PAGE_SIZE == 0) PAGE_SIZE = sysconf(_SC_PAGESIZE); + if (getrusage(RUSAGE_SELF, &ruse) == 0) rss = ruse.ru_maxrss * PAGE_SIZE; + if (rss == 0) { + /* bug in Linux kernel means resident size is reported 0 */ + FILE * f = fopen("/proc/self/statm", "r"); + if (f != NULL) { + int discard; + fscanf(f, "%d %ld\n", &discard, &rss); + fclose(f); + rss *= PAGE_SIZE; + } + } + if (rss > maxrss) maxrss = rss; + printf("rss=%lu KB, delta=%ld KB, maxrss=%lu KB\n", rss/1024, (rss - prev_rss)/1024, maxrss/1024); + prev_rss = rss; + return; +} + +static void print_estimated_mem_footprint(int verbose) { + if (verbose) { + printf("Estimated peak memory resident size (k=1) : %.1f MB\n", (float)estimated_maxrss/(1024*1024)); + printf("For estimating RSS for a different value of k, multiply above usage by k.\n"); + } + else printf("%.0f\n", ceil((float)estimated_maxrss/(1024*1024))); + return; +} + +int main(int argc, char *argv[]) + { + unsigned char verbose=0; /* Print some progress information? */ + unsigned char appendnc=0; /* Append to an existing netCDF file? */ + unsigned char removein=0; /* Remove the ".####" decomposed input files? */ + int nstart=0; /* PE number of the first input netCDF file */ + int nend=(-1); /* PE number of the last input netCDF file */ + int force=0; /* Allows combining of incomplete input filesets */ + int headerpad=16384; /* Additional padding at the end of the header */ + int format=NC_NOCLOBBER; /* Format of new netCDF output file */ + unsigned char missing=0; /* Initialize output variables with */ + /* "missing_value" instead of 0 value? */ + int outputarg=(-1); /* Argument # of the output netCDF file */ + int inputarg=(-1); /* Argument # of first input netCDF file */ + struct stat statbuf; /* Dummy structure for file-testing "stat" call */ + struct fileinfo *ncoutfile; /* Information for the output file */ + char outfilename[2048], *strptr; /* Name of the output netCDF file */ + int outlen; /* Length of the output filename */ + char infilename[2048]; /* Name of an input file */ + unsigned char infileerror=0; /* Errors reading an input file */ + unsigned char infileerrors=0; /* Errors reading any input files */ + unsigned char outfileerrors=0; /* error in output file writing */ + int nfiles=(-1); /* Number of files in the decomposed domain */ + int a, f, r, block, k, v; /* Loop variables */ + int status; /* Return status */ + int nrecs=1; /* Number of records in each decomposed file */ + int bf=DEFAULT_BF; /* default blocking factor: bf records will be read and written at a time */ + int nblocks=1; /* nblocks=nrecs/bf = number of iterations of outer loop */ + int peWidth = -1; /* Width of PE number in uncombined file extension */ + size_t blksz=65536; /* netCDF block size */ + int defl=0; /* deflating level */ + + /* Check the command-line arguments */ + if (argc < 2) + { + usage(); return(1); + } + for (a=1; a < argc; a++) + { + if (!strcmp(argv[a],"-v")) verbose=1; + else if (!strcmp(argv[a],"-vv")) verbose=2; /* Hidden debug mode */ + else if (!strcmp(argv[a],"-V")) { + fprintf(stderr, "mppnccombine version: %s\n", version); + fprintf(stderr, "Last updated: %s\n", last_updated); + exit(0); + } + else if (!strcmp(argv[a],"-M")) print_mem_usage=1; + else if (!strcmp(argv[a],"-x")) { + mem_dry_run=1; + } + else if (!strcmp(argv[a],"-a")) appendnc=1; + else if (!strcmp(argv[a],"-r")) removein=1; + else if (!strcmp(argv[a],"-f")) force=1; + else if (!strcmp(argv[a],"-n")) + { + a++; + if (a < argc) nstart=atoi(argv[a]); + else + { + usage(); return(1); + } + } + else if (!strcmp(argv[a],"-k")) + { + a++; + if (a < argc) bf=atoi(argv[a]); + else + { + usage(); return(1); + } + if (mem_dry_run) continue; + if (bf > MAX_BF) + { + fprintf(stderr, "Warning: k is set to high. Choosing a more sane value of %d.\n", MAX_BF); + bf = MAX_BF; + } + } + else if (!strcmp(argv[a],"-d")) + { + a++; + if (a < argc) defl=atoi(argv[a]); + else + { + usage(); return(1); + } + } + else if (!strcmp(argv[a],"-e")) + { + a++; + if (a < argc) nend=atoi(argv[a]); + else + { + usage(); return(1); + } + } + else if (!strcmp(argv[a],"-h")) + { + a++; + if (a < argc) headerpad=atoi(argv[a]); + else + { + usage(); return(1); + } + } + else if (!strcmp(argv[a],"-64")) + format=(NC_NOCLOBBER | NC_64BIT_OFFSET); + else if (!strcmp(argv[a], "-n4")) + format=(NC_NOCLOBBER | NC_NETCDF4 | NC_CLASSIC_MODEL); + else if (!strcmp(argv[a],"-m")) missing=1; + else + { + outputarg=a; break; + } + } + if (outputarg==(-1)) + { + usage(); return(1); + } + if (argc-1 > outputarg) inputarg=outputarg+1; + sprintf(outfilename,argv[outputarg]); outlen=strlen(outfilename); + if (outlen > 4) + { + strptr=outfilename+outlen-5; + if (!strcmp(strptr,".0000")) outfilename[outlen-5]='\0'; + } + + + /* if -x (estimate memory usage) is set, k will be automatically set to 1 */ + if (mem_dry_run) { + if (bf != 1) fprintf(stderr, "-x is set, so blocking factor will be set to 1. The -k option will be ignored.\n"); + bf = 1; + if (verbose) printf("This run will estimate peak memory resident size. No output file will be created.\n"); + } + + /* Disable fatal returns from netCDF library functions */ + ncopts=0; + + if (!mem_dry_run) { + /* Create a new netCDF output file */ + if ((ncoutfile=(struct fileinfo *)malloc(sizeof(struct fileinfo)))==NULL) + { + fprintf(stderr,"Error: cannot allocate enough memory!\n"); return(1); + } + if (!appendnc) + { + if (stat(outfilename,&statbuf)==0) + { + fprintf(stderr,"Error: output file seems to exist already!\n"); + free(ncoutfile); return(1); + } +// TN + if (nc_set_chunk_cache(NEW_CACHE_SIZE, NEW_CACHE_NELEMS, + NEW_CACHE_PREEMPTION)) + { + fprintf(stderr,"Warning: No new cache size possible!\n"); + } + fprintf(stderr,"Cache: %d %d %f %d\n",NEW_CACHE_SIZE,NEW_CACHE_NELEMS,NEW_CACHE_PREEMPTION,NC_SIZEHINT_DEFAULT ); +// TN status = nc__create(outfilename, format, 0, &blksz, &ncoutfile->ncfid); + status = nc__create(outfilename, format, 0, NC_SIZEHINT_DEFAULT, &ncoutfile->ncfid); + if (status==(-1)) + { + fprintf(stderr,"Error: cannot create the output netCDF file!\n"); + free(ncoutfile); return(1); + } + ncsetfill(ncoutfile->ncfid,NC_NOFILL); + } + /* Open an existing netCDF file for appending */ + else + { + if ((ncoutfile->ncfid=ncopen(outfilename,NC_WRITE))==(-1)) + { + fprintf(stderr,"Error: cannot open the output netCDF file for appending!\n"); + free(ncoutfile); return(1); + } + } + } + + /* No input files are specified on the command-line */ + if (inputarg==(-1)) + { + int num_infiles_used = 0; /* we may use only a subset of the input files */ + if (nend > -1) + for (block=0; block < nblocks; block++) + { + if (verbose) printf("block = %d\n",block); + f=0; + for (a=nstart; a <= nend; a++) + { + if (peWidth<0) + { + sprintf(infilename,"%s.%04d",outfilename,a); + if (stat(infilename,&statbuf)==0) + { + peWidth=4; + } + else + { + sprintf(infilename,"%s.%06d",outfilename,a); + if (stat(infilename,&statbuf)==0) + { + peWidth=6; + } + else + { + continue; + } + } + } + sprintf(infilename,"%s.%0*d",outfilename,peWidth,a); + if (stat(infilename,&statbuf)!=0){ + if (force==0) { + printf("ERROR: missing at least %s from the input fileset. Exiting.\n", infilename); + unlink(outfilename); + return 9; + }else{ + infileerrors=1; + } + } + if (verbose) + { + if (block==0) printf(" n files to go... "); + else printf(" %d files to go... ",num_infiles_used-f); + printf("processing \"%s\"\n",infilename); + } + infileerror=process_file(infilename,appendnc,ncoutfile, + outfilename,&nfiles,&nrecs,&nblocks,&bf,block,f, + headerpad,verbose,missing,defl); + if (infileerror) infileerrors=1; + appendnc=1; f++; + if (f==nfiles || a==nend) + { + if (mem_dry_run) { + print_estimated_mem_footprint(verbose); + exit(0); + } + if (verbose > 1) + printf(" Write variables from previous %d files\n",f); + for (r=block * bf; r 0) nend=nstart+nfiles; + appendnc=1; f++; + if (f==nfiles || a==(nend-1)) + { + if (mem_dry_run) { + print_estimated_mem_footprint(verbose); + exit(0); + } + if (verbose > 1) + printf(" Write variables from previous %d files\n",f); + for (r=block*bf; r 1) + printf(" Write variables from previous %d files\n",f); + for (r=block*bf; rncfid); free(ncoutfile); + if ((!infileerrors) && (!outfileerrors)) + { + if (removein) + { + /* No input files are specified on the command-line */ + if (inputarg==(-1)) + { + f=0; + for (a=nstart; a <= nend; a++) + { + // commenting line below, as it's a bug + // occasionally nfiles may be wrongly set to zero, + // and yet the user wants to remove the input files in a range. + //if (++f > nfiles) break; + if (peWidth<0) + { + sprintf(infilename,"%s.%04d",outfilename,a); + if (stat(infilename,&statbuf)==0) + { + peWidth=4; + } + else + { + sprintf(infilename,"%s.%06d",outfilename,a); + if (stat(infilename,&statbuf)==0) + { + peWidth=6; + } + else + { + continue; + } + } + } + sprintf(infilename,"%s.%0*d",outfilename,peWidth,a); + if (stat(infilename,&statbuf)!=0) continue; + if (verbose) printf("Removing \"%s\"\n",infilename); + unlink(infilename); + } + } + /* Loop over all the specified input files */ + else + for (a=inputarg; a < argc; a++) + { + if (stat(argv[a],&statbuf)!=0) continue; + if (verbose) printf("Removing \"%s\"\n",argv[a]); + unlink(argv[a]); + } + } + } + else + fprintf(stderr,"Warning: output file may be incomplete!\n"); + return(infileerrors); + } + + +/* Print the usage message for mppnccombine */ +void usage() + { + printf("mppnccombine %s - (written by Hans.Vahlenkamp)\n\n", version); + printf("Usage: mppnccombine [-v] [-V] [-M] [-a] [-r] [-n #] [-k #] [-e #] [-h #] [-64] [-n4] [-m]\n"); + printf(" output.nc [input ...]\n\n"); + printf(" -v Print some progress information.\n"); + printf(" -V Print version information.\n"); + printf(" -M Print memory usage statistics.\n"); + printf(" -f Force combine to happen even if input files are missing.\n"); + printf(" -a Append to an existing netCDF file (not heavily tested...).\n"); + printf(" -r Remove the \".####\" decomposed files after a successful run.\n"); + printf(" -n # Input filename extensions start with number #### instead of 0000.\n"); + printf(" -k # Blocking factor. k records are read from an input file at a time.\n"); + printf(" Valid values are between 0 and %d. For a given input, the maximum\n", MAX_BF); + printf(" permissible value for k is min(total number of records, %d).\n", MAX_BF); + printf(" Setting k to zero will set the blocking factor to this maximum\n"); + printf(" permissible value. Setting k to a value higher than this value,\n"); + printf(" will make the system implictly set k to the highest permissible value.\n"); + printf(" A value of 1 for k disables blocking. This is the default behavior.\n"); + printf(" Blocking often improves performance, but increases the peak memory\n"); + printf(" footprint (by the blocking factor). Beware of running out of\n"); + printf(" available physical memory and causing swapping to disk due to\n"); + printf(" large blocking factors and/or large input datasets.\n"); + printf(" A value of 10 for k has worked well on many input datasets.\n"); + printf(" See -x for estimating memory usage for a given input set.\n"); + printf(" -e # Ending number #### of a specified range of input filename extensions.\n"); + printf(" Files within the range do not have to be consecutively numbered.\n"); + printf(" -h # Add a specified number of bytes of padding at the end of the header.\n"); + printf(" -64 Create netCDF output files with the 64-bit offset format.\n"); + printf(" -n4 Create netCDF output files in NETCDF4_CLASSIC mode (no v4 enhanced features).\n"); + printf(" -m Initialize output variables with a \"missing_value\" from the variables\n"); + printf(" of the first input file instead of the default 0 value.\n"); + printf(" -x Print an estimate for peak memory resident size in (MB) and exit.\n"); + printf(" No output file will be created. Setting -x automatically sets\n"); + printf(" the blocking factor (-k) to 1. Any value set for -k on the\n"); + printf(" command-line will be ignored. To estimate memory usage for a\n"); + printf(" a different blocking factor, simply multiply the estimate by k.\n\n"); + printf(" -d # Deflating level for NC4 (-n4) format. Default=no compression\n"); + printf("mppnccombine joins together an arbitrary number of netCDF input files, each\n"); + printf("containing parts of a decomposed domain, into a unified netCDF output file.\n"); + printf("An output file must be specified and it is assumed to be the first filename\n"); + printf("argument. If the output file already exists, then it will not be modified\n"); + printf("unless the option is chosen to append to it. If no input files are specified\n"); + printf("then their names will be based on the name of the output file plus the default\n"); + printf("numeric extension \".0000\", which will increment by 1. There is an option for\n"); + printf("starting the filename extensions with an arbitrary number instead of 0. There\n"); + printf("is an option for specifying an end to the range of filename extension numbers;\n"); + printf("files within the range do not have to be consecutively numbered. If input\n"); + printf("files are specified then names will be used verbatim.\n\n"); + printf("A value of 0 is returned if execution completed successfully; a value of 1\n"); + printf("otherwise.\n"); + } + + +inline int min(int a, int b) +{ + if (ancfid=ncopen(ncname,NC_NOWRITE))==(-1)) + { + fprintf(stderr,"Error: cannot open input file \"%s\"\n",ncname); + free(ncinfile); return(1); + } + + /* Determine the number of files in the decomposed domain */ + if (ncattget(ncinfile->ncfid,NC_GLOBAL,"NumFilesInSet", + (void *)&nfiles2)==(-1)) + { + if (*nfiles==1) + { + fprintf(stderr,"Error: missing the \"NumFilesInSet\" global attribute!\n"); + return(1); + } + else if (*nfiles==(-1)) + { + fprintf(stderr,"Warning: missing the \"NumFilesInSet\" global attribute.\n"); + } + } + *nfiles=nfiles2; + + /* Get some general information about the input netCDF file */ + if (ncinquire(ncinfile->ncfid,&(ncinfile->ndims),&(ncinfile->nvars), + &(ncinfile->ngatts),&(ncinfile->recdim))==(-1)) + { + fprintf(stderr,"Error: cannot read the file's metadata!\n"); + ncclose(ncinfile->ncfid); free(ncinfile); return(1); + } + + /* Get some information about the dimensions */ + for (d=0; d < ncinfile->ndims; d++) + { + if ((ncdiminq(ncinfile->ncfid,d,ncinfile->dimname[d], + &(ncinfile->dimsize[d])))==(-1)) + { + fprintf(stderr,"Error: cannot read dimension #%d's metadata!\n",d); + ncclose(ncinfile->ncfid); free(ncinfile); return(1); + } + ncinfile->dimfullsize[d]=ncinfile->dimsize[d]; + ncinfile->dimstart[d]=1; ncinfile->dimend[d]=(-1); + } + + /* Save some information for the output file */ + if ((block==0) && (!mem_dry_run)) + { + ncoutfile->nvars=ncinfile->nvars; ncoutfile->recdim=ncinfile->recdim; + } + + /* Get some information about the variables */ + for (v=0; v < ncinfile->nvars; v++) + { + if ((ncvarinq(ncinfile->ncfid,v,ncinfile->varname[v], + &(ncinfile->datatype[v]),&(ncinfile->varndims[v]), + ncinfile->vardim[v],&(ncinfile->natts[v])))==(-1)) + { + fprintf(stderr,"Error: cannot read variable #%d's metadata!\n",v); + ncclose(ncinfile->ncfid); free(ncinfile); return(1); + } + + /* If the variable is also a dimension then get decomposition info */ + if ((dimid=ncdimid(ncinfile->ncfid,ncinfile->varname[v]))!=(-1)) + { + if (ncattget(ncinfile->ncfid,v,"domain_decomposition", + (void *)decomp)!=(-1)) + { + /* the dimension is decomposed */ + ncinfile->dimfullsize[dimid]=decomp[1]-decomp[0]+1; + ncinfile->dimstart[dimid]=decomp[2]-(decomp[0]-1); + ncinfile->dimend[dimid]=decomp[3]-(decomp[0]-1); + } + else + { + /* the dimension is NOT decomposed */ + ncinfile->dimfullsize[dimid]=ncinfile->dimsize[dimid]; + ncinfile->dimstart[dimid]=1; ncinfile->dimend[dimid]=(-1); + } + } + } + + /* Get some additional information about the variables */ + for (v=0; v < ncinfile->nvars; v++) + { + + /* start by assuming the variable has no decomposed dimension */ + ncinfile->vardecomp[v]=0; + + /* now, iterate over the variable's dimensions and mark the */ + /* variable as a decomposed variable if any dimension of */ + /* the variable is decomposed */ + for (d=0; d < ncinfile->varndims[v]; d++) + { + /* Does the variable have a decomposed dimension? */ + if (ncinfile->dimend[ncinfile->vardim[v][d]]!=(-1)) + { + ncinfile->vardecomp[v]=1; break; + } + } + + /* Save some information for the output file */ + /* This only needs to be done once per output file */ + if ((block==0) && (!mem_dry_run)) + { + ncoutfile->varndims[v]=ncinfile->varndims[v]; + for (d=0; d < ncinfile->ndims; d++) + ncoutfile->dimfullsize[d]=ncinfile->dimfullsize[d]; + for (d=0; d < ncinfile->varndims[v]; d++) + ncoutfile->vardim[v][d]=ncinfile->vardim[v][d]; + ncoutfile->vardecomp[v]=ncinfile->vardecomp[v]; + strcpy(ncoutfile->varname[v],ncinfile->varname[v]); +// ncoutfile->varmiss[v]=0; + } + } + + /* If the output netCDF file was just created then define its structure */ + if ((!appendnc) && (!mem_dry_run)) + { + if (verbose) printf(" Creating output \"%s\"\n",outncname); + + /* Define the dimensions */ + for (d=0; d < ncinfile->ndims; d++) + { + if (d==ncinfile->recdim) + ncdimdef(ncoutfile->ncfid,ncinfile->dimname[d],NC_UNLIMITED); + else ncdimdef(ncoutfile->ncfid,ncinfile->dimname[d], + ncinfile->dimfullsize[d]); + } + + /* Define the variables and copy their attributes */ + for (v=0; v < ncinfile->nvars; v++) + { + ncoutfile->varmiss[v]=0; + varID=ncvardef(ncoutfile->ncfid,ncinfile->varname[v],ncinfile->datatype[v], + ncinfile->varndims[v],ncinfile->vardim[v]); + if (defl>0) { + if (rc=nc_def_var_deflate(ncoutfile->ncfid,varID,0,1,defl) != NC_NOERR) { + printf("deflation not possible %d %d\n",NC_NOERR, rc); exit(1); + } +// fprintf(stderr,"VARS: %s #dims %d\n",ncoutfile->varname[v],ncoutfile->varndims[v]); + if (ncoutfile->varndims[v]==4) { + for (dims=0; dimsvarndims[v]; dims++) + { +// fprintf(stderr,"DIMS: %d Name: %s Size: %d",ncoutfile->vardim[v][dims],ncinfile->dimname[ncoutfile->vardim[v][dims]], +// ncoutfile->dimfullsize[ncoutfile->vardim[v][dims]]); + if (ncoutfile->vardim[v][dims]==ncoutfile->recdim) { +// fprintf(stderr," RECDIM\n"); + chunksize[dims]=1; + } else { +// fprintf(stderr," NO-RECDIM\n"); + chunksize[dims]=ncoutfile->dimfullsize[ncoutfile->vardim[v][dims]]; + } + } +// chunking z-axis, could be done more clever + chunksize[1]=10; + rc=nc_def_var_chunking(ncoutfile->ncfid,varID,NC_CHUNKED,chunksize); + fprintf(stderr,"RC: %d\n",rc); + } + } + for (n=0; n < ncinfile->natts[v]; n++) + { + ncattname(ncinfile->ncfid,v,n,attname); + if (missing) + { + if (!strcmp(attname,"missing_value")) + { + ncoutfile->varmiss[v]=1; + ncattget(ncinfile->ncfid,v,"missing_value", + (void *)(ncoutfile->varmissval[v])); + } + } + if (!strcmp(attname,"domain_decomposition")) continue; + else + { + if (ncattcopy(ncinfile->ncfid,v,attname,ncoutfile->ncfid,v)==(-1)) + { + fprintf(stderr,"Error: cannot copy variable \"%s\"'s attributes!\n", + ncinfile->varname[v]); + free(ncinfile); return(1); + } + } + } + } + + /* Copy the global attributes */ + for (n=0; n < ncinfile->ngatts; n++) + { + ncattname(ncinfile->ncfid,NC_GLOBAL,n,attname); + if (!strcmp(attname,"NumFilesInSet")) continue; + else if (!strcmp(attname,"filename")) + ncattput(ncoutfile->ncfid,NC_GLOBAL,attname,NC_CHAR, + strlen(outncname),(void *)outncname); + else + { + if (ncattcopy(ncinfile->ncfid,NC_GLOBAL,attname,ncoutfile->ncfid, + NC_GLOBAL)==(-1)) + { + fprintf(stderr,"Error: cannot copy the file's global attributes!\n"); + return(1); + } + } + } + + /* Definitions done */ + nc__enddef(ncoutfile->ncfid,headerpad,4,0,4); + } + + /* Copy all data values of the dimensions and variables to memory */ + /* For non-decomposed variables, process_vars will write them to the */ + /* output file. Decomposed variables for N records from this file will */ + /* be written to memory, where they will eventually get merged with those */ + /* from other input files */ + int r = block * (*bf); // the position of r is absolute + unsigned long mem_for_rec, tmp_mem_alloc; + do + { + tmp_mem_alloc = mem_allocated; /* store current memory usage in a temporary */ + ncinfileerror+=process_vars(ncinfile,ncoutfile,appendnc,nrecs,nblocks,bf,r,*nfiles, + f,verbose,missing); + mem_for_rec= mem_allocated - tmp_mem_alloc; + if (verbose && print_mem_usage) + if (mem_for_rec > 0) printf(" mem alloc for r=%d, infile=%s is %lu KB\n", r, ncname, mem_for_rec/1024); + r++; + appendnc = 1; + } while (rncfid); +/* ncclose(ncinfile->ncfid); free(ncinfile); return(ncinfileerror); */ + ncclose(ncinfile->ncfid); + return(ncinfileerror); + } + + +/* Decomposed variables from an input file and record will be written to memory */ +/* non-decomposed variables will be written to the output file */ +int process_vars(struct fileinfo *ncinfile, struct fileinfo *ncoutfile, + unsigned char appendnc, int *nrecs, int *nblocks, int* bf, int r, int nfiles, + int f, unsigned char verbose, unsigned char missing) + { + int v, d, i, j, k, l, b, s; /* Loop variables */ + int dimid; /* ID of a dimension */ + void *values = NULL; /* Current data values */ + long instart[MAX_NC_DIMS], outstart[MAX_NC_DIMS]; /* Data array sizes */ + long count[MAX_NC_DIMS]; /* " */ + long long recsize; /* Decomposed size of one record of a variable */ + long long recfullsize; /* Non-decomposed size of one record of a variable */ + int varrecdim; /* Variable's record dimension */ + static unsigned char first=1; /* First time reading variables? */ + int imax, jmax, kmax, lmax; + int imaxfull, jmaxfull, kmaxfull, lmaxfull; + int imaxjmaxfull, imaxjmaxkmaxfull; + int offset, ioffset, joffset, koffset, loffset; + int recdimsize; /* Using a local recdimsize to correct issue when netcdf file does not have a record dimension */ + long long varbufsize; + + if ( ncinfile->recdim < 0 ) + recdimsize=1; + else + recdimsize=ncinfile->dimsize[ncinfile->recdim]; + + /* Check the number of records */ + if (*nrecs==1) + { + *nrecs=recdimsize; + + if ((*bf) >= 1) + { + if ((*bf) > (*nrecs)) { + fprintf(stderr, "blocking factor (k) > total records (%d). Setting blocking factor to %d.\n", + *nrecs, *nrecs); + *bf = *nrecs; + } + if (((*nrecs) % (*bf)) != 0) *nblocks = (int)((*nrecs)/(*bf)) + 1; + else *nblocks = (int)((*nrecs)/(*bf)); + } + else + { + /* bf was set to zero, so we do full buffering */ + *bf = min(MAX_BF,*nrecs); // we use the maximum blocking factor in our capacity + /* normally we'll have one block, unless we hit MAX_BF */ + *nblocks = (int)((*nrecs)/(*bf)); + } + if (verbose) fprintf(stderr, "blocking factor=%d, num. blocks=%d, num. records=%d\n",*bf,*nblocks, *nrecs); + } + else + if (recdimsize != *nrecs) + { + fprintf(stderr,"Error: different number of records than the first input file!\n"); + return(1); + } + + /* Allocate memory for the decomposed variables, if none has been allocated yet + We use an optimized algorithm to malloc and set up a double dimension array + using a single malloc call. We do the cross-linking after the malloc, so + the entire allocation appears to be a double-dimensional array. The memory + allocated below is a trivial amount. The real allocation will happen later. + This allocation is done exactly once in the whole program */ + if (varbuf == NULL) { + int nbytes = (*bf)*sizeof(void**) + ((*bf) * MAX_NC_VARS* sizeof(void *)); + if (verbose || print_mem_usage) fprintf(stderr, "allocating a buffer of %d bytes for the multi-dimensional pointer array\n", nbytes); + if (mem_dry_run) estimated_maxrss += nbytes; + varbuf = (void ***)calloc(nbytes, 1); + if (varbuf == NULL) { + fprintf(stderr, "Could not allocate a memory of size %lu bytes\n", sizeof(void*)*(*bf)*MAX_NC_VARS); + exit(1); + } + /* now initialize the buffer to create a mult-dimensional array */ + int z; + for (z=0; z<(*bf); z++) { + varbuf[z] = (void**) ((size_t)varbuf + (*bf)*sizeof(void**) + z*MAX_NC_VARS*sizeof(void*)); + } + /* The nested memory alloc works fine, but it involves multiple malloc calls. + varbuf = (void ***)malloc((*bf) * sizeof(void **)); + if (varbuf == NULL) { + fprintf(stderr, "Could not allocate memory\n"); + exit(1); + } + int z; + for (z=0; z<(*bf); z++) { + varbuf[z] = calloc(MAX_NC_VARS*sizeof(void*),1); + if (varbuf == NULL) { + fprintf(stderr, "Could not allocate memory\n"); + exit(1); + } + } + */ + } /* end of memory allocation, done once per block */ + + /* Loop over all the variables */ + for (v=0; v < ncinfile->nvars; v++) + { + if (verbose > 1) printf(" variable = %s\n",ncinfile->varname[v]); + + /* Get read/write dimension sizes for the variable */ + recsize=1; recfullsize=1; varrecdim=(-1); + outstart[0]=0; outstart[1]=0; outstart[2]=0; outstart[3]=0; + for (d=0; d < ncinfile->varndims[v]; d++) + { + if (ncinfile->vardim[v][d]==ncinfile->recdim) + { + count[d]=1; varrecdim=d; + } + else + { + count[d]=ncinfile->dimsize[ncinfile->vardim[v][d]]; + recsize*=count[d]; instart[d]=0; + outstart[d]=ncinfile->dimstart[ncinfile->vardim[v][d]]-1; + recfullsize*=ncinfile->dimfullsize[ncinfile->vardim[v][d]]; + } + if (verbose > 1) + printf(" dim %d: instart=%ld outstart=%ld count=%ld\n",d, + instart[d],outstart[d],count[d]); + } + + /* Prevent unnecessary reads/writes */ + if (r > 0) + { + /* Prevent unnecessary reads/writes of the dimensions */ + if ((dimid=ncdimid(ncinfile->ncfid,ncinfile->varname[v]))!=(-1)) + { + if (ncinfile->recdim==dimid) + { + if (f!=0) continue; + } + else continue; + } + /* Prevent unnecessary reads/writes of the variables */ + else + { + /* Prevent unnecessary reads/writes of non-decomposed variables + if (ncinfile->vardecomp[v]!=1 && appendnc) continue; */ + + /* Non-record variables */ + if (varrecdim==(-1)) continue; + + /* Non-decomposed record variables */ + if (ncinfile->vardecomp[v]!=1 && f > 0) continue; + } + } + else + { + if (ncinfile->vardecomp[v]!=1 && appendnc) continue; + } + + /* Allocate a buffer for the variable's record */ + if ((values=malloc(nctypelen(ncinfile->datatype[v])*recsize))==NULL) + { + fprintf(stderr,"Error: cannot allocate %lld bytes for decomposed variable \"%s\"'s values!\n", + nctypelen(ncinfile->datatype[v])*recsize,ncinfile->varname[v]); + return(1); + } + + /* Read the variable */ + if (varrecdim!=(-1)) instart[varrecdim]=outstart[varrecdim]=r; + if (ncvarget(ncinfile->ncfid,v,instart,count,values)==(-1)) + { + fprintf(stderr,"Error: cannot read variable \"%s\"'s values!\n", + ncinfile->varname[v]); + return(1); + } + + /* Write the buffered variable immediately if it's not decomposed */ + if ((ncinfile->vardecomp[v]!=1) && (!mem_dry_run)) + { + if (verbose > 1) + printf(" writing %lld bytes to file\n", + nctypelen(ncinfile->datatype[v])*recsize); + if (ncvarput(ncoutfile->ncfid,v,outstart,count,values)==(-1)) + { + fprintf(stderr,"Error: cannot write variable \"%s\"'s values!\n", + ncinfile->varname[v]); + return(1); + } + } + /* Save the buffer */ + else + { + /* Allocate a buffer for the variable's non-decomposed record size */ + /* rather than checking for whether this is the first file, and so */ + /* we do this once per record per variable for each block */ + /* if (f==0) */ + if (varbuf[(r % (*bf))][v] == NULL) + { + varbufsize=nctypelen(ncinfile->datatype[v])*recfullsize; + if (verbose && print_mem_usage) + printf(" allocating %lld bytes for full domain of variable %s\n", + varbufsize, ncinfile->varname[v]); + if (mem_dry_run) { + estimated_maxrss += varbufsize; + varbuf[(r % (*bf))][v] = "deadbeef"; + continue; + } + if ((varbuf[(r % (*bf))][v]=calloc(varbufsize,1))==NULL) + { + fprintf(stderr,"Error: cannot allocate %lld bytes for entire variable \"%s\"'s values!\n", + varbufsize,ncinfile->varname[v]); return(1); + } + mem_allocated += varbufsize; +// printf("CCCCC %d %d %d\n",v,missing, ncoutfile->varmiss[v]); + if (missing && ncoutfile->varmiss[v]) + switch (ncinfile->datatype[v]) + { + case NC_BYTE: + case NC_CHAR: + for (s=0; s < recfullsize; s++) + *((unsigned char *)(varbuf[(r % (*bf))][v])+s)= + *((unsigned char *)(ncoutfile->varmissval[v])); + break; + case NC_SHORT: + for (s=0; s < recfullsize; s++) + *((short *)(varbuf[(r % (*bf))][v])+s)= + *((short *)(ncoutfile->varmissval[v])); + break; + case NC_INT: + for (s=0; s < recfullsize; s++) + *((int *)(varbuf[(r % (*bf))][v])+s)= + *((int *)(ncoutfile->varmissval[v])); + break; + case NC_FLOAT: + for (s=0; s < recfullsize; s++) + *((float *)(varbuf[(r % (*bf))][v])+s)= + *((float *)(ncoutfile->varmissval[v])); + break; + case NC_DOUBLE: + for (s=0; s < recfullsize; s++) + *((double *)(varbuf[(r % (*bf))][v])+s)= + *((double *)(ncoutfile->varmissval[v])); + break; + } + } + if (varbuf[(r % (*bf))][v]==NULL) + { + fprintf(stderr,"Internal memory usage error!\n"); exit(1); + } + if (mem_dry_run) continue; + if (verbose > 1) + printf(" writing %lld bytes to memory\n", + nctypelen(ncinfile->datatype[v])*recsize); + + imax=ncinfile->dimsize[ncinfile->vardim[v][ncinfile->varndims[v]-1]]; + if (ncinfile->varndims[v] > 1) + { + dimid=ncinfile->vardim[v][ncinfile->varndims[v]-2]; + if (dimid==ncinfile->recdim) jmax=1; + else jmax=ncinfile->dimsize[dimid]; + } + else jmax=1; + if (ncinfile->varndims[v] > 2) + { + dimid=ncinfile->vardim[v][ncinfile->varndims[v]-3]; + if (dimid==ncinfile->recdim) kmax=1; + else kmax=ncinfile->dimsize[dimid]; + } + else kmax=1; + if (ncinfile->varndims[v] > 3) + { + dimid=ncinfile->vardim[v][ncinfile->varndims[v]-4]; + if (dimid==ncinfile->recdim) lmax=1; + else lmax=ncinfile->dimsize[dimid]; + } + else lmax=1; + if (verbose > 1) + printf(" imax=%d jmax=%d kmax=%d lmax=%d\n",imax,jmax, + kmax,lmax); + + imaxfull=ncinfile->dimfullsize[ncinfile->vardim[v][ncinfile->varndims[v]-1]]; + if (ncinfile->varndims[v] > 1) + jmaxfull=ncinfile->dimfullsize[ncinfile->vardim[v][ncinfile->varndims[v]-2]]; + else jmaxfull=1; + if (ncinfile->varndims[v] > 2) + kmaxfull=ncinfile->dimfullsize[ncinfile->vardim[v][ncinfile->varndims[v]-3]]; + else kmaxfull=1; + if (ncinfile->varndims[v] > 3) + { + if (ncinfile->vardim[v][ncinfile->varndims[v]-4]!=ncinfile->recdim) + lmaxfull=ncinfile->dimfullsize[ncinfile->vardim[v][ncinfile->varndims[v]-4]]; + else lmaxfull=1; + } + else lmaxfull=1; + if (verbose > 1) + printf(" imaxfull=%d jmaxfull=%d kmaxfull=%d lmaxfull=%d\n", + imaxfull,jmaxfull,kmaxfull,lmaxfull); + imaxjmaxfull=imaxfull*jmaxfull; + imaxjmaxkmaxfull=imaxfull*jmaxfull*kmaxfull; + + ioffset=outstart[ncinfile->varndims[v]-0-1]; + if (ncinfile->varndims[v] > 1) + joffset=outstart[ncinfile->varndims[v]-1-1]; + else joffset=0; + if (ncinfile->varndims[v] > 2) + koffset=outstart[ncinfile->varndims[v]-2-1]; + else koffset=0; + if (ncinfile->varndims[v] > 3) + loffset=outstart[ncinfile->varndims[v]-3-1]; + else loffset=0; + if (varrecdim!=(-1)) + { + switch (ncinfile->varndims[v]) + { + case 1: + ioffset=0; + break; + case 2: + joffset=0; + break; + case 3: + koffset=0; + break; + case 4: + loffset=0; + break; + } + } + if (verbose > 1) + printf(" ioffset=%d joffset=%d koffset=%d loffset=%d\n", + ioffset,joffset,koffset,loffset); + switch (ncinfile->datatype[v]) + { + case NC_BYTE: + case NC_CHAR: + if (verbose > 1) printf(" start copying byte/char\n"); + b=0; + for (l=0; l < lmax; l++) + for (k=0; k < kmax; k++) + for (j=0; j < jmax; j++) + for (i=0; i < imax; i++) + { + offset=(i+ioffset)+ + (j+joffset)*imaxfull+ + (k+koffset)*imaxjmaxfull+ + (l+loffset)*imaxjmaxkmaxfull; + *((unsigned char *)(varbuf[(r % (*bf))][v])+offset)= + *((unsigned char *)values+(b++)); + } + if (verbose > 1) printf(" end copying byte/char\n"); + break; + case NC_SHORT: + if (verbose > 1) printf(" start copying short\n"); + b=0; + for (l=0; l < lmax; l++) + for (k=0; k < kmax; k++) + for (j=0; j < jmax; j++) + for (i=0; i < imax; i++) + { + offset=(i+ioffset)+ + (j+joffset)*imaxfull+ + (k+koffset)*imaxjmaxfull+ + (l+loffset)*imaxjmaxkmaxfull; + *((short *)(varbuf[(r % (*bf))][v])+offset)= + *((short *)values+(b++)); + } + if (verbose > 1) printf(" end copying short\n"); + break; + case NC_INT: + if (verbose > 1) printf(" start copying int\n"); + b=0; + for (l=0; l < lmax; l++) + for (k=0; k < kmax; k++) + for (j=0; j < jmax; j++) + for (i=0; i < imax; i++) + { + offset=(i+ioffset)+ + (j+joffset)*imaxfull+ + (k+koffset)*imaxjmaxfull+ + (l+loffset)*imaxjmaxkmaxfull; + *((int *)(varbuf[(r % (*bf))][v])+offset)= + *((int *)values+(b++)); + } + if (verbose > 1) printf(" end copying int\n"); + break; + case NC_FLOAT: + if (verbose > 1) printf(" start copying float\n"); + b=0; + for (l=0; l < lmax; l++) + for (k=0; k < kmax; k++) + for (j=0; j < jmax; j++) + for (i=0; i < imax; i++) + { + offset=(i+ioffset)+ + (j+joffset)*imaxfull+ + (k+koffset)*imaxjmaxfull+ + (l+loffset)*imaxjmaxkmaxfull; + *((float *)(varbuf[(r % (*bf))][v])+offset)= + *((float *)values+(b++)); + } + if (verbose > 1) printf(" end copying float\n"); + break; + case NC_DOUBLE: + if (verbose > 1) printf(" start copying double\n"); + b=0; + for (l=0; l < lmax; l++) + for (k=0; k < kmax; k++) + for (j=0; j < jmax; j++) + for (i=0; i < imax; i++) + { + offset=(i+ioffset)+ + (j+joffset)*imaxfull+ + (k+koffset)*imaxjmaxfull+ + (l+loffset)*imaxjmaxkmaxfull; + *((double *)(varbuf[(r % (*bf))][v])+offset)= + *((double *)values+(b++)); + } + if (verbose > 1) printf(" end copying double\n"); + break; + } + } + + /* Deallocate the decomposed variable's buffer */ + if (values != NULL) free(values); + } + first=0; return(0); + } + + +/* Write all the buffered decomposed variables to the output file */ +int flush_decomp(struct fileinfo *ncoutfile, int nfiles, int r, int bf, unsigned char verbose) + { + int v, d; /* Loop variable */ + long outstart[MAX_NC_DIMS]; /* Data array sizes */ + long count[MAX_NC_DIMS]; /* " */ + int varrecdim; /* Position of a variable's record dimension */ + + if (verbose > 1) + { + printf(" nvars=%d\n",ncoutfile->nvars); + } + + /* Write out all the decomposed variables */ + for (v=0; v < ncoutfile->nvars; v++) + { + if (ncoutfile->vardecomp[v]==0) continue; + if (verbose > 1) printf(" v=%d (%s)\n",v,ncoutfile->varname[v]); + varrecdim=(-1); + for (d=0; d < ncoutfile->varndims[v]; d++) + { + outstart[d]=0; + if (ncoutfile->vardim[v][d]==ncoutfile->recdim) + { + count[d]=1; varrecdim=d; + } + else + { + count[d]=ncoutfile->dimfullsize[ncoutfile->vardim[v][d]]; + } + if (verbose > 1) + printf(" d=%d: outstart=%ld count=%ld\n",d,outstart[d], + count[d]); + } + if (varrecdim!=(-1)) outstart[varrecdim]=r; + if (varrecdim==(-1) && r > 0) continue; + if (verbose > 1) + printf(" writing to disk\n"); + if (ncvarput(ncoutfile->ncfid,v,outstart,count,varbuf[(r % bf)][v])==(-1)) + { + fprintf(stderr,"Error: cannot write variable \"%d\"'s values!\n", + v); return(1); + } + } + return(0); + } + + +/* + U.S. Department of Commerce (DOC) Software License for "mppnccombine" + written at NOAA's Geophysical Fluid Dynamics Laboratory, Princeton + Forrestal Campus + + 1. Scope of License + + Subject to all the terms and conditions of this license, DOC grants USER the + royalty-free, nonexclusive, nontransferable, and worldwide rights to + reproduce, modify, and distribute "mppnccombine", herein referred to as the + PRODUCT. + + 2. Conditions and Limitations of Use + + Warranties. Neither the U.S. Government, nor any agency or employee + thereof, makes any warranties, expressed or implied, with respect to the + PRODUCT provided under this license, including but not limited to the + implied warranties or merchantability and fitness for any particular + purpose. + + Liability. In no event shall the U.S. Government, nor any agency or + employee thereof, be liable for any direct, indirect, or consequential + damages flowing from the use of the PRODUCT provided under this license. + + Non-Assignment. Neither this license nor any rights granted hereunder are + transferable or assignable without the explicit prior written consent of + DOC. + + Names and Logos. USER shall not substitute its name or logo for the name or + logo of DOC, or any of its agencies, in identification of the PRODUCT. + + Export of Technology. USER shall comply with all U.S. laws and regulations + restricting the export of the PRODUCT to other countries. + + Governing Law. This license shall be governed by the laws of United States + as interpreted and applied by the Federal courts in the District of + Columbia. + + 3. Term of License + + This license shall remain in effect as long as USER uses the PRODUCT in + accordance with Paragraphs 1 and 2. +*/ diff --git a/MOM_code/src/atmos_bgrid/documentation/decomposition.jpg b/MOM_code/src/atmos_bgrid/documentation/decomposition.jpg new file mode 100644 index 0000000..fea665a Binary files /dev/null and b/MOM_code/src/atmos_bgrid/documentation/decomposition.jpg differ diff --git a/MOM_code/src/atmos_bgrid/documentation/flowchart.jpg b/MOM_code/src/atmos_bgrid/documentation/flowchart.jpg new file mode 100644 index 0000000..8a03401 Binary files /dev/null and b/MOM_code/src/atmos_bgrid/documentation/flowchart.jpg differ diff --git a/MOM_code/src/atmos_bgrid/documentation/global_temp_grid.jpg b/MOM_code/src/atmos_bgrid/documentation/global_temp_grid.jpg new file mode 100644 index 0000000..a02bcc3 Binary files /dev/null and b/MOM_code/src/atmos_bgrid/documentation/global_temp_grid.jpg differ diff --git a/MOM_code/src/atmos_bgrid/documentation/global_vel_grid.jpg b/MOM_code/src/atmos_bgrid/documentation/global_vel_grid.jpg new file mode 100644 index 0000000..c6b5be4 Binary files /dev/null and b/MOM_code/src/atmos_bgrid/documentation/global_vel_grid.jpg differ diff --git a/MOM_code/src/atmos_bgrid/documentation/north_pole.jpg b/MOM_code/src/atmos_bgrid/documentation/north_pole.jpg new file mode 100644 index 0000000..90e86e3 Binary files /dev/null and b/MOM_code/src/atmos_bgrid/documentation/north_pole.jpg differ diff --git a/MOM_code/src/atmos_bgrid/documentation/south_pole.jpg b/MOM_code/src/atmos_bgrid/documentation/south_pole.jpg new file mode 100644 index 0000000..56aaac5 Binary files /dev/null and b/MOM_code/src/atmos_bgrid/documentation/south_pole.jpg differ diff --git a/MOM_code/src/atmos_bgrid/documentation/text.xbm b/MOM_code/src/atmos_bgrid/documentation/text.xbm new file mode 100644 index 0000000..7fd8c6a Binary files /dev/null and b/MOM_code/src/atmos_bgrid/documentation/text.xbm differ diff --git a/MOM_code/src/atmos_bgrid/documentation/time_steps.jpg b/MOM_code/src/atmos_bgrid/documentation/time_steps.jpg new file mode 100644 index 0000000..392a536 Binary files /dev/null and b/MOM_code/src/atmos_bgrid/documentation/time_steps.jpg differ diff --git a/MOM_code/src/atmos_bgrid/driver/coupled/atmosphere.F90 b/MOM_code/src/atmos_bgrid/driver/coupled/atmosphere.F90 new file mode 100644 index 0000000..bb5c451 --- /dev/null +++ b/MOM_code/src/atmos_bgrid/driver/coupled/atmosphere.F90 @@ -0,0 +1,514 @@ + +module atmosphere_mod + +!----------------------------------------------------------------------- +! +! interface for b-grid dynamical core and physics +! +!----------------------------------------------------------------------- +!---------------- m o d u l e i n f o r m a t i o n ------------------ + +use mpp_mod, only: input_nml_file +use bgrid_core_driver_mod, only: bgrid_dynam_type, & + bgrid_core_driver_init, & + bgrid_core_driver, & + bgrid_core_time_diff, & + bgrid_core_driver_end, & + get_bottom_data, & + put_bottom_data + +use bgrid_prog_var_mod, only: prog_var_type, var_init + +use bgrid_horiz_mod, only: get_horiz_grid_size, & + get_horiz_grid_bound, TGRID + +use time_manager_mod, only: time_type, get_time, operator(+) + +use fms_mod, only: file_exist, open_namelist_file, & + error_mesg, FATAL, WARNING, & + check_nml_error, stdlog, & + write_version_number, & + mpp_pe, mpp_root_pe, & + close_file, set_domain, & + mpp_clock_id, mpp_clock_begin, & + mpp_clock_end, MPP_CLOCK_SYNC, & + CLOCK_SUBCOMPONENT, NOTE + +use bgrid_vert_mod, only: compute_height_bottom +use bgrid_change_grid_mod, only: change_grid, WIND_GRID, TEMP_GRID + +use bgrid_physics_mod, only: bgrid_physics_down, bgrid_physics_up, & + bgrid_physics_init, bgrid_physics_end, & + surf_diff_type + +use mpp_domains_mod, only: domain2d + +use field_manager_mod, only: MODEL_ATMOS +use tracer_manager_mod, only: get_tracer_index, NO_TRACER +use xgrid_mod, only: grid_box_type + +!----------------------------------------------------------------------- + +implicit none +private + +public atmosphere_down, atmosphere_up, & + atmosphere_init, atmosphere_end, & + atmosphere_resolution, atmosphere_boundary, & + atmosphere_cell_area, atmosphere_restart, & + get_atmosphere_axes, atmosphere_domain + +public get_bottom_mass, get_bottom_wind + +public surf_diff_type, get_stock_pe + +!----------------------------------------------------------------------- + +character(len=128) :: version = '$Id: atmosphere.F90,v 19.0 2012/01/06 19:52:46 fms Exp $' +character(len=128) :: tag = '$Name: tikal $' + +!----------------------------------------------------------------------- +!---- namelist (saved in file input.nml) ---- +! +! physics_window The number of "i" by "j" rows processed each time +! the modular physics is called. To process the entire +! domain use physics_window = (/0,0/). +! [integer, default: physics_window = 0,1] + + integer, dimension(2) :: physics_window = (/0,1/) + + namelist /atmosphere_nml/ physics_window + +!----------------------------------------------------------------------- +!---- private data ---- + +type (bgrid_dynam_type), save :: Dynam +type (prog_var_type), save :: Var, Var_dt +type (time_type) :: Time_step_atmos + +real :: dt_atmos +real, dimension(:,:,:), pointer :: omega =>NULL() +integer, dimension(4) :: atmos_axes + +integer :: id_dynam, id_phys_down, id_phys_up +logical :: stock_warning_issued = .FALSE. + +!----------------------------------------------------------------------- + +contains + +!####################################################################### + + subroutine atmosphere_down (Time, frac_land, & + t_surf, albedo, albedo_vis_dir, & + albedo_nir_dir, albedo_vis_dif, & + albedo_nir_dif, rough_mom, & + u_star, b_star, q_star, & + dtau_du, dtau_dv, tau_x, tau_y, & + frac_open_sea, & + gust, coszen, flux_sw, flux_sw_dir, & + flux_sw_dif, & + flux_sw_down_vis_dir, flux_sw_down_vis_dif, & + flux_sw_down_total_dir, flux_sw_down_total_dif, & + flux_sw_vis, & + flux_sw_vis_dir, & + flux_sw_vis_dif, flux_lw, & + Surf_diff ) + +! +! Time = time at the current time level +! + + type(time_type),intent(in) :: Time + + real, intent(in), dimension(:,:) :: frac_land, & + t_surf, albedo, rough_mom, & + albedo_vis_dir, albedo_nir_dir, & + albedo_vis_dif, albedo_nir_dif, & + u_star, b_star, q_star, & + dtau_du, dtau_dv, frac_open_sea + real, intent(inout), dimension(:,:) :: tau_x, tau_y + real, intent(out), dimension(:,:) :: gust, coszen, flux_sw, & + flux_sw_dir, & + flux_sw_dif, & + flux_sw_down_vis_dir, & + flux_sw_down_vis_dif, & + flux_sw_down_total_dir, & + flux_sw_down_total_dif, & + flux_sw_vis, & + flux_sw_vis_dir, & + flux_sw_vis_dif, flux_lw + type(surf_diff_type), intent(inout) :: Surf_diff + + type(time_type) :: Time_prev, Time_next +!----------------------------------------------------------------------- + + Time_prev = Time ! two time-level scheme + Time_next = Time + Time_step_atmos + +!---- dynamics ----- + + call mpp_clock_begin (id_dynam) + call bgrid_core_driver ( Time_next, Var, Var_dt, Dynam, omega ) + call mpp_clock_end (id_dynam) + +!---- call physics ----- + + call mpp_clock_begin (id_phys_down) + call bgrid_physics_down (physics_window, dt_atmos, & + Time_prev, Time, Time_next, & + Dynam%Hgrid, Dynam%Vgrid, Dynam, & + Var, Var_dt, frac_land, & + albedo, albedo_vis_dir, albedo_nir_dir, & + albedo_vis_dif, albedo_nir_dif, & + rough_mom, t_surf, & + u_star, b_star, q_star, & + dtau_du, dtau_dv, tau_x, tau_y, & + flux_sw, & + flux_sw_dir, & + flux_sw_dif, & + flux_sw_down_vis_dir, & + flux_sw_down_vis_dif, & + flux_sw_down_total_dir, & + flux_sw_down_total_dif, & + flux_sw_vis, & + flux_sw_vis_dir, & + flux_sw_vis_dif, & + flux_lw, coszen, gust, & + Surf_diff, frac_open_sea ) + call mpp_clock_end (id_phys_down) + +!----------------------------------------------------------------------- + + end subroutine atmosphere_down + +!####################################################################### + + subroutine atmosphere_up (Time, frac_land, Surf_diff, lprec, fprec, gust, & + u_star, b_star, q_star ) + + type(time_type),intent(in) :: Time + real, intent(in), dimension(:,:) :: frac_land + type(surf_diff_type), intent(inout) :: Surf_diff + real, intent(out), dimension(:,:) :: lprec, fprec + real, intent(inout), dimension(:,:) :: gust + real, intent(in), dimension(:,:) :: u_star, b_star, q_star + + type(time_type) :: Time_prev, Time_next +!----------------------------------------------------------------------- +!------ call physics up ------ + + Time_prev = Time ! two time-level scheme + Time_next = Time + Time_step_atmos + + call mpp_clock_begin (id_phys_up) + call bgrid_physics_up (physics_window, dt_atmos, & + Time_prev, Time, Time_next, & + Dynam%Hgrid, Dynam%Vgrid, Dynam, & + Var, Var_dt, omega, & + frac_land, Surf_diff, & + lprec, fprec, gust, & + u_star, b_star, q_star ) + call mpp_clock_end (id_phys_up) + +!------ time differencing and diagnostics ------- + + call bgrid_core_time_diff ( omega, Time_next, Dynam, Var, Var_dt ) + +!----------------------------------------------------------------------- + + end subroutine atmosphere_up + +!####################################################################### + + subroutine atmosphere_init (Time_init, Time, Time_step, Surf_diff, Grid_box) + + type (time_type), intent(in) :: Time_init, Time, Time_step + type(surf_diff_type), intent(inout) :: Surf_diff + type(grid_box_type), intent(inout) :: Grid_box + + integer :: unit, sec, ierr, io, logunit + +!----------------------------------------------------------------------- +!----- read namelist ----- + + if (file_exist('input.nml')) then +#ifdef INTERNAL_FILE_NML + read (input_nml_file, nml=atmosphere_nml, iostat=io) + ierr = check_nml_error(io,'atmosphere_nml') +#else + unit = open_namelist_file ( ) + ierr=1; do while (ierr /= 0) + read (unit, nml=atmosphere_nml, iostat=io, end=10) + ierr = check_nml_error (io, 'atmosphere_nml') + enddo + 10 call close_file (unit) +#endif + endif + +!----- write version and namelist to log file ----- + + call write_version_number ( version, tag ) + logunit = stdlog() + if ( mpp_pe() == mpp_root_pe() ) write (logunit, nml=atmosphere_nml) + +!---- compute physics/atmos time step in seconds ---- + + Time_step_atmos = Time_step + call get_time (Time_step_atmos, sec) + dt_atmos = real(sec) + +!----- initialize dynamical core ----- + + call bgrid_core_driver_init ( Time_init, Time, Time_step, & + Var, Var_dt, Dynam, atmos_axes ) + +!----- initialize storage needed for vert motion ---- + + omega => var_init (Dynam%Hgrid, Dynam%Vgrid%nlev) + +!----- initialize physics interface ----- +!----- initialize domains for reading global physics data ----- + + call set_domain ( Dynam%Hgrid%Tmp%Domain_nohalo ) + + call bgrid_physics_init (atmos_axes, Time, Dynam%Hgrid, Dynam%Vgrid, Dynam, & + Var, Surf_diff) + +! ----- use entire grid as window ? ----- + + if (physics_window(1) <= 0) physics_window(1) = Dynam%Hgrid%Tmp%ie-Dynam%Hgrid%Tmp%is+1 + if (physics_window(2) <= 0) physics_window(2) = Dynam%Hgrid%Tmp%je-Dynam%Hgrid%Tmp%js+1 + +! --- initialize clocks for dynamics, physics_down and physics_up + + id_dynam = mpp_clock_id ('BGRID: dynamical core', & + flags=MPP_CLOCK_SYNC, grain=CLOCK_SUBCOMPONENT ) + id_phys_down = mpp_clock_id ('Physics_down', & + flags=MPP_CLOCK_SYNC, grain=CLOCK_SUBCOMPONENT ) + id_phys_up = mpp_clock_id ('Physics_up', & + flags=MPP_CLOCK_SYNC, grain=CLOCK_SUBCOMPONENT ) + +!----------------------------------------------------------------------- + + end subroutine atmosphere_init + +!####################################################################### + + subroutine atmosphere_end (Time, Grid_box) + + type (time_type), intent(in) :: Time + type(grid_box_type), intent(inout) :: Grid_box + integer :: unit + + + call bgrid_core_driver_end ( Var, Dynam ) + +!----- initialize domains for writing global physics data ----- + + call set_domain ( Dynam%Hgrid%Tmp%Domain_nohalo ) + + call bgrid_physics_end (Time) + + end subroutine atmosphere_end + + !####################################################################### + ! + ! + ! dummy routine. + ! + subroutine atmosphere_restart(timestamp) + character(len=*), intent(in) :: timestamp + + call error_mesg ('atmosphere_restart in atmosphere_mod', & + 'intermediate restart capability is not implemented for this model', FATAL) + + end subroutine atmosphere_restart + ! + +!####################################################################### +! returns the number of longitude and latitude grid points +! for either the local PEs grid (default) or the global grid + + subroutine atmosphere_resolution (nlon, nlat, global) + + integer, intent(out) :: nlon, nlat + logical, intent(in), optional :: global + +!---- return the size of the grid used for physics computations ---- + + call get_horiz_grid_size (Dynam % Hgrid, TGRID, nlon, nlat, global) + + end subroutine atmosphere_resolution + +!####################################################################### + subroutine atmosphere_cell_area(area_out) + real, dimension(:,:), intent(out) :: area_out + integer :: j + + do j=Dynam%Hgrid%Tmp%js,Dynam%Hgrid%Tmp%je + area_out(:,j-Dynam%Hgrid%Tmp%js+1) = Dynam%Hgrid%Tmp%area(j) + enddo + + end subroutine atmosphere_cell_area +!####################################################################### +! returns the longitude and latitude grid box edges +! for either the local PEs grid (default) or the global grid + + subroutine atmosphere_boundary (blon, blat, global) + + real, intent(out) :: blon(:,:), blat(:,:) + logical, intent(in), optional :: global + + real, dimension(size(blon,1)) :: rlonb + real, dimension(size(blat,2)) :: rlatb + integer :: i, j +!----- return the longitudinal and latitudinal grid box edges ---------- + + call get_horiz_grid_bound (Dynam % Hgrid, TGRID, rlonb, rlatb, global) + do i=1,size(blon,1) + blon(i,:) = rlonb(i) + end do + do j=1,size(blat,2) + blat(:,j) = rlatb(j) + end do + + end subroutine atmosphere_boundary + +!####################################################################### +! returns the domain2d variable associated with the coupling grid +! note: coupling is done using the mass/temperature grid with no halos + + subroutine atmosphere_domain (Domain) + type(domain2d), intent(inout) :: Domain + + Domain = Dynam % Hgrid % Tmp % Domain_nohalo + + end subroutine atmosphere_domain + +!####################################################################### +! returns the axis indices associated with the coupling grid + + subroutine get_atmosphere_axes ( axes ) + + integer, intent(out) :: axes (:) + +!----- returns the axis indices for the atmospheric (mass) grid ----- + + if ( size(axes(:)) < 0 .or. size(axes(:)) > 4 ) call error_mesg ( & + 'get_atmosphere_axes in atmosphere_mod', & + 'size of argument is incorrect', FATAL ) + + axes (1:size(axes(:))) = atmos_axes (1:size(axes(:))) + + end subroutine get_atmosphere_axes + +!####################################################################### +! returns temp, tracers, pres, height at the lowest model level +! and surface pressure and sea level pressure + + subroutine get_bottom_mass (t_bot, tr_bot, p_bot, z_bot, p_surf, slp) + + real, intent(out), & + dimension(Dynam%Hgrid%Tmp%is:Dynam%Hgrid%Tmp%ie,Dynam%Hgrid%Tmp%js:Dynam%Hgrid%Tmp%je) & + :: t_bot, p_bot, z_bot, p_surf, slp + real, intent(out), & + dimension(Dynam%Hgrid%Tmp%is:Dynam%Hgrid%Tmp%ie,Dynam%Hgrid%Tmp%js:Dynam%Hgrid%Tmp%je,Var%ntrace) :: tr_bot + + real, dimension(Dynam%Hgrid%Tmp%is:Dynam%Hgrid%Tmp%ie,Dynam%Hgrid%Tmp%js:Dynam%Hgrid%Tmp%je) :: q_bot + integer :: i, j, kb, sphum, n + integer :: is,ie,js,je + + + is = Dynam%Hgrid%Tmp%is; ie = Dynam%Hgrid%Tmp%ie + js = Dynam%Hgrid%Tmp%js; je = Dynam%Hgrid%Tmp%je + + sphum = get_tracer_index ( MODEL_ATMOS, 'sphum' ) + + do j = js, je + do i = is, ie + kb = Dynam%Masks%Tmp%kbot(i,j) + t_bot(i,j) = Var % t(i,j,kb) + enddo + enddo + + if(sphum == NO_TRACER) then + q_bot = 0.0 + else + do j = js, je + do i = is, ie + kb = Dynam%Masks%Tmp%kbot(i,j) + q_bot(i,j) = Var % r(i,j,kb,sphum) + enddo + enddo + endif + + do n=1,size(tr_bot,3) + do j = js, je + do i = is, ie + kb = Dynam%Masks%Tmp%kbot(i,j) + tr_bot(i,j,n) = Var % r(i,j,kb,n) + enddo + enddo + enddo + + p_surf = Var % ps (is:ie,js:je) + + slp = Var % ps (is:ie,js:je) + + call compute_height_bottom ( Dynam%Vgrid, Var%pssl(is:ie,js:je), & + t_bot, q_bot, z_bot, p_bot, & + Dynam%Masks%Tmp%kbot(is:ie,js:je) ) + + + end subroutine get_bottom_mass + +!####################################################################### +! returns u and v on the mass grid at the lowest model level + + subroutine get_bottom_wind (u_bot, v_bot) + + real, intent(out), & + dimension(Dynam%Hgrid%Tmp%is:Dynam%Hgrid%Tmp%ie,Dynam%Hgrid%Tmp%js:Dynam%Hgrid%Tmp%je) & + :: u_bot, v_bot + + real, dimension(Dynam%Hgrid%ilb:Dynam%Hgrid%iub,Dynam%Hgrid%jlb:Dynam%Hgrid%jub) :: u,v,uh,vh + +!---- compute lowest level winds on mass grid ----- + + call get_bottom_data ( Var % u, Var % v, & + u, v, Dynam%Masks%Vel%kbot ) + + call change_grid ( Dynam%Hgrid, WIND_GRID, TEMP_GRID, u, v, uh, vh ) + + u_bot = uh (Dynam%Hgrid%Tmp%is:Dynam%Hgrid%Tmp%ie,Dynam%Hgrid%Tmp%js:Dynam%Hgrid%Tmp%je) + v_bot = vh (Dynam%Hgrid%Tmp%is:Dynam%Hgrid%Tmp%ie,Dynam%Hgrid%Tmp%js:Dynam%Hgrid%Tmp%je) + + end subroutine get_bottom_wind + +!####################################################################### + + subroutine get_stock_pe(index, value) + + ! This is a dummy routine. + ! It is neccessary to satisfy revision 13.0.4.3.2.1 of atmos_coupled/atmos_model.f90 + ! Since that revision of atmos_coupled/atmos_model.f90 does nothing with the result, + ! this routine can be a dummy. + ! If and when the result is needed, it should be the total water content of the + ! global atmosphere (Kg), including vapor, liquid and ice. + + integer, intent(in) :: index + real, intent(out) :: value + + value = 0.0 + if(.not.stock_warning_issued) then + call error_mesg('get_stock_pe','Stocks not yet implemented. Returning zero.',NOTE) + stock_warning_issued = .true. + endif + + end subroutine get_stock_pe + +!####################################################################### + +end module atmosphere_mod + diff --git a/MOM_code/src/atmos_bgrid/driver/coupled/bgrid_physics.F90 b/MOM_code/src/atmos_bgrid/driver/coupled/bgrid_physics.F90 new file mode 100644 index 0000000..55c4874 --- /dev/null +++ b/MOM_code/src/atmos_bgrid/driver/coupled/bgrid_physics.F90 @@ -0,0 +1,778 @@ + +module bgrid_physics_mod + +!----------------------------------------------------------------------- +! +! interface for b-grid dynamics with atmospheric physics +! +!----------------------------------------------------------------------- + +use bgrid_core_driver_mod, only: bgrid_dynam_type +use bgrid_halo_mod, only: update_halo, NORTH, EAST, WEST, SOUTH, & + TEMP, UWND, VWND +use bgrid_prog_var_mod, only: prog_var_type +use bgrid_vert_mod, only: vert_grid_type, compute_height, & + compute_pres_full, compute_pres_half, & + compute_pres_depth +use bgrid_horiz_mod, only: horiz_grid_type, get_horiz_grid_bound, TGRID + +use bgrid_change_grid_mod, only: change_grid, TEMP_GRID, WIND_GRID +use bgrid_integrals_mod, only: global_integral +use bgrid_masks_mod, only: grid_mask_type + +use time_manager_mod, only: time_type, get_time, operator(-) +use fms_mod, only: error_mesg, FATAL, write_version_number , mpp_pe +use physics_driver_mod, only: physics_driver_init, & + physics_driver_end, & + physics_driver_moist_init, & + physics_driver_moist_end, & + physics_driver_down_time_vary, & + physics_driver_up_time_vary, & + physics_driver_down_endts, & + physics_driver_up_endts, & + physics_driver_down, & + physics_driver_up, & + surf_diff_type +use field_manager_mod, only: MODEL_ATMOS +use tracer_manager_mod, only: get_tracer_index, NO_TRACER + +!----------------------------------------------------------------------- + +implicit none +private + +public bgrid_physics_down, bgrid_physics_up, & + bgrid_physics_init, bgrid_physics_end +public surf_diff_type + +!----------------------------------------------------------------------- +character(len=128) :: version = '$Id: bgrid_physics.F90,v 19.0.2.1 2013/12/18 23:34:26 Niki.Zadeh Exp $' +character(len=128) :: tag = '$Name: $' +!----------------------------------------------------------------------- + +real, allocatable, dimension(:,:,:) :: u_dt, v_dt + +contains + +!####################################################################### + +subroutine bgrid_physics_down (window, dt_phys, & + Time_prev, Time, Time_next, & + Hgrid, Vgrid, Dynam, & + Var, Var_dt, & + frac_land, albedo, & + albedo_vis_dir, albedo_nir_dir, & + albedo_vis_dif, albedo_nir_dif, & + rough_vel, t_surf, & + u_star, b_star, q_star, & + dtau_du, dtau_dv, tau_x, tau_y, & + flux_sw, & + flux_sw_dir, & + flux_sw_dif, & + flux_sw_down_vis_dir, & + flux_sw_down_vis_dif, & + flux_sw_down_total_dir, & + flux_sw_down_total_dif, & + flux_sw_vis, & + flux_sw_vis_dir, & + flux_sw_vis_dif, & + flux_lw, coszen, & + gust, Surf_diff, frac_open_sea ) + +!----------------------------------------------------------------------- +! +! Time_prev = time at the previous time level, tau-1 (time_type) +! Time = time at the current time level, tau (time_type) +! Time_next = time at the next time level, tau+1 (time_type) +! +! NOTE: for a two time level scheme (e.g., forward-backward scheme) +! Time_prev = Time. +! +!----------------------------------------------------------------------- + integer, intent(in) :: window(2) + real, intent(in) :: dt_phys + type(time_type),intent(in) :: Time_prev, Time, Time_next +type (horiz_grid_type),intent(inout) :: Hgrid +type (vert_grid_type),intent(in) :: Vgrid +type(bgrid_dynam_type),intent(in) :: Dynam +type (prog_var_type),intent(inout) :: Var +type (prog_var_type),intent(inout) :: Var_dt + + ! Note: Var is intent inout because of diagnostic tracers + + real, intent(in), dimension(Hgrid%Tmp%is:,Hgrid%Tmp%js:) :: & + frac_land, albedo, & + albedo_vis_dir, albedo_nir_dir, & + albedo_vis_dif, albedo_nir_dif, & + rough_vel, t_surf, & + u_star, b_star, & + q_star, dtau_du, dtau_dv, frac_open_sea + real, intent(inout), dimension(Hgrid%Tmp%is:,Hgrid%Tmp%js:) :: tau_x, tau_y + real, intent(out), dimension(Hgrid%Tmp%is:,Hgrid%Tmp%js:) :: & + flux_sw, & + flux_sw_dir, & + flux_sw_dif, & + flux_lw, coszen, & + flux_sw_down_vis_dir, & + flux_sw_down_vis_dif, & + flux_sw_down_total_dir, & + flux_sw_down_total_dif, & + flux_sw_vis, & + flux_sw_vis_dir, & + flux_sw_vis_dif, & + gust + + type(surf_diff_type), intent(inout) :: Surf_diff +!----------------------------------------------------------------------- + integer :: j, k, n, is, ie, js, je, i1, i2, j1, j2, sphum, nt, ntp + integer :: ix, jx, idim, jdim + real :: dt + integer :: sec, day +!----------------------------------------------------------------------- + + real, dimension(window(1),window(2),Vgrid%nlev) :: p_full, z_full + + real, dimension(window(1),window(2),Vgrid%nlev+1) :: p_half, z_half + real, dimension(1,1,Vgrid%nlev+1) :: phalfgrey + + real, dimension(Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub, & + Vgrid%nlev) :: uh, vh + + real, dimension(window(1),window(2)) :: pssl_new, area + real, dimension(size(Var%r, 4)) :: gavg_rrv + real, dimension(1,1) :: psurf + +!----------------------------------------------------------------------- +!---------------------------- do physics ------------------------------- + + idim = window(1) + jdim = window(2) + +! --- momentum and momentum tendency on mass grid --- +! note: tendency is saved for "physics_up" call + + call update_halo (Hgrid, UWND, Var_dt%u, halos=SOUTH+WEST) + call update_halo (Hgrid, VWND, Var_dt%v, halos=SOUTH+WEST) + + if (Dynam%Masks%sigma) then + call change_grid (Hgrid, WIND_GRID, TEMP_GRID, Var%u, Var%v, uh , vh ) + call change_grid (Hgrid, WIND_GRID, TEMP_GRID, Var_dt%u, Var_dt%v, u_dt, v_dt) + else + call change_grid (Hgrid, WIND_GRID, TEMP_GRID, & + Var%u, Var%v, uh , vh , mask_inp=Dynam%Masks%Vel%mask) + call change_grid (Hgrid, WIND_GRID, TEMP_GRID, & + Var_dt%u, Var_dt%v, u_dt, v_dt, mask_inp=Dynam%Masks%Vel%mask) + endif + +! --- loop through physics windows --- + + sphum = get_tracer_index ( MODEL_ATMOS, 'sphum' ) + if (sphum <= 0) call error_mesg ('bgrid_physics_mod', & + 'specific humidity tracer not found', FATAL) + ntp = Var_dt%ntrace + nt = Var %ntrace + js = Hgrid%Tmp%js + + gavg_rrv = 0. + call compute_g_avg(Hgrid, Vgrid, Var, Dynam%Masks, gavg_rrv, 'co2') + +!--------------------------------------------------------------------- +! compute the physics time step (from tau-1 to tau+1). +!--------------------------------------------------------------------- + call get_time (Time_next-Time_prev, sec, day) + dt = real(sec+day*86400) + +!--------------------------------------------------------------------- +! call physics_driver_down_time_vary to do the time-dependent, spatially +! independent calculations before entering windows / threads loop. +!--------------------------------------------------------------------- + call physics_driver_down_time_vary (Time, Time_next, gavg_rrv, dt) + + + do while ( js <= Hgrid%Tmp%je ) + + je = min ( js+jdim-1, Hgrid%Tmp%je ) + jx = je-js+1 + is = Hgrid%Tmp%is + + do while ( is <= Hgrid%Tmp%ie ) + + ie = min ( is+idim-1, Hgrid%Tmp%ie ) + ix = ie-is+1 + +! ---- pass updated surface pressure ---- + do j = 1, jx + pssl_new(1:ix,j) = Var %pssl(is:ie,js+j-1) + & + Var_dt%pssl(is:ie,js+j-1) * dt_phys + area (1:ix,j) = Hgrid%Tmp%area(js+j-1) + enddo + + call compute_pres_full (Vgrid, pssl_new(1:ix,1:jx), & + p_full(1:ix,1:jx,:)) + call compute_pres_half (Vgrid, pssl_new(1:ix,1:jx), & + p_half(1:ix,1:jx,:)) + +! compute a reference profile of pressure based on psurf = 1000 hPa + psurf = reshape ( (/ 100000. /), (/ 1, 1 /) ) + call compute_pres_half (Vgrid, psurf, phalfgrey) + + +! ----- compute height (in meters) ------- +! ----- spec humidity assumed to be tracer #1 -------- + + call compute_height (Vgrid, Dynam%fisl(is:ie,js:je), & + Var%t (is:ie,js:je,:), & + Var%r (is:ie,js:je,:,sphum), & + p_full (1:ix,1:jx,:), & + p_half (1:ix,1:jx,:), & + z_full (1:ix,1:jx,:), & + z_half (1:ix,1:jx,:), & + Dynam%Masks%Tmp%mask(is:ie,js:je,:) ) + +! ---- j-axis indices in the global physics grid ---- + + j1 = js-Hgrid%Tmp%js+1; j2 = j1+(je-js) + i1 = is-Hgrid%Tmp%is+1; i2 = i1+(ie-is) + +!----------------------------------------------------------------------- +!-------------------------- call physics ------------------------------- +!------------ (need to add leap-frog option for uh,vh) ----------------- +!----------------------------------------------------------------------- + if ( .not. Dynam%Masks%sigma ) then +!------------ eta coordinate ------------------------------------------- + call physics_driver_down (i1, i2, j1, j2 ,& + Time_prev, Time, Time_next ,& + Hgrid%Tmp%aph (is:ie,js:je), Hgrid%Tmp%alm (is:ie,js:je),& + area ( 1:ix, 1:jx), p_half ( 1:ix, 1:jx,:) ,& + p_full ( 1:ix, 1:jx,:), z_half ( 1:ix, 1:jx,:) ,& + z_full ( 1:ix, 1:jx,:) ,& + phalfgrey ,& + uh (is:ie,js:je,:) ,& + vh (is:ie,js:je,:) , Var%t(is:ie,js:je,:) ,& + Var%r(is:ie,js:je,:,sphum) , Var%r(is:ie,js:je,:, : ) ,& + uh (is:ie,js:je,:) , vh (is:ie,js:je,:) ,& + Var%t (is:ie,js:je,:) , Var%r (is:ie,js:je,:,sphum) ,& + Var%r (is:ie,js:je,:, : ) , & + frac_land(is:ie,js:je) , rough_vel(is:ie,js:je) ,& + frac_open_sea(is:ie,js:je) , & + albedo (is:ie,js:je) , albedo_vis_dir (is:ie,js:je) ,& + albedo_nir_dir (is:ie,js:je) , albedo_vis_dif (is:ie,js:je) ,& + albedo_nir_dif (is:ie,js:je) , t_surf (is:ie,js:je) ,& + u_star (is:ie,js:je) , b_star (is:ie,js:je) ,& + q_star (is:ie,js:je) , dtau_du (is:ie,js:je), dtau_dv (is:ie,js:je),& + tau_x (is:ie,js:je) , tau_y (is:ie,js:je) ,& + u_dt (is:ie,js:je,:) , v_dt (is:ie,js:je,:) ,& + Var_dt%t (is:ie,js:je,:) , Var_dt%r (is:ie,js:je,:,sphum),& + Var_dt%r (is:ie,js:je,:,1:ntp) , flux_sw (is:ie,js:je) ,& + flux_sw_dir (is:ie,js:je) ,& + flux_sw_dif (is:ie,js:je) ,& + flux_sw_down_vis_dir (is:ie,js:je) ,& + flux_sw_down_vis_dif (is:ie,js:je) ,& + flux_sw_down_total_dir (is:ie,js:je) ,& + flux_sw_down_total_dif (is:ie,js:je) ,& + flux_sw_vis (is:ie,js:je) ,& + flux_sw_vis_dir (is:ie,js:je) ,& + flux_sw_vis_dif (is:ie,js:je) ,& + flux_lw (is:ie,js:je) ,& + coszen (is:ie,js:je) ,& + gust (is:ie,js:je) ,& + Surf_diff ,& + gavg_rrv ,& + mask=Dynam%Masks%Tmp%mask(is:ie,js:je,:) ,& + kbot=Dynam%Masks%Tmp%kbot(is:ie,js:je) ) + else +!------------- sigma coordinate ---------------------------------------- + call physics_driver_down (i1, i2, j1, j2 ,& + Time_prev, Time, Time_next ,& + Hgrid%Tmp%aph (is:ie,js:je), Hgrid%Tmp%alm (is:ie,js:je),& + area ( 1:ix, 1:jx), p_half ( 1:ix, 1:jx,:) ,& + p_full ( 1:ix, 1:jx,:), z_half ( 1:ix, 1:jx,:) ,& + z_full ( 1:ix, 1:jx,:) ,& + phalfgrey ,& + uh (is:ie,js:je,:) ,& + vh (is:ie,js:je,:) , Var%t(is:ie,js:je,:) ,& + Var%r(is:ie,js:je,:,sphum) , Var%r(is:ie,js:je,:, : ) ,& + uh (is:ie,js:je,:) , vh (is:ie,js:je,:) ,& + Var%t (is:ie,js:je,:) , Var%r (is:ie,js:je,:,sphum) ,& + Var%r (is:ie,js:je,:, : ) , & + frac_land(is:ie,js:je) , rough_vel(is:ie,js:je) ,& + frac_open_sea(is:ie,js:je) , & + albedo (is:ie,js:je) , albedo_vis_dir (is:ie,js:je) ,& + albedo_nir_dir (is:ie,js:je) , albedo_vis_dif (is:ie,js:je) ,& + albedo_nir_dif (is:ie,js:je) , t_surf (is:ie,js:je) ,& + u_star (is:ie,js:je) , b_star (is:ie,js:je) ,& + q_star (is:ie,js:je) , dtau_du (is:ie,js:je) ,dtau_dv (is:ie,js:je),& + tau_x (is:ie,js:je) , tau_y (is:ie,js:je) ,& + u_dt (is:ie,js:je,:) , v_dt (is:ie,js:je,:) ,& + Var_dt%t (is:ie,js:je,:) , Var_dt%r (is:ie,js:je,:,sphum),& + Var_dt%r (is:ie,js:je,:,1:ntp) , flux_sw (is:ie,js:je) ,& +! Time_prev, Time, Time_next ,& +! Hgrid%Tmp%aph (is:ie,js:je) ,& +! Hgrid%Tmp%alm (is:ie,js:je) ,& +! area ( 1:ix, 1:jx) ,& +! p_half ( 1:ix, 1:jx,:) ,& +! p_full ( 1:ix, 1:jx,:) ,& +! z_half ( 1:ix, 1:jx,:) ,& +! z_full ( 1:ix, 1:jx,:) ,& +! uh (is:ie,js:je,:) ,& +! vh (is:ie,js:je,:) ,& +! Var%t(is:ie,js:je,:) ,& +! Var%r(is:ie,js:je,:,sphum) ,& +! Var%r(is:ie,js:je,:,1:ntp) ,& +! uh (is:ie,js:je,:) ,& +! vh (is:ie,js:je,:) ,& +! Var%t (is:ie,js:je,:) ,& +! Var%r (is:ie,js:je,:,sphum) ,& +! Var%r (is:ie,js:je,:,1:ntp) ,& +! Var%r (is:ie,js:je,:,ntp+1:nt) ,& +! frac_land(is:ie,js:je) ,& +! rough_vel(is:ie,js:je) ,& +! albedo (is:ie,js:je) ,& +! albedo_vis_dir (is:ie,js:je) ,& +! albedo_nir_dir (is:ie,js:je) ,& +! albedo_vis_dif (is:ie,js:je) ,& +! albedo_nir_dif (is:ie,js:je) ,& +! t_surf (is:ie,js:je) ,& +! u_star (is:ie,js:je) ,& +! b_star (is:ie,js:je) ,& +! q_star (is:ie,js:je) ,& +! dtau_dv (is:ie,js:je) ,& +! tau_x (is:ie,js:je) ,& +! tau_y (is:ie,js:je) ,& +! u_dt (is:ie,js:je,:) ,& +! v_dt (is:ie,js:je,:) ,& +! Var_dt%t (is:ie,js:je,:) ,& +! Var_dt%r (is:ie,js:je,:,sphum) ,& +! Var_dt%r (is:ie,js:je,:,1:ntp) ,& +! flux_sw (is:ie,js:je) ,& + flux_sw_dir (is:ie,js:je) ,& + flux_sw_dif (is:ie,js:je) ,& + flux_sw_down_vis_dir (is:ie,js:je) ,& + flux_sw_down_vis_dif (is:ie,js:je) ,& + flux_sw_down_total_dir (is:ie,js:je) ,& + flux_sw_down_total_dif (is:ie,js:je) ,& + flux_sw_vis (is:ie,js:je) ,& + flux_sw_vis_dir (is:ie,js:je) ,& + flux_sw_vis_dif (is:ie,js:je) ,& + flux_lw (is:ie,js:je) ,& + coszen (is:ie,js:je) ,& + gust (is:ie,js:je) ,& + Surf_diff ,& + gavg_rrv ) + endif + + is = is + idim + + enddo + + js = js + jdim + + enddo + + + call physics_driver_down_endts (is-Hgrid%Tmp%is+1, js-Hgrid%Tmp%js+1) + +! halo rows for tendencies do not need updating until after physics_up +! update halos for diagnostic tracers only + + if (ntp < nt) call update_halo (Hgrid, TEMP, Var%r(:,:,:,ntp+1:nt)) + +!----------------------------------------------------------------------- + +end subroutine bgrid_physics_down + +!####################################################################### + +subroutine bgrid_physics_up (window, dt_phys, & + Time_prev, Time, Time_next, & + Hgrid, Vgrid, Dynam, & + Var, Var_dt, omega, & + frac_land, Surf_diff, lprec, fprec, gust, & + u_star, b_star, q_star ) + +!----------------------------------------------------------------------- +! +! Time_prev = time at the previous time level, tau-1 (time_type) +! Time = time at the current time level, tau (time_type) +! Time_next = time at the next time level, tau+1 (time_type) +! +! NOTE: for a two time level scheme (e.g., forward-backward scheme) +! Time_prev = Time. +! +!----------------------------------------------------------------------- + integer, intent(in) :: window(2) + real, intent(in) :: dt_phys + type(time_type),intent(in) :: Time_prev, Time, Time_next +type (horiz_grid_type),intent(inout) :: Hgrid +type (vert_grid_type),intent(in) :: Vgrid +type(bgrid_dynam_type),intent(in) :: Dynam +type (prog_var_type),intent(inout) :: Var +type (prog_var_type),intent(inout) :: Var_dt + +real, intent(in), dimension(Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub, & + Vgrid%nlev) :: omega + + real, intent(in), dimension(Hgrid%Tmp%is:,Hgrid%Tmp%js:) :: frac_land +type(surf_diff_type), intent(inout) :: Surf_diff + real, intent(out), dimension(Hgrid%Tmp%is:,Hgrid%Tmp%js:) :: lprec, fprec + real, intent(inout), dimension(Hgrid%Tmp%is:,Hgrid%Tmp%js:) :: gust + real, intent(in), dimension(Hgrid%Tmp%is:,Hgrid%Tmp%js:) :: u_star, b_star, q_star + +!----------------------------------------------------------------------- + integer :: j, k, n, is, ie, js, je, i1, i2, j1, j2, sphum, ntp, npz,nt + integer :: ix, jx, idim, jdim + integer :: sec, day + real :: dt +!----------------------------------------------------------------------- + + real, dimension(window(1),window(2),Vgrid%nlev) :: p_full, z_full + + real, dimension(window(1),window(2),Vgrid%nlev+1) :: p_half, z_half + + real, dimension(Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub, & + Vgrid%nlev) :: uh, vh, uh_dt, vh_dt + + real, dimension(window(1),window(2)) :: pssl_new, area + +!--------------------------------------------------------------------- +! compute the physics time step (from tau-1 to tau+1). +!--------------------------------------------------------------------- + call get_time (Time_next-Time_prev, sec, day) + dt = real(sec+day*86400) + + call physics_driver_up_time_vary (Time, Time_next, dt) + + +!----------------------------------------------------------------------- +!---------------------------- do physics ------------------------------- + + idim = window(1) + jdim = window(2) + +! --- momentum and previous momentum tendency on mass grid --- + + if (Dynam%Masks%sigma) then + call change_grid (Hgrid, WIND_GRID, TEMP_GRID, Var%u, Var%v, uh , vh ) + call change_grid (Hgrid, WIND_GRID, TEMP_GRID, Var_dt%u, Var_dt%v, uh_dt, vh_dt) + else + call change_grid (Hgrid, WIND_GRID, TEMP_GRID, & + Var%u, Var%v, uh , vh , mask_inp=Dynam%Masks%Vel%mask) + call change_grid (Hgrid, WIND_GRID, TEMP_GRID, & + Var_dt%u, Var_dt%v, uh_dt, vh_dt, mask_inp=Dynam%Masks%Vel%mask) + endif + +! --- loop through physics windows --- + + sphum = get_tracer_index ( MODEL_ATMOS, 'sphum' ) + if (sphum <= 0) call error_mesg ('bgrid_physics_mod', & + 'specific humidity tracer not found', FATAL) + ntp = Var_dt%ntrace + js = Hgrid%Tmp%js + npz = size(p_full,3) + nt = Var%ntrace + call physics_driver_moist_init (window(1), window(2), npz, ntp, nt) + do while ( js <= Hgrid%Tmp%je ) + + je = min ( js+jdim-1, Hgrid%Tmp%je ) + jx = je-js+1 + is = Hgrid%Tmp%is + + do while ( is <= Hgrid%Tmp%ie ) + + ie = min ( is+idim-1, Hgrid%Tmp%ie ) + ix = ie-is+1 + +! ---- pass updated surface pressure ---- + do j = 1, jx + pssl_new(1:ix,j) = Var %pssl(is:ie,js+j-1) + & + Var_dt%pssl(is:ie,js+j-1) * dt_phys + area (1:ix,j) = Hgrid%Tmp%area(js+j-1) + enddo + + call compute_pres_full (Vgrid, pssl_new(1:ix,1:jx), & + p_full(1:ix,1:jx,:)) + call compute_pres_half (Vgrid, pssl_new(1:ix,1:jx), & + p_half(1:ix,1:jx,:)) + + call compute_height (Vgrid, Dynam%fisl(is:ie,js:je), & + Var%t (is:ie,js:je,:), & + Var%r (is:ie,js:je,:,sphum), & + p_full (1:ix,1:jx,:), & + p_half (1:ix,1:jx,:), & + z_full (1:ix,1:jx,:), & + z_half (1:ix,1:jx,:), & + Dynam%Masks%Tmp%mask(is:ie,js:je,:) ) + +! ---- j-axis indices in the global physics grid ---- + + j1 = js-Hgrid%Tmp%js+1; j2 = j1+(je-js) + i1 = is-Hgrid%Tmp%is+1; i2 = i1+(ie-is) + +!----------------------------------------------------------------------- +!-------------------------- call physics ------------------------------- +!------------ (need to add leap-frog option for uh,vh) ----------------- +!----------------------------------------------------------------------- + if ( .not. Dynam%Masks%sigma ) then +!------------ eta coordinate ------------------------------------------- + call physics_driver_up (i1, i2, j1, j2 ,& + Time_prev, Time, Time_next ,& + Hgrid%Tmp%aph (is:ie,js:je) ,& + Hgrid%Tmp%alm (is:ie,js:je) ,& + area ( 1:ix, 1:jx) ,& + p_half ( 1:ix, 1:jx,:) ,& + p_full ( 1:ix, 1:jx,:) ,& + z_half ( 1:ix, 1:jx,:) ,& + z_full ( 1:ix, 1:jx,:) ,& + omega (is:ie,js:je,:) ,& + uh (is:ie,js:je,:) ,& + vh (is:ie,js:je,:) ,& + Var%t(is:ie,js:je,:) ,& + Var%r(is:ie,js:je,:,sphum) ,& + Var%r(is:ie,js:je,:,:) ,& + uh (is:ie,js:je,:) ,& + vh (is:ie,js:je,:) ,& + Var%t (is:ie,js:je,:) ,& + Var%r (is:ie,js:je,:,sphum) ,& + Var%r (is:ie,js:je,:,:) ,& + frac_land(is:ie,js:je) ,& + u_star(is:ie,js:je) ,& + b_star(is:ie,js:je) ,& + q_star(is:ie,js:je) ,& + u_dt (is:ie,js:je,:) ,& + v_dt (is:ie,js:je,:) ,& + Var_dt%t (is:ie,js:je,:) ,& + Var_dt%r (is:ie,js:je,:,sphum) ,& + Var_dt%r (is:ie,js:je,:,:) ,& + Surf_diff ,& + lprec (is:ie,js:je) ,& + fprec (is:ie,js:je) ,& + gust (is:ie,js:je) ,& + mask=Dynam%Masks%Tmp%mask(is:ie,js:je,:) ,& + kbot=Dynam%Masks%Tmp%kbot(is:ie,js:je) ) + else +!------------- sigma coordinate ---------------------------------------- + call physics_driver_up (i1, i2, j1, j2 ,& + Time_prev, Time, Time_next ,& + Hgrid%Tmp%aph (is:ie,js:je) ,& + Hgrid%Tmp%alm (is:ie,js:je) ,& + area ( 1:ix, 1:jx) ,& + p_half ( 1:ix, 1:jx,:) ,& + p_full ( 1:ix, 1:jx,:) ,& + z_half ( 1:ix, 1:jx,:) ,& + z_full ( 1:ix, 1:jx,:) ,& + omega (is:ie,js:je,:) ,& + uh (is:ie,js:je,:) ,& + vh (is:ie,js:je,:) ,& + Var%t(is:ie,js:je,:) ,& + Var%r(is:ie,js:je,:,sphum) ,& + Var%r(is:ie,js:je,:,1:ntp) ,& + uh (is:ie,js:je,:) ,& + vh (is:ie,js:je,:) ,& + Var%t (is:ie,js:je,:) ,& + Var%r (is:ie,js:je,:,sphum) ,& + Var%r (is:ie,js:je,:,1:ntp) ,& + frac_land(is:ie,js:je) ,& + u_star(is:ie,js:je) ,& + b_star(is:ie,js:je) ,& + q_star(is:ie,js:je) ,& + u_dt (is:ie,js:je,:) ,& + v_dt (is:ie,js:je,:) ,& + Var_dt%t (is:ie,js:je,:) ,& + Var_dt%r (is:ie,js:je,:,sphum) ,& + Var_dt%r (is:ie,js:je,:,1:ntp) ,& + Surf_diff ,& + lprec (is:ie,js:je) ,& + fprec (is:ie,js:je) ,& + gust (is:ie,js:je) ) + endif + + is = is + idim + + enddo + + js = js + jdim + + enddo + + call physics_driver_moist_end + call physics_driver_up_endts (is-Hgrid%Tmp%is+1, js-Hgrid%Tmp%js+1) + +!----------------------------------------------------------------------- +! compute momentum tendencies on mass grid for physics only +! udt(phys) = udt(current) - udt(before physics) + + uh(:,:,:) = u_dt(:,:,:) - uh_dt(:,:,:) + vh(:,:,:) = v_dt(:,:,:) - vh_dt(:,:,:) + +! update halos of momentum tendencies on mass grid +! then move momentum tendencies to momentum grid + + call update_halo (Hgrid, TEMP, uh, halos=NORTH+EAST) + call update_halo (Hgrid, TEMP, vh, halos=NORTH+EAST) + + call change_grid (Hgrid, TEMP_GRID, WIND_GRID, uh, vh, uh, vh) + + uh(:,Hgrid%jub,:) = 0.0 ! zero out unused polar halo row + vh(:,Hgrid%jub,:) = 0.0 ! no harm done when not polar row + +!---- update momentum tendencies ---- + + Var_dt%u = Var_dt%u + uh * Dynam%Masks%Vel%mask + Var_dt%v = Var_dt%v + vh * Dynam%Masks%Vel%mask + +!---- update all halo rows ---- + + call update_halo (Hgrid, TEMP, Var_dt%t) + call update_halo (Hgrid, TEMP, Var_dt%r) + call update_halo (Hgrid, UWND, Var_dt%u) + call update_halo (Hgrid, VWND, Var_dt%v) + +!----------------------------------------------------------------------- + +end subroutine bgrid_physics_up + +!####################################################################### + +subroutine bgrid_physics_init (axes, Time, Hgrid, Vgrid, Dynam, & + Var, Surf_diff) + +!----------------------------------------------------------------------- +! +! axes = array of axis indices for diagnostics (x,y,pf,ph) +! Time = current time (time_type) +! Hgrid = horizontal grid constants +! Vgrid = vertical grid constants +! Dynam = current state of the dynamical core +! Var = prognostic variables +! +!----------------------------------------------------------------------- +integer, intent(in) :: axes(4) +type (time_type), intent(in) :: Time +type (horiz_grid_type),intent(inout) :: Hgrid +type (vert_grid_type),intent(in) :: Vgrid +type(bgrid_dynam_type),intent(in) :: Dynam +type (prog_var_type),intent(inout) :: Var +type (surf_diff_type), intent(inout) :: Surf_diff +!----------------------------------------------------------------------- + real, dimension(Hgrid%Tmp%is:Hgrid%Tmp%ie+1) :: lonb + real, dimension(Hgrid%Tmp%js:Hgrid%Tmp%je+1) :: latb + real, dimension(Hgrid%Tmp%is:Hgrid%Tmp%ie, & + Hgrid%Tmp%js:Hgrid%Tmp%je,Vgrid%nlev+1) :: phalf + real, dimension(Vgrid%nlev+1,2) :: pref + real, dimension(2,1,Vgrid%nlev) :: pref_full + real, dimension(2,1) :: pref_sl + real, dimension(Hgrid%Tmp%is:Hgrid%Tmp%ie+1,Hgrid%Tmp%js:Hgrid%Tmp%je+1) :: lonb2d, latb2d +!----------------------------------------------------------------------- + integer :: i, j, k, n, nt, is, ie, js, je, unit +!----------------------------------------------------------------------- + + nt = Var%ntrace + +!----- write version to logfile -------- + + call write_version_number (version,tag) + +!---------- get local grid box edges --------- + + call get_horiz_grid_bound (Hgrid, TGRID, lonb, latb) + do j = Hgrid%Tmp%js,Hgrid%Tmp%je+1 + lonb2d(:,j) = lonb(:) + end do + do i = Hgrid%Tmp%is,Hgrid%Tmp%ie+1 + latb2d(i,:) = latb(:) + end do + +!---------- reference profile ----------- + + pref_sl = reshape ( (/ 101325., 81060. /), (/ 2, 1 /) ) + call compute_pres_full (Vgrid, pref_sl, pref_full) + pref(1:Vgrid%nlev,1) = pref_full(1,1,:) + pref(1:Vgrid%nlev,2) = pref_full(2,1,:) + pref(Vgrid%nlev+1,1) = pref_sl(1,1) + pref(Vgrid%nlev+1,2) = pref_sl(2,1) + +!------- pressure at model layer interfaces ----- + + is = Hgrid % Tmp % is; ie = Hgrid % Tmp % ie + js = Hgrid % Tmp % js; je = Hgrid % Tmp % je + + call compute_pres_half (Vgrid, Var%pssl(is:ie,js:je), phalf) + +!---------- initialize physics ------- + + if (Dynam%Masks%sigma) then + call physics_driver_init (Time, lonb2d, latb2d, lonb2d, latb2d, axes, pref, & + Var%r(is:ie,js:je,:,1:nt), & + Surf_diff, phalf ) + else + call physics_driver_init (Time, lonb2d, latb2d, lonb2d, latb2d, axes, pref, & + Var%r(is:ie,js:je,:,1:nt), & + Surf_diff, phalf, & + mask=Dynam%Masks%Tmp%mask(is:ie,js:je,:), & + kbot=Dynam%Masks%Vel%kbot(is:ie,js:je) ) + endif + +! ---- boundaries for tracers ---- + call update_halo (Hgrid, TEMP, Var%r) + +! ---- storage for global data ---- + + allocate (u_dt(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub,Vgrid%nlev)) + allocate (v_dt(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub,Vgrid%nlev)) + +!----------------------------------------------------------------------- + +end subroutine bgrid_physics_init + +!####################################################################### + +subroutine bgrid_physics_end (Time) + +!----------------------------------------------------------------------- + type(time_type), intent(in) :: Time +!----------------------------------------------------------------------- +! NOTE: this is not the dynamics time +!----------------------------------------------------------------------- + + call physics_driver_end (Time) + +!----------------------------------------------------------------------- + +end subroutine bgrid_physics_end + +!####################################################################### + +subroutine compute_g_avg(Hgrid, Vgrid, Var, Masks, rrv, tracer_name) + + type (horiz_grid_type),intent(inout) :: Hgrid + type (vert_grid_type),intent(in) :: Vgrid + type (prog_var_type),intent(in) :: Var + type (grid_mask_type), intent(in) :: Masks + + real, dimension(:), intent(inout) :: rrv + character(len=*), intent(in) :: tracer_name + + real, dimension (Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub, Var%nlev) :: dpde, avg + + real avgps + real psfc_sum, qp_sum, qp + integer j, i, k, idx + + psfc_sum = 0. + qp_sum = 0. + idx = get_tracer_index(MODEL_ATMOS, trim(tracer_name)) + if(idx /= NO_TRACER) then + call compute_pres_depth (Vgrid, Var%pssl, dpde) + avg = Var%r(:,:,:,idx) * dpde + avgps = global_integral (Hgrid, 1, Var%ps, do_exact=.true.) + rrv(idx) = global_integral(Hgrid, 1, avg, Masks, .true.) / avgps + endif + +end subroutine compute_g_avg + +end module bgrid_physics_mod + diff --git a/MOM_code/src/atmos_bgrid/driver/shallow/atmosphere.F90 b/MOM_code/src/atmos_bgrid/driver/shallow/atmosphere.F90 new file mode 100644 index 0000000..e54ade6 --- /dev/null +++ b/MOM_code/src/atmos_bgrid/driver/shallow/atmosphere.F90 @@ -0,0 +1,363 @@ + +module atmosphere_mod + +!----------------------------------------------------------------------- +! +! interface for B-grid dynamical core with Held-Suarez forcing +! +!----------------------------------------------------------------------- + +use bgrid_core_driver_mod, only: bgrid_dynam_type, & + bgrid_core_driver_init, & + bgrid_core_driver, & + bgrid_core_time_diff, & + bgrid_core_driver_end, & + get_bottom_data, & + put_bottom_data, & + atmosphere_domain + +use bgrid_prog_var_mod, only: prog_var_type, var_init + +use bgrid_horiz_mod, only: get_horiz_grid_size, & + get_horiz_grid_bound, TGRID + +use time_manager_mod, only: time_type, get_time, operator(+) + +use fms_mod, only: file_exist, open_namelist_file, & + error_mesg, FATAL, & + check_nml_error, stdlog, & + write_version_number, & + mpp_pe, mpp_root_pe, & + close_file, set_domain + +! routines used by subroutine bgrid_physics +use bgrid_change_grid_mod, only: change_grid, TEMP_GRID, WIND_GRID +use bgrid_horiz_mod , only: horiz_grid_type +use bgrid_vert_mod , only: vert_grid_type, & + compute_pres_full, compute_pres_half +use bgrid_halo_mod , only: update_halo, UWND, VWND, TEMP, & + NORTH, EAST, WEST, SOUTH +use shallow_physics_mod , only: shallow_physics_init, shallow_physics, & + shallow_physics_end + +!----------------------------------------------------------------------- + +implicit none +private + +public atmosphere, & + atmosphere_init, & + atmosphere_end, & + atmosphere_resolution, & + atmosphere_boundary, & + get_atmosphere_axes, & + atmosphere_domain + +!----------------------------------------------------------------------- + +character(len=128) :: version = '$Id: atmosphere.F90,v 14.0 2007/03/15 21:56:36 fms Exp $' +character(len=128) :: tag = '$Name: tikal $' + +!----------------------------------------------------------------------- +!---- namelist (saved in file input.nml) ---- +! +! physics_window The number of "i" by "j" rows processed each time +! the modular physics is called. To process the entire +! domain use physics_window = (/0,0/). +! [integer, default: physics_window = 0,0] + + integer, dimension(2) :: physics_window = (/0,0/) + + namelist /atmosphere_nml/ physics_window + +!----------------------------------------------------------------------- +!---- private data ---- + +type (bgrid_dynam_type), save :: Dynam +type (prog_var_type), save :: Var, Var_dt +type (time_type) :: Time_step_atmos + +real :: dt_atmos +real, dimension(:,:,:), pointer :: omega =>NULL() +integer, dimension(4) :: atmos_axes + +!----------------------------------------------------------------------- + +contains + +!####################################################################### + + subroutine atmosphere (Time) + type (time_type), intent(in) :: Time + + type(time_type) :: Time_prev, Time_next +!----------------------------------------------------------------------- + + Time_prev = Time ! two time-level scheme + Time_next = Time + Time_step_atmos + +!---- dynamics ----- + + call bgrid_core_driver ( Time_next, Var, Var_dt, Dynam, omega ) + +!---- call physics ----- + + call bgrid_physics ( physics_window, dt_atmos, Time_next, & + Dynam%Hgrid, Dynam%Vgrid, Dynam, & + Var, Var_dt ) + +!---- time differencing and diagnostics ----- + + call bgrid_core_time_diff ( omega, Time_next, Dynam, Var, Var_dt ) + +!----------------------------------------------------------------------- + + end subroutine atmosphere + +!####################################################################### + + subroutine atmosphere_init ( Time_init, Time, Time_step ) + + type (time_type), intent(in) :: Time_init, Time, Time_step + + integer :: unit, sec, ierr, io + +!----------------------------------------------------------------------- +!----- read namelist ----- + + if (file_exist('input.nml')) then + unit = open_namelist_file ( ) + ierr=1; do while (ierr /= 0) + read (unit, nml=atmosphere_nml, iostat=io, end=10) + ierr = check_nml_error (io, 'atmosphere_nml') + enddo + 10 call close_file (unit) + endif + +!----- write version and namelist to log file ----- + + call write_version_number ( version, tag ) + if ( mpp_pe() == mpp_root_pe() ) write (stdlog(), nml=atmosphere_nml) + +!---- compute physics/atmos time step in seconds ---- + + Time_step_atmos = Time_step + call get_time (Time_step_atmos, sec) + dt_atmos = real(sec) + +!----- initialize dynamical core ----- + + call bgrid_core_driver_init ( Time_init, Time, Time_step, & + Var, Var_dt, Dynam, atmos_axes ) + +!----- make sure code is initialized for shallow water version ----- + + if (Dynam%Vgrid%nlev /= 1) call error_mesg ('atmosphere_init', & + 'number of model levels not correct '// & + 'for shallow water version', FATAL) + +!----- initialize storage needed for vert motion ---- + + omega => var_init (Dynam%Hgrid, Dynam%Vgrid%nlev) + +!----- initialize physics interface ----- +! (might want to use alm,aph instead of tlm,tph) + + call shallow_physics_init ( atmos_axes, Time, & + Dynam%Hgrid%Tmp%tlm(Dynam%Hgrid%Tmp%is:Dynam%Hgrid%Tmp%ie), & + Dynam%Hgrid%Tmp%tph(Dynam%Hgrid%Tmp%js:Dynam%Hgrid%Tmp%je) ) + +! ----- use entire grid as window ? ----- + + if (physics_window(1) <= 0) physics_window(1) = Dynam%Hgrid%Tmp%ie-Dynam%Hgrid%Tmp%is+1 + if (physics_window(2) <= 0) physics_window(2) = Dynam%Hgrid%Tmp%je-Dynam%Hgrid%Tmp%js+1 + +!----------------------------------------------------------------------- + + end subroutine atmosphere_init + +!####################################################################### + + subroutine atmosphere_end + + integer :: unit + + call bgrid_core_driver_end ( Var, Dynam ) + + end subroutine atmosphere_end + +!####################################################################### +! returns the number of longitude and latitude grid points +! for either the local PEs grid (default) or the global grid + + subroutine atmosphere_resolution (nlon, nlat, global) + + integer, intent(out) :: nlon, nlat + logical, intent(in), optional :: global + +!---- return the size of the grid used for physics computations ---- + + call get_horiz_grid_size (Dynam % Hgrid, TGRID, nlon, nlat, global) + + end subroutine atmosphere_resolution + +!####################################################################### +! returns the longitude and latitude grid box edges +! for either the local PEs grid (default) or the global grid + + subroutine atmosphere_boundary (blon, blat, global) + + real, intent(out) :: blon(:), blat(:) + logical, intent(in), optional :: global + +!----- return the longitudinal and latitudinal grid box edges ---------- + + call get_horiz_grid_bound (Dynam % Hgrid, TGRID, blon, blat, global) + + end subroutine atmosphere_boundary + +!####################################################################### +! returns the axis indices associated with the coupling grid + + subroutine get_atmosphere_axes ( axes ) + + integer, intent(out) :: axes (:) + +!----- returns the axis indices for the atmospheric (mass) grid ----- + + if ( size(axes) < 0 .or. size(axes) > 4 ) call error_mesg ( & + 'get_atmosphere_axes in atmosphere_mod', & + 'size of argument is incorrect', FATAL ) + + axes (1:size(axes)) = atmos_axes (1:size(axes)) + + end subroutine get_atmosphere_axes + +!####################################################################### + +subroutine bgrid_physics ( window, dt_phys, Time, Hgrid, Vgrid, & + Dynam, Var, Var_dt ) + +!----------------------------------------------------------------------- +! +! Time = current time (time_type, see time manager) +! +!----------------------------------------------------------------------- + integer, intent(in) :: window(2) + real, intent(in) :: dt_phys + type(time_type),intent(in) :: Time +type (horiz_grid_type),intent(inout) :: Hgrid +type (vert_grid_type),intent(in) :: Vgrid +type(bgrid_dynam_type),intent(in) :: Dynam +type (prog_var_type),intent(in) :: Var +type (prog_var_type),intent(inout) :: Var_dt + +!----------------------------------------------------------------------- + integer :: j, k, n, is, ie, js, je, i1, i2, j1, j2, idim, jdim + integer :: timelev = +1 +!----------------------------------------------------------------------- + + real, dimension(Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub,1) :: uh, vh, uh_dt, vh_dt, & + u_dt, v_dt + +!----------------------------------------------------------------------- +!---------------------------- do physics ------------------------------- + + idim = window(1) + jdim = window(2) + +! --- momentum and momentum tendency on mass grid --- + + call update_halo (Hgrid, UWND, Var_dt%u, halos=SOUTH+WEST) + call update_halo (Hgrid, VWND, Var_dt%v, halos=SOUTH+WEST) + + call change_grid (Hgrid, WIND_GRID, TEMP_GRID, Var%u, Var%v, uh , vh ) + call change_grid (Hgrid, WIND_GRID, TEMP_GRID, Var_dt%u, Var_dt%v, uh_dt, vh_dt) + + u_dt = uh_dt ! save copy of tendency before physics + v_dt = vh_dt + +! --- loop through physics windows --- + + js = Hgrid%Tmp%js + + do while ( js <= Hgrid%Tmp%je ) + + je = min ( js+jdim-1, Hgrid%Tmp%je ) + is = Hgrid%Tmp%is + + do while ( is <= Hgrid%Tmp%ie ) + + ie = min ( is+idim-1, Hgrid%Tmp%ie ) + +! ---- j-axis indices in the global physics grid ---- + + j1 = js-Hgrid%Tmp%js+1; j2 = j1+(je-js) + i1 = is-Hgrid%Tmp%is+1; i2 = i1+(ie-is) + +!----------------------------------------------------------------------- +!-------------------------- call physics ------------------------------- +!------------ (need to add leap-frog option for uh,vh) ----------------- +!----------------------------------------------------------------------- + call shallow_physics ( i1, i2, j1, j2, timelev, dt_phys, Time ,& + uh (is:ie,js:je,1) ,& + vh (is:ie,js:je,1) ,& + Var%ps (is:ie,js:je) ,& + uh (is:ie,js:je,1) ,& + vh (is:ie,js:je,1) ,& + Var%ps (is:ie,js:je) ,& + uh_dt (is:ie,js:je,1) ,& + vh_dt (is:ie,js:je,1) ,& + Var_dt%ps (is:ie,js:je) ) + + is = is + idim + + enddo + + js = js + jdim + + enddo + +!----------------------------------------------------------------------- +! compute momentum tendencies on mass grid for physics only +! udt(phys) = udt(current) - udt(before physics) + + uh_dt = uh_dt - u_dt + vh_dt = vh_dt - v_dt + +! update halos of momentum tendencies on mass grid +! then move momentum tendencies to momentum grid + + call update_halo (Hgrid, TEMP, uh_dt, halos=NORTH+EAST) + call update_halo (Hgrid, TEMP, vh_dt, halos=NORTH+EAST) + + call change_grid (Hgrid, TEMP_GRID, WIND_GRID, uh_dt, vh_dt, u_dt, v_dt) + + u_dt(:,Hgrid%jub,:) = 0.0 ! zero out unused polar halo row + v_dt(:,Hgrid%jub,:) = 0.0 ! no harm done when not polar row + +!---- update momentum tendencies ---- + + Var_dt%u = Var_dt%u + u_dt + Var_dt%v = Var_dt%v + v_dt + +!---- update all halo rows ---- + + call update_halo (Hgrid, TEMP, Var_dt%ps) + call update_halo (Hgrid, UWND, Var_dt%u) + call update_halo (Hgrid, VWND, Var_dt%v) + + call update_halo (Hgrid, TEMP, Var_dt%t) + call update_halo (Hgrid, TEMP, Var_dt%r) + + Var_dt % pssl = Var_dt % ps + +!----------------------------------------------------------------------- + +end subroutine bgrid_physics + +!####################################################################### + +end module atmosphere_mod + diff --git a/MOM_code/src/atmos_bgrid/driver/solo/atmosphere.F90 b/MOM_code/src/atmos_bgrid/driver/solo/atmosphere.F90 new file mode 100644 index 0000000..df64943 --- /dev/null +++ b/MOM_code/src/atmos_bgrid/driver/solo/atmosphere.F90 @@ -0,0 +1,424 @@ + +module atmosphere_mod + +!----------------------------------------------------------------------- +! +! interface for B-grid dynamical core with Held-Suarez forcing +! +!----------------------------------------------------------------------- + +use bgrid_core_driver_mod, only: bgrid_dynam_type, & + bgrid_core_driver_init, & + bgrid_core_driver, & + bgrid_core_time_diff, & + bgrid_core_driver_end, & + get_bottom_data, & + put_bottom_data, & + atmosphere_domain + +use bgrid_prog_var_mod, only: prog_var_type, var_init + +use bgrid_horiz_mod, only: get_horiz_grid_size, & + get_horiz_grid_bound, TGRID + +use time_manager_mod, only: time_type, get_time, operator(+) + +use fms_mod, only: file_exist, open_namelist_file, & + error_mesg, FATAL, & + check_nml_error, stdlog, & + write_version_number, & + mpp_pe, mpp_root_pe, & + close_file, set_domain + +! routines used by subroutine bgrid_physics +use bgrid_change_grid_mod, only: change_grid, TEMP_GRID, WIND_GRID +use bgrid_horiz_mod , only: horiz_grid_type +use bgrid_vert_mod , only: vert_grid_type, & + compute_pres_full, compute_pres_half +use bgrid_halo_mod , only: update_halo, UWND, VWND, TEMP, & + NORTH, EAST, WEST, SOUTH +use hs_forcing_mod , only: hs_forcing_init, hs_forcing + +!----------------------------------------------------------------------- + +implicit none +private + +public atmosphere, & + atmosphere_init, & + atmosphere_end, & + atmosphere_resolution, & + atmosphere_boundary, & + get_atmosphere_axes, & + atmosphere_domain + +!----------------------------------------------------------------------- + +character(len=128) :: version = '$Id: atmosphere.F90,v 19.0 2012/01/06 19:52:51 fms Exp $' +character(len=128) :: tag = '$Name: tikal $' + +!----------------------------------------------------------------------- +!---- namelist (saved in file input.nml) ---- +! +! physics_window The number of "i" by "j" rows processed each time +! the modular physics is called. To process the entire +! domain use physics_window = (/0,0/). +! [integer, default: physics_window = 0,0] + + integer, dimension(2) :: physics_window = (/0,0/) + + namelist /atmosphere_nml/ physics_window + +!----------------------------------------------------------------------- +!---- private data ---- + +type (bgrid_dynam_type), save :: Dynam +type (prog_var_type), save :: Var, Var_dt +type (time_type) :: Time_step_atmos + +real :: dt_atmos +real, dimension(:,:,:), pointer :: omega =>NULL() +integer, dimension(4) :: atmos_axes + +!----------------------------------------------------------------------- + +contains + +!####################################################################### + + subroutine atmosphere (Time) + type (time_type), intent(in) :: Time + + type(time_type) :: Time_prev, Time_next +!----------------------------------------------------------------------- + + Time_prev = Time ! two time-level scheme + Time_next = Time + Time_step_atmos + +!---- dynamics ----- + + call bgrid_core_driver ( Time_next, Var, Var_dt, Dynam, omega ) + +!---- call physics ----- + + call bgrid_physics ( physics_window, dt_atmos, Time_next, & + Dynam%Hgrid, Dynam%Vgrid, Dynam, & + Var, Var_dt ) + +!---- time differencing and diagnostics ----- + + call bgrid_core_time_diff ( omega, Time_next, Dynam, Var, Var_dt ) + +!----------------------------------------------------------------------- + + end subroutine atmosphere + +!####################################################################### + + subroutine atmosphere_init ( Time_init, Time, Time_step ) + + type (time_type), intent(in) :: Time_init, Time, Time_step + + integer :: unit, sec, ierr, io, is, ie, js, je, i, j + real, allocatable :: blon(:), blat(:), blon_2d(:,:), blat_2d(:,:) + +!----------------------------------------------------------------------- +!----- read namelist ----- + + if (file_exist('input.nml')) then + unit = open_namelist_file ( ) + ierr=1; do while (ierr /= 0) + read (unit, nml=atmosphere_nml, iostat=io, end=10) + ierr = check_nml_error (io, 'atmosphere_nml') + enddo + 10 call close_file (unit) + endif + +!----- write version and namelist to log file ----- + + call write_version_number ( version, tag ) + if ( mpp_pe() == mpp_root_pe() ) write (stdlog(), nml=atmosphere_nml) + +!---- compute physics/atmos time step in seconds ---- + + Time_step_atmos = Time_step + call get_time (Time_step_atmos, sec) + dt_atmos = real(sec) + +!----- initialize dynamical core ----- + + call bgrid_core_driver_init ( Time_init, Time, Time_step, & + Var, Var_dt, Dynam, atmos_axes ) + +!----- initialize storage needed for vert motion ---- + + omega => var_init (Dynam%Hgrid, Dynam%Vgrid%nlev) + +!----- initialize physics interface ----- + + is = Dynam%Hgrid%Tmp%is + ie = Dynam%Hgrid%Tmp%ie + js = Dynam%Hgrid%Tmp%js + je = Dynam%Hgrid%Tmp%je + allocate ( blon(ie-is+2), blon_2d(ie-is+2,je-js+2) ) + allocate ( blat(je-js+2), blat_2d(ie-is+2,je-js+2) ) + call atmosphere_boundary(blon, blat, global=.false.) + do i=1,ie-is+2 + blon_2d(i,:) = blon(i) + enddo + do j=1,je-js+2 + blat_2d(:,j) = blat(j) + enddo + call hs_forcing_init ( atmos_axes, Time, blon_2d, blat_2d ) + deallocate(blon, blat, blon_2d, blat_2d) + +! ----- use entire grid as window ? ----- + + if (physics_window(1) <= 0) physics_window(1) = ie-is+1 + if (physics_window(2) <= 0) physics_window(2) = je-js+1 + +!----------------------------------------------------------------------- + + end subroutine atmosphere_init + +!####################################################################### + + subroutine atmosphere_end + + integer :: unit + + call bgrid_core_driver_end ( Var, Dynam ) + + end subroutine atmosphere_end + +!####################################################################### +! returns the number of longitude and latitude grid points +! for either the local PEs grid (default) or the global grid + + subroutine atmosphere_resolution (nlon, nlat, global) + + integer, intent(out) :: nlon, nlat + logical, intent(in), optional :: global + +!---- return the size of the grid used for physics computations ---- + + call get_horiz_grid_size (Dynam % Hgrid, TGRID, nlon, nlat, global) + + end subroutine atmosphere_resolution + +!####################################################################### +! returns the longitude and latitude grid box edges +! for either the local PEs grid (default) or the global grid + + subroutine atmosphere_boundary (blon, blat, global) + + real, intent(out) :: blon(:), blat(:) + logical, intent(in), optional :: global + +!----- return the longitudinal and latitudinal grid box edges ---------- + + call get_horiz_grid_bound (Dynam % Hgrid, TGRID, blon, blat, global) + + end subroutine atmosphere_boundary + +!####################################################################### +! returns the axis indices associated with the coupling grid + + subroutine get_atmosphere_axes ( axes ) + + integer, intent(out) :: axes (:) + +!----- returns the axis indices for the atmospheric (mass) grid ----- + + if ( size(axes) < 0 .or. size(axes) > 4 ) call error_mesg ( & + 'get_atmosphere_axes in atmosphere_mod', & + 'size of argument is incorrect', FATAL ) + + axes (1:size(axes)) = atmos_axes (1:size(axes)) + + end subroutine get_atmosphere_axes + +!####################################################################### + +subroutine bgrid_physics ( window, dt_phys, Time, Hgrid, Vgrid, & + Dynam, Var, Var_dt ) + +!----------------------------------------------------------------------- +! +! Time = current time (time_type, see time manager) +! +!----------------------------------------------------------------------- + integer, intent(in) :: window(2) + real, intent(in) :: dt_phys + type(time_type),intent(in) :: Time +type (horiz_grid_type),intent(inout) :: Hgrid +type (vert_grid_type),intent(in) :: Vgrid +type(bgrid_dynam_type),intent(in) :: Dynam +type (prog_var_type),intent(in) :: Var +type (prog_var_type),intent(inout) :: Var_dt + +!----------------------------------------------------------------------- + integer :: j, k, n, is, ie, js, je, i1, i2, j1, j2, nt + integer :: ix, jx, idim, jdim +!----------------------------------------------------------------------- + + real, dimension(window(1),window(2),Vgrid%nlev) :: p_full, u_dt, v_dt + + real, dimension(window(1),window(2),Vgrid%nlev+1) :: p_half + + real, dimension(Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub, & + Vgrid%nlev) :: uh, vh, uh_dt, vh_dt + + real, dimension(window(1),window(2)) :: pssl_new +!----------------------------------------------------------------------- +!---------------------------- do physics ------------------------------- + + idim = window(1) + jdim = window(2) + +! --- momentum and momentum tendency on mass grid --- + + call update_halo (Hgrid, UWND, Var_dt%u, halos=SOUTH+WEST) + call update_halo (Hgrid, VWND, Var_dt%v, halos=SOUTH+WEST) + + if (Dynam%Masks%sigma) then + call change_grid (Hgrid, WIND_GRID, TEMP_GRID, Var%u, Var%v, uh , vh ) + call change_grid (Hgrid, WIND_GRID, TEMP_GRID, Var_dt%u, Var_dt%v, uh_dt, vh_dt) + else + call change_grid (Hgrid, WIND_GRID, TEMP_GRID, & + Var%u, Var%v, uh , vh , mask_inp=Dynam%Masks%Vel%mask) + call change_grid (Hgrid, WIND_GRID, TEMP_GRID, & + Var_dt%u, Var_dt%v, uh_dt, vh_dt, mask_inp=Dynam%Masks%Vel%mask) + endif + +! --- loop through physics windows --- + + nt = Var%ntrace + js = Hgrid%Tmp%js + + do while ( js <= Hgrid%Tmp%je ) + + je = min ( js+jdim-1, Hgrid%Tmp%je ) + jx = je-js+1 + is = Hgrid%Tmp%is + + do while ( is <= Hgrid%Tmp%ie ) + + ie = min ( is+idim-1, Hgrid%Tmp%ie ) + ix = ie-is+1 + +! ---- pass updated surface pressure ---- + pssl_new(1:ix,1:jx) = Var%pssl(is:ie,js:je) + & + Var_dt%pssl(is:ie,js:je) * dt_phys + + call compute_pres_full (Vgrid, pssl_new(1:ix,1:jx), & + p_full(1:ix,1:jx,:)) + call compute_pres_half (Vgrid, pssl_new(1:ix,1:jx), & + p_half(1:ix,1:jx,:)) + + + u_dt(1:ix,1:jx,:) = uh_dt(is:ie,js:je,:) + v_dt(1:ix,1:jx,:) = vh_dt(is:ie,js:je,:) + + +! ---- j-axis indices in the global physics grid ---- + + j1 = js-Hgrid%Tmp%js+1; j2 = j1+(je-js) + i1 = is-Hgrid%Tmp%is+1; i2 = i1+(ie-is) + +!----------------------------------------------------------------------- +!-------------------------- call physics ------------------------------- +!------------ (need to add leap-frog option for uh,vh) ----------------- +!----------------------------------------------------------------------- + if (.not.Dynam%Masks%sigma) then +!------------ eta coordinate ------------------------------------------- + + call hs_forcing ( i1, i2, j1, j2, dt_phys, Time ,& + Hgrid%Tmp%alm(is:ie,js:je) ,& + Hgrid%Tmp%aph(is:ie,js:je) ,& + p_half ( 1:ix, 1:jx,:) ,& + p_full ( 1:ix, 1:jx,:) ,& + uh (is:ie,js:je,:) ,& + vh (is:ie,js:je,:) ,& + Var%t (is:ie,js:je,:) ,& + Var%r (is:ie,js:je,:,:) ,& + uh (is:ie,js:je,:) ,& + vh (is:ie,js:je,:) ,& + Var%t (is:ie,js:je,:) ,& + Var%r (is:ie,js:je,:,:) ,& + u_dt ( 1:ix, 1:jx,:) ,& + v_dt ( 1:ix, 1:jx,:) ,& + Var_dt%t (is:ie,js:je,:) ,& + Var_dt%r (is:ie,js:je,:,:) ,& + mask=Dynam%Masks%Tmp%mask(is:ie,js:je,:) ,& + kbot=Dynam%Masks%Tmp%kbot(is:ie,js:je) ) + + else +!------------- sigma coordinate ---------------------------------------- + + call hs_forcing ( i1, i2, j1, j2, dt_phys, Time ,& + Hgrid%Tmp%alm(is:ie,js:je) ,& + Hgrid%Tmp%aph(is:ie,js:je) ,& + p_half ( 1:ix, 1:jx,:) ,& + p_full ( 1:ix, 1:jx,:) ,& + uh (is:ie,js:je,:) ,& + vh (is:ie,js:je,:) ,& + Var%t (is:ie,js:je,:) ,& + Var%r (is:ie,js:je,:,:) ,& + uh (is:ie,js:je,:) ,& + vh (is:ie,js:je,:) ,& + Var%t (is:ie,js:je,:) ,& + Var%r (is:ie,js:je,:,:) ,& + u_dt ( 1:ix, 1:jx,:) ,& + v_dt ( 1:ix, 1:jx,:) ,& + Var_dt%t (is:ie,js:je,:) ,& + Var_dt%r (is:ie,js:je,:,:) ) + + endif + + ! compute momentum tendencies on mass grid for physics only + ! udt(phys) = udt(current) - udt(before physics) + uh(is:ie,js:je,:) = u_dt(1:ix,1:jx,:) - uh_dt(is:ie,js:je,:) + vh(is:ie,js:je,:) = v_dt(1:ix,1:jx,:) - vh_dt(is:ie,js:je,:) + + is = is + idim + + enddo + + js = js + jdim + + enddo + +!----------------------------------------------------------------------- +! update halos of momentum tendencies on mass grid +! then move momentum tendencies to momentum grid + + call update_halo (Hgrid, TEMP, uh, halos=NORTH+EAST) + call update_halo (Hgrid, TEMP, vh, halos=NORTH+EAST) + + call change_grid (Hgrid, TEMP_GRID, WIND_GRID, uh, vh, uh, vh) + + uh(:,Hgrid%jub,:) = 0.0 ! zero out unused polar halo row + vh(:,Hgrid%jub,:) = 0.0 ! no harm done when not polar row + +!---- update momentum tendencies ---- + + Var_dt%u = Var_dt%u + uh * Dynam%Masks%Vel%mask + Var_dt%v = Var_dt%v + vh * Dynam%Masks%Vel%mask + +!---- update all halo rows ---- + + call update_halo (Hgrid, TEMP, Var_dt%t) + call update_halo (Hgrid, TEMP, Var_dt%r) + call update_halo (Hgrid, UWND, Var_dt%u) + call update_halo (Hgrid, VWND, Var_dt%v) + +!----------------------------------------------------------------------- + +end subroutine bgrid_physics + +!####################################################################### + +end module atmosphere_mod + diff --git a/MOM_code/src/atmos_bgrid/model/bgrid_advection.F90 b/MOM_code/src/atmos_bgrid/model/bgrid_advection.F90 new file mode 100644 index 0000000..79ec8a0 --- /dev/null +++ b/MOM_code/src/atmos_bgrid/model/bgrid_advection.F90 @@ -0,0 +1,1662 @@ + + module bgrid_advection_mod + +!----------------------------------------------------------------------- +! +! performs vertical and horizontal advection +! and negative tracer borrowing/filling +! +!----------------------------------------------------------------------- +!--------------------------- modules ----------------------------------- +!----------------------------------------------------------------------- +use bgrid_horiz_mod , only: horiz_grid_type +use bgrid_vert_mod , only: vert_grid_type, compute_pres_depth +use bgrid_masks_mod , only: grid_mask_type +use bgrid_prog_var_mod , only: prog_var_type +use bgrid_polar_filter_mod, only: pfilt_control_type, polar_filter, & + polar_filter_wind, TGRID +use bgrid_halo_mod , only: update_halo, vel_flux_boundary, & + EAST, WEST, SOUTH, NORTH, NOPOLE, & + TEMP, UWND, VWND, WIND, POLEONLY +use bgrid_change_grid_mod , only: change_grid, EQUAL, AREA, & + UFLX_GRID, VFLX_GRID, TEMP_GRID, WIND_GRID +use vert_advection_mod , only: vert_advection, vert_advection_end, & + SECOND_CENTERED, FOURTH_CENTERED, & + SECOND_CENTERED_WTS, FOURTH_CENTERED_WTS, & + FINITE_VOLUME_LINEAR, FINITE_VOLUME_PARABOLIC, & + FLUX_FORM, WEIGHTED_TENDENCY +!!!use horiz_advection_mod , only: horiz_advection, & +!!! FINITE_VOLUME_LINEAR_HORIZ=>FINITE_VOLUME_LINEAR, & +!!! FINITE_VOLUME_PARABOLIC_HORIZ=>FINITE_VOLUME_PARABOLIC + +use fms_mod, only: error_mesg, FATAL, write_version_number, & + file_exist, open_namelist_file, & + check_nml_error, close_file, & + mpp_pe, mpp_root_pe, stdlog, uppercase, & + mpp_clock_id, mpp_clock_begin, mpp_clock_end, & + MPP_CLOCK_SYNC, CLOCK_MODULE, CLOCK_ROUTINE, CLOCK_LOOP +use mpp_mod, only: input_nml_file, mpp_max +use field_manager_mod, only: MODEL_ATMOS, parse +use tracer_manager_mod, only: query_method, get_tracer_names, get_number_tracers +!----------------------------------------------------------------------- + +implicit none +private + + public :: advection_init, advection, advection_end + +!----------------------------------------------------------------------- +!------------ namelist: bgrid_advection_nml ------------- + +! vert_advec_scheme_wind The vertical advection scheme. +! vert_advec_scheme_temp Possible values are NONE, SECOND_CENTERED, FOURTH_CENTERED, +! vert_advec_scheme_tracer FINITE_VOLUME_LINEAR, or FINITE_VOLUME_PARABOLIC. +! Using finite volume schemes for momentum has not been +! tested and may produce poor results. + + character(len=24) :: vert_advec_scheme_wind = 'SECOND_CENTERED' + character(len=24) :: vert_advec_scheme_temp = 'SECOND_CENTERED' + character(len=24) :: vert_advec_scheme_tracer = 'SECOND_CENTERED' + +! horiz_advec_scheme_wind The horizontal advection scheme. +! horiz_advec_scheme_temp Possible values are NONE, SECOND_CENTERED, FOURTH_CENTERED. +! horiz_advec_scheme_tracer + + character(len=24) :: horiz_advec_scheme_wind = 'SECOND_CENTERED' + character(len=24) :: horiz_advec_scheme_temp = 'SECOND_CENTERED' + character(len=24) :: horiz_advec_scheme_tracer = 'SECOND_CENTERED' + +! advec_weight_wind Weights used for modified Euler-backward time differencing +! advec_weight_temp (i.e., when the scheme is SECOND_CENTERED or FOURTH_CENTERED). +! advec_weight_tracer 0.0 = full Euler-forward (not recommended) +! 1.0 = full Euler-backward + + real :: advec_weight_wind = 0.7 + real :: advec_weight_temp = 0.7 + real :: advec_weight_tracer = 0.7 + +! num_fill_pass The number of successive repetitions of the tracer borrowing scheme. +! This value applies to both the horizontal and vertical schemes. + + integer :: num_fill_pass = 1 + +! temporary undocumented developer flags + +logical :: compute_vert_wind_flux = .false. +character(len=16) :: vert_vel_flux = 'area_weight' +character(len=16) :: horiz_vel_flux = 'equal_weight' + +namelist /bgrid_advection_nml/ horiz_advec_scheme_wind, vert_advec_scheme_wind, & + horiz_advec_scheme_temp, vert_advec_scheme_temp, & + horiz_advec_scheme_tracer, vert_advec_scheme_tracer, & + advec_weight_wind, advec_weight_temp, advec_weight_tracer, & + num_fill_pass ,& + compute_vert_wind_flux, vert_vel_flux, horiz_vel_flux + +!----------------------------------------------------------------------- +!----- private data ----- + +! derived-type containing tracer filling parameters + type trfill_control_type + integer, pointer :: fill_scheme(:) =>NULL(), & + npass_horiz(:) =>NULL(), & + npass_vert(:) =>NULL() + end type trfill_control_type + +! derived-type containing advection parameters + type advec_control_type + type(trfill_control_type) :: Fill + integer, pointer :: scheme(:,:) =>NULL() + real , pointer :: weight(:) =>NULL() + logical :: do_mask4_tmp, do_mask4_vel, & + do_finite_volume_tmp, do_finite_volume_trs + end type advec_control_type + + integer, parameter :: NONE = 7000, & ! may apply to advection or filling + ! filling schemes + EQUAL_BORROW = 8005, & + BOTTOM_BORROW = 8006, & ! not implemented + GLOBAL_BORROW = 8007 ! not implemented + +! advection control parameters +! set via values in namelist or field table + type(advec_control_type),save :: Control + + real, parameter :: c4 = -1./6. ! weights for 4th order centered schemes + real, parameter :: c2 = 1. - 2.*c4 + + logical :: do_log = .true. + logical :: stability_check = .false. ! perform stability check for horizontal + ! finite volume (Lin-Rood) schemes + +! performance timing info + integer :: id_tmp, id_trs, id_vel, id_fill + logical :: do_clock_init = .true. + + character(len=128) :: version='$Id: bgrid_advection.F90,v 19.0 2012/01/06 19:52:53 fms Exp $' + character(len=128) :: tagname='$Name: tikal $' + +!----------------------------------------------------------------------- + +contains + +!####################################################################### + +subroutine advection ( Pfilt, Hgrid, Vgrid, Masks, & + pfilt_opt, dt, dpde_old, dpde, & + few, fns, etadot, u, v, t, Var, Var_dt ) + +type(pfilt_control_type), intent(in) :: Pfilt +type(horiz_grid_type), intent(inout) :: Hgrid +type (vert_grid_type), intent(in) :: Vgrid +type (grid_mask_type), intent(in) :: Masks + integer, intent(in) :: pfilt_opt + real, intent(in) :: dt +real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: & + dpde_old, dpde, u, v, t +real, intent(inout), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: & + few, fns, etadot +type (prog_var_type), intent(in) :: Var +type (prog_var_type), intent(inout) :: Var_dt + +!----------------------------------------------------------------------- +! +! Pfilt = polar filter constants +! Hgrid = horizontal grid constants +! Vgrid = vertical grid constants +! Masks = grid masking constants +! pf_opt = polar filter option flag +! dt = adjustment time step +! dpde_old = pressure thickness of model layers at the end of the +! last advective time step +! dpde = current pressure thickness of model layers +! few, fns = zonal, meridional mass fluxes (Pa-m2/s) +! (a summation since the last call to advection) +! etadot = vertical mass flux (Pa/s) (summation since the last call to advection) +! u, v, t = prognostic variables at the end of the last advective time +! step, note that tracers have not been updated since the last +! advective time step, therefore, r = Var%r + dt*Var_dt%r +! Var = prognostic variables at the end of the last dynamics time +! step, current values would be, uc = Var%u + dt*Var_dt%u +! Var_dt = prognostic variable tendencies, accumulated since the +! variable were updated in Var +! +!----------------------------------------------------------------------- + real, dimension(Hgrid%ilb:Hgrid%iub, Hgrid%jlb:Hgrid%jub, & + Vgrid%nlev) :: dpdt, dpde_xy, r, uc, vc + real, dimension(Hgrid%ilb:Hgrid%iub, Hgrid%jlb:Hgrid%jub, & + Vgrid%nlev,2) :: mask4 + integer :: i, j, k, n, is, ie, js, je +!----------------------------------------------------------------------- + +! ---- update halos for fluxes ---- + + call update_halo (Hgrid, TEMP, few) + call update_halo (Hgrid, VWND, fns) + +! ---- compute pressure tendency in each layer ---- + + dpdt = (dpde - dpde_old) / dt + +! ---- stability diagnostic (CFL for horizontal finite volume schemes) ---- + if (stability_check) call stability_diag ( Hgrid, dt, few, dpde_old, dpde ) + +!----------------------------------------------------------------------- +!------------------ advection of mass fields --------------------------- +!----------------------------------------------------------------------- + +!------ initialize fourth-order mask ---- + + if (Control%do_mask4_tmp) & + call mask4_init (Hgrid, 1, Masks%sigma, Masks%Tmp%mask, mask4) + + ! compute wind components for horizontal finite-volume advection schemes + if (Control%do_finite_volume_tmp .or. Control%do_finite_volume_trs) then + call compute_advecting_wind (Hgrid, dpde_old, dpde, few, fns, uc, vc) + else + uc = 0. + vc = 0. + endif + +!------ temperature advection ------ + + call mpp_clock_begin (id_tmp) + if (Masks%sigma) then + call advect_mass (Hgrid, Pfilt, Control % scheme(:,0), & + Control % weight(0), pfilt_opt, & + dt, dpdt, dpde, few, fns, etadot, & + uc, vc, Var%t, t, Var_dt%t) + else + call advect_mass (Hgrid, Pfilt, Control % scheme(:,0), & + Control % weight(0), pfilt_opt, & + dt, dpdt, dpde, few, fns, etadot, & + uc, vc, Var%t, t, Var_dt%t, & + mask=Masks%Tmp%mask, mask4=mask4) + endif + call mpp_clock_end (id_tmp) + +!------ tracer advection ----------- +! (need to pass all tracers to update pressure tendency part) + + call mpp_clock_begin (id_trs) + do n = 1, Var_dt%ntrace + + r = Var%r(:,:,:,n) + dt*Var_dt%r(:,:,:,n) + + if (Masks%sigma) then + call advect_mass (Hgrid, Pfilt, Control%scheme(:,n), & + Control % weight(n), & + pfilt_opt, dt, dpdt, dpde, & + few, fns, etadot, uc, vc, & + Var%r(:,:,:,n), r, Var_dt%r(:,:,:,n) ) + else + call advect_mass (Hgrid, Pfilt, Control%scheme(:,n), & + Control % weight(n), & + pfilt_opt, dt, dpdt, dpde, & + few, fns, etadot, uc, vc, & + Var%r(:,:,:,n), r, Var_dt%r(:,:,:,n),& + mask=Masks%Tmp%mask, mask4=mask4 ) + endif + + enddo + call mpp_clock_end (id_trs) + +!------ tracer hole filling ------- +! (remove negative tracer values with vert/horiz borrowing) + + call mpp_clock_begin (id_fill) + call vert_borrow ( dt, dpde, Var%r(:,:,:,1:Var_dt%ntrace), & + Var_dt%r(:,:,:,1:Var_dt%ntrace), & + iters = Control % Fill % npass_vert ) + + if (Masks%sigma) then + call horiz_borrow ( Hgrid, dt, dpde, & + Var%r(:,:,:,1:Var_dt%ntrace), & + Var_dt%r(:,:,:,1:Var_dt%ntrace), & + iters = Control % Fill % npass_horiz ) + else + call horiz_borrow ( Hgrid, dt, dpde, & + Var%r(:,:,:,1:Var_dt%ntrace), & + Var_dt%r(:,:,:,1:Var_dt%ntrace), & + mask = Masks%Tmp%mask, & + iters = Control % Fill % npass_horiz ) + endif + call mpp_clock_end (id_fill) + +!----------------------------------------------------------------------- +!------------------ advection of momentum fields ----------------------- +!----------------------------------------------------------------------- + + call mpp_clock_begin (id_vel) + + is = Hgrid % Vel % is; ie = Hgrid % Vel % ie + js = Hgrid % Vel % js; je = Hgrid % Vel % je + + !--- mass fluxes between velocity points --- + + if (trim(horiz_vel_flux(1:5)) == 'equal') then + call change_grid (Hgrid, UFLX_GRID, VFLX_GRID, few, few, weight=EQUAL) + call change_grid (Hgrid, VFLX_GRID, UFLX_GRID, fns, fns, weight=EQUAL) + else + call change_grid (Hgrid, UFLX_GRID, VFLX_GRID, few, few, weight=AREA) + call change_grid (Hgrid, VFLX_GRID, UFLX_GRID, fns, fns, weight=AREA) + endif + + ! compute vertical flux for momentum from horizonal momentum fluxes + if (compute_vert_wind_flux) then + call compute_etadot_vel (Hgrid, Vgrid, Masks, few, fns, etadot ) + endif + + ! no flux across pole + call vel_flux_boundary (Hgrid, fns) + + !--- interpolate mass fields to momentum grid --- + if (.not.compute_vert_wind_flux) then + if (trim(vert_vel_flux(1:4)) == 'area') then + call change_grid (Hgrid, TEMP_GRID, WIND_GRID, etadot, etadot, weight=AREA) + else + call change_grid (Hgrid, TEMP_GRID, WIND_GRID, etadot, etadot, weight=EQUAL) + endif + endif + ! always area-weighted (the default) + call change_grid (Hgrid, TEMP_GRID, WIND_GRID, dpde, dpde_xy) + call change_grid (Hgrid, TEMP_GRID, WIND_GRID, dpdt, dpdt) + + + ! advection of momentum + ! determine whether step-mountain mask are needed + if (Control%do_mask4_vel .and. .not.Masks%sigma) then + call mask4_init (Hgrid, 2, Masks%sigma, Masks%Vel%mask, mask4) + + call advect_vel (Hgrid, Pfilt, Control % scheme(:,-1), & + Control % weight(-1), & + pfilt_opt, dt, dpdt, dpde_xy, & + few, fns, etadot, Var%u, Var%v, u, v, & + Var_dt%u, Var_dt%v, & + mask=Masks%Vel%mask, mask4=mask4) + else + ! sigma case + call advect_vel (Hgrid, Pfilt, Control % scheme(:,-1), & + Control % weight(-1), & + pfilt_opt, dt, dpdt, dpde_xy, & + few, fns, etadot, Var%u, Var%v, u, v, & + Var_dt%u, Var_dt%v) + endif + + call mpp_clock_end (id_vel) +!----------------------------------------------------------------------- +!------ done with fluxes - zero-out ??? ------- + + few = 0.0 + fns = 0.0 + etadot = 0.0 + +!----------------------------------------------------------------------- + +end subroutine advection + +!####################################################################### + +subroutine advect_mass ( Hgrid, Pfilt, scheme, coeff, fopt, dt, & + dpdt, dpn, few, fns, fud, uc, vc, & + ro, r, r_dt, mask, mask4 ) + + type(horiz_grid_type), intent(inout) :: Hgrid + type(pfilt_control_type), intent(in) :: Pfilt + integer, intent(in) :: scheme(2) + integer, intent(in) :: fopt + real, intent(in) :: coeff, dt + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: dpdt, dpn,& + few, fns, fud, ro, r, uc, vc + real, intent(inout), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: r_dt + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:), optional :: mask + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:,:), optional :: mask4 + +!----------------------------------------------------------------------- + + real, dimension(Hgrid%ilb:Hgrid%iub, Hgrid%jlb:Hgrid%jub, & + size(r,3)) :: rst, rst_dt, rst_dt_v, rdpdt + + real :: rcoef + integer :: pass, npass, j, k + integer :: vert_scheme, horiz_scheme + integer, parameter :: FINITE_VOLUME = 1234567 !can not match other numbers? + +!----------------------------------------------------------------------- + + ! set the vertical and horizontal differencing scheme + horiz_scheme = scheme(1) + vert_scheme = scheme(2) + ! rename horizontal finite volume schemes to correct horizontal name + ! if (horiz_scheme == FINITE_VOLUME_LINEAR) horiz_scheme = FINITE_VOLUME_LINEAR_HORIZ + ! if (horiz_scheme == FINITE_VOLUME_PARABOLIC) horiz_scheme = FINITE_VOLUME_PARABOLIC_HORIZ + +!----------------------------------------------------------------------- + + rst = ro + dt * r_dt ! use updated value + rdpdt = r*dpdt + rcoef = coeff + + npass = 1 + if (rcoef > 1.e-4) npass = 2 + ! no advection, psdt correction only + if (vert_scheme == NONE) then + rst_dt_v = 0.0 + if (horiz_scheme == NONE) npass = 1 + endif + ! both vert and horiz are using finite volume + if ( (vert_scheme == FINITE_VOLUME_LINEAR .or. & + vert_scheme == FINITE_VOLUME_PARABOLIC) .and. & + (horiz_scheme == FINITE_VOLUME_LINEAR .or. & + horiz_scheme == FINITE_VOLUME_PARABOLIC) ) then + !(horiz_scheme == FINITE_VOLUME_LINEAR_HORIZ .or. & + ! horiz_scheme == FINITE_VOLUME_PARABOLIC_HORIZ) ) then + npass = 2 + rcoef = 1. + endif + + do pass = 1, npass + + !---- vertical tendency ---- + ! finite volume schemes on pass 1 only + if (vert_scheme == SECOND_CENTERED .or. vert_scheme == SECOND_CENTERED_WTS .or. & + vert_scheme == FOURTH_CENTERED .or. vert_scheme == FOURTH_CENTERED_WTS .or. & + ((vert_scheme == FINITE_VOLUME_LINEAR .or. & + vert_scheme == FINITE_VOLUME_PARABOLIC) .and. pass == 1)) then + call vert_advection ( dt, fud, dpn, rst, rst_dt_v, & + mask=mask, scheme=vert_scheme, & + form=FLUX_FORM, flags=WEIGHTED_TENDENCY ) + endif + + !---- horizontal tendency ---- + + if (horiz_scheme == SECOND_CENTERED) then + call advect_mass_horiz_2nd (Hgrid, few, fns, rst, rst_dt) + if ( fopt >= 1 ) call polar_filter (Pfilt, rst_dt, TGRID, mask) + call update_halo (Hgrid, TEMP, rst_dt) + + else if (horiz_scheme == FOURTH_CENTERED) then + call advect_mass_horiz_4th (Hgrid, few, fns, rst, rst_dt, mask4) + if ( fopt >= 1 ) call polar_filter (Pfilt, rst_dt, TGRID, mask) + call update_halo (Hgrid, TEMP, rst_dt) + + ! compute horizontal finite volume scheme on 2nd pass + else if ((horiz_scheme == FINITE_VOLUME_LINEAR .or. & + horiz_scheme == FINITE_VOLUME_PARABOLIC) .and. pass == 2) then + ! temporary error check + call error_mesg ('bgrid_advection_mod', & + 'horizontal finite volume schemes & + &are not implemented with this release', FATAL) + !call horiz_advection ( Hgrid%Tmp%Domain, dt, Hgrid%Tmp%dx, Hgrid%Tmp%dy, & + ! uc, vc, few, fns, rst, rst_dt, scheme=horiz_scheme ) + ! halos updated by finite volume scheme + ! need update only poles (model b.c. differs) + call update_halo (Hgrid, TEMP, rst_dt, flags=POLEONLY) + + else + rst_dt = 0.0 + endif + + + !---- combine vertical and horizontal tendencies ---- + !---- adjust for pressure tendency ---- + rst_dt = (rst_dt + rst_dt_v - rdpdt) / dpn + ! apply step-mountain mask? + if (present(mask)) rst_dt = rst_dt*mask + + !---- compute new value or return tendency ---- + if (pass < npass) then + rst = ro + dt * (r_dt + rcoef*rst_dt) + else + r_dt = r_dt + rst_dt + endif + + enddo + +!----------------------------------------------------------------------- + +end subroutine advect_mass + +!####################################################################### + +subroutine advect_vel ( Hgrid, Pfilt, scheme, coeff, fopt, dt, & + dpdt, dpn, few, fns, fud, & + uo, vo, u, v, u_dt, v_dt, mask, mask4 ) + + type(horiz_grid_type), intent(inout) :: Hgrid + type(pfilt_control_type), intent(in) :: Pfilt + integer, intent(in) :: scheme(2) + integer, intent(in) :: fopt + real, intent(in) :: coeff, dt + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: dpdt, dpn,& + few, fns, fud, uo, vo, u, v + real, intent(inout), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: u_dt, v_dt + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:), optional :: mask + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:,:), optional :: mask4 + +!----------------------------------------------------------------------- + + real, dimension(Hgrid%ilb:Hgrid%iub, Hgrid%jlb:Hgrid%jub, & + size(u,3)) :: ust_dt, ust_dt_v, & + vst_dt, vst_dt_v +! store ust & vst components together to create larger halo updates + real, dimension(Hgrid%ilb:Hgrid%iub, Hgrid%jlb:Hgrid%jub, & + size(u,3),2) :: uvst + integer, parameter :: UCOMP=1, VCOMP=2 + + integer :: vert_scheme, horiz_scheme + integer :: pass, npass, i, j, k, is, ie, js, je, nlev + +!----------------------------------------------------------------------- + + ! set the vertical differencing scheme + horiz_scheme = scheme(1) + vert_scheme = scheme(2) + +!----------------------------------------------------------------------- + + is = Hgrid%Vel%is; ie = Hgrid%Vel%ie + js = Hgrid%Vel%js; je = Hgrid%Vel%je + nlev = size(u,3) + + uvst(:,:,:,UCOMP) = uo + dt * u_dt ! use updated values + uvst(:,:,:,VCOMP) = vo + dt * v_dt + + ! tendency halos are not up-to-date + ! need to update halos + call update_halo ( Hgrid, WIND, uvst ) + + npass = 1 + if (coeff > 1.e-4) npass = 2 + + do pass = 1, npass + + !---- vertical tendency ---- + ! finite volume schemes on pass 1 only + if (vert_scheme == SECOND_CENTERED .or. vert_scheme == SECOND_CENTERED_WTS .or. & + vert_scheme == FOURTH_CENTERED .or. vert_scheme == FOURTH_CENTERED_WTS .or. & + ((vert_scheme == FINITE_VOLUME_LINEAR .or. & + vert_scheme == FINITE_VOLUME_PARABOLIC) .and. pass == 1)) then + call vert_advection ( dt, fud, dpn, uvst(:,:,:,UCOMP), ust_dt_v, & + mask=mask, scheme=vert_scheme, & + form=FLUX_FORM, flags=WEIGHTED_TENDENCY ) + call vert_advection ( dt, fud, dpn, uvst(:,:,:,VCOMP), vst_dt_v, & + mask=mask, scheme=vert_scheme, & + form=FLUX_FORM, flags=WEIGHTED_TENDENCY ) + else if (vert_scheme == NONE .and. pass == 1) then + ust_dt_v = 0.0 + vst_dt_v = 0.0 + endif + + !---- horizontal tendency ---- + if (horiz_scheme == SECOND_CENTERED) then + call advect_vel_horiz_2nd (Hgrid, few, fns, uvst(:,:,:,UCOMP), & + uvst(:,:,:,VCOMP), ust_dt, vst_dt ) + + else if (horiz_scheme == FOURTH_CENTERED) then + call advect_vel_horiz_4th (Hgrid, few, fns, & + uvst(:,:,:,UCOMP), uvst(:,:,:,VCOMP), & + ust_dt, vst_dt, mask4 ) + endif + + ! polar filter horizontal tendency + if (fopt >= 2) then + call polar_filter_wind (Pfilt, ust_dt, vst_dt, mask) + endif + + !---- combine vertical and horizontal tendencies ---- + !---- adjust for pressure tendency ---- + do k = 1, nlev + do j = js, je + do i = is, ie + ust_dt(i,j,k) = (ust_dt(i,j,k) + ust_dt_v(i,j,k) - & + u(i,j,k)*dpdt(i,j,k)) / dpn(i,j,k) + vst_dt(i,j,k) = (vst_dt(i,j,k) + vst_dt_v(i,j,k) - & + v(i,j,k)*dpdt(i,j,k)) / dpn(i,j,k) + enddo + enddo + enddo + ! apply step-mountain mask? + if (present(mask)) then + do k = 1, nlev + ust_dt(is:ie,js:je,k) = ust_dt(is:ie,js:je,k)*mask(is:ie,js:je,k) + vst_dt(is:ie,js:je,k) = vst_dt(is:ie,js:je,k)*mask(is:ie,js:je,k) + enddo + endif + + !---- compute new value or return tendency ---- + if (pass < npass) then + do k = 1, nlev + do j = js, je + do i = is, ie + uvst(i,j,k,UCOMP) = uo(i,j,k) + dt * (u_dt(i,j,k) + coeff*ust_dt(i,j,k)) + uvst(i,j,k,VCOMP) = vo(i,j,k) + dt * (v_dt(i,j,k) + coeff*vst_dt(i,j,k)) + enddo + enddo + enddo + call update_halo (Hgrid, WIND, uvst) + else + do k = 1, nlev + do j = js, je + do i = is, ie + u_dt(i,j,k) = u_dt(i,j,k) + ust_dt(i,j,k) + v_dt(i,j,k) = v_dt(i,j,k) + vst_dt(i,j,k) + enddo + enddo + enddo + ! NOTE: halos not updated for output tendencies + ! do this in the dynamical core for efficiency + endif + + enddo + +!----------------------------------------------------------------------- + +end subroutine advect_vel + +!####################################################################### + + subroutine advect_mass_horiz_2nd (Hgrid, few, fns, r, rdt) + + type(horiz_grid_type), intent(in) :: Hgrid + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: few, fns, r + real, intent(out), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: rdt + + real, dimension(Hgrid%ilb:Hgrid%iub, Hgrid%jlb:Hgrid%jub) :: frew, frns + integer :: i, j, k + +! second order centered differencing on B-grid temperature grid +! constant grid spacing assumed +! minimum halo size = 1 + + do k = 1, size(r,3) + + !--- horizontal fluxes --- + do j = Hgrid%Tmp%js-1, Hgrid%Tmp%je + do i = Hgrid%Tmp%is-1, Hgrid%Tmp%ie + frew(i,j) = few(i,j,k) * (r(i+1,j,k) + r(i,j,k)) + frns(i,j) = fns(i,j,k) * (r(i,j+1,k) + r(i,j,k)) + enddo + enddo + + !--- horizontal advective tendency --- + do j = Hgrid%Tmp%js, Hgrid%Tmp%je + do i = Hgrid%Tmp%is, Hgrid%Tmp%ie + rdt(i,j,k) = -0.5*Hgrid%Tmp%rarea(j)* & + ((frew(i ,j)+frns(i,j )) & + -(frew(i-1,j)+frns(i,j-1))) + enddo + enddo + + enddo + + end subroutine advect_mass_horiz_2nd + +!####################################################################### + + subroutine advect_mass_horiz_4th (Hgrid, few, fns, r, rdt, mask4) + + type(horiz_grid_type), intent(inout) :: Hgrid + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: few, fns, r + real, intent(out), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: rdt + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:,:), optional :: & + mask4 + + real, dimension(Hgrid%ilb:Hgrid%iub, Hgrid%jlb:Hgrid%jub, & + size(r,3)) :: rew, rns, frew, frns + real, dimension(Hgrid%ilb:Hgrid%iub) :: x2, x4 + real, dimension(Hgrid%ilb:Hgrid%iub) :: y2, y4 + integer :: i, j, k, is, ie, js, je + +! fourth order centered differencing on B-grid temperature grid +! constant grid spacing assumed +! assumed halo size = 1 + + is = Hgrid % Tmp % is; ie = Hgrid % Tmp % ie + js = Hgrid % Tmp % js; je = Hgrid % Tmp % je + + rns(:,Hgrid%jub,:) = 0.0 + do k = 1, size(r,3) + do j = Hgrid%jlb,Hgrid%jub + do i = Hgrid%ilb,Hgrid%iub-1 + rew(i,j,k) = r(i+1,j,k)+r(i,j,k) + enddo + enddo + do j = Hgrid%jlb,Hgrid%jub-1 + do i = Hgrid%ilb,Hgrid%iub + rns(i,j,k) = r(i,j+1,k)+r(i,j,k) + enddo + enddo + enddo + ! assumed halosize = 1 + call update_halo (Hgrid,TEMP,rew,halos=EAST) + call update_halo (Hgrid,UWND,rns,halos=NORTH+NOPOLE) + +! ---- horizontal fluxes ---- + + if (present(mask4)) then + frew=0.0; frns=0.0 + do k = 1, size(r,3) + do j = js, je + do i = Hgrid%ilb+1, ie + x4(i) = mask4(i,j,k,1) + x2(i) = 1.0 - 2.*x4(i) + frew(i,j,k) = few(i,j,k) * ( x2(i) * rew(i,j,k) & + + x4(i) * (rew(i-1,j,k) + rew(i+1,j,k)) ) + enddo + enddo + do j = Hgrid%jlb+1, je + do i = is, ie + y4(i) = mask4(i,j,k,2) + y2(i) = 1.0 - 2.*y4(i) + frns(i,j,k) = fns(i,j,k) * ( y2(i) * rns(i,j,k) & + + y4(i) * (rns(i,j-1,k) + rns(i,j+1,k)) ) + enddo + enddo + enddo + else + frew=0.0; frns=0.0 + do k = 1, size(r,3) + do j = js, je + do i = Hgrid%ilb+1, ie + frew(i,j,k) = few(i,j,k) * ( c2 * rew(i,j,k) & + + c4 * (rew(i-1,j,k) + rew(i+1,j,k)) ) + enddo + enddo + do j = Hgrid%jlb+1, je + do i = is, ie + frns(i,j,k) = fns(i,j,k) * ( c2 * rns(i,j,k) & + + c4 * (rns(i,j-1,k) + rns(i,j+1,k)) ) + enddo + enddo + enddo + endif + + ! assumed halosize = 1 + call update_halo (Hgrid,TEMP,frew,halos=WEST) + call update_halo (Hgrid,VWND,frns,halos=SOUTH) + +! ---- horizontal advective tendency ---- + + do k = 1, size(r,3) + do j = js, je + do i = is, ie + rdt(i,j,k) = -0.5*Hgrid%Tmp%rarea(j)* & + ((frew(i ,j,k)+frns(i,j ,k)) & + -(frew(i-1,j,k)+frns(i,j-1,k))) + enddo + enddo + enddo + + + end subroutine advect_mass_horiz_4th + +!####################################################################### + + subroutine advect_vel_horiz_2nd (Hgrid, few, fns, u, v, udt, vdt) + + type(horiz_grid_type), intent(in) :: Hgrid + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: few, fns, & + u, v + real, intent(out), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: udt, vdt + + real, dimension(Hgrid%ilb:Hgrid%iub, Hgrid%jlb:Hgrid%jub) :: & + fuew, funs, fvew, fvns + integer :: i, j, k + +! second order centered differencing on B-grid momentum grid +! constant grid spacing assumed +! minimum halo size = 1 + + do k = 1, size(u,3) + + !--- horizontal fluxes --- + do j = Hgrid%Vel%js, Hgrid%Vel%je + do i = Hgrid%Vel%is, Hgrid%Vel%ie+1 + fuew(i,j) = few(i,j,k) * (u(i-1,j,k) + u(i,j,k)) + fvew(i,j) = few(i,j,k) * (v(i-1,j,k) + v(i,j,k)) + enddo + enddo + do j = Hgrid%Vel%js, Hgrid%Vel%je+1 + do i = Hgrid%Vel%is, Hgrid%Vel%ie + funs(i,j) = fns(i,j,k) * (u(i,j-1,k) + u(i,j,k)) + fvns(i,j) = fns(i,j,k) * (v(i,j-1,k) + v(i,j,k)) + enddo + enddo + + !--- horizontal advective tendency ---- + do j = Hgrid%Vel%js, Hgrid%Vel%je + do i = Hgrid%Vel%is, Hgrid%Vel%ie + udt(i,j,k) = -0.5*Hgrid%Vel%rarea(j)* & + ((fuew(i+1,j)+funs(i,j+1)) & + -(fuew(i ,j)+funs(i,j ))) + vdt(i,j,k) = -0.5*Hgrid%Vel%rarea(j)* & + ((fvew(i+1,j)+fvns(i,j+1)) & + -(fvew(i ,j)+fvns(i,j ))) + enddo + enddo + + enddo + + end subroutine advect_vel_horiz_2nd + +!####################################################################### + + subroutine advect_vel_horiz_4th (Hgrid, few, fns, u, v, udt, vdt, & + mask4) + + type(horiz_grid_type), intent(inout) :: Hgrid + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: few, fns, u, v + real, intent(out), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: udt, vdt + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:,:), optional :: & + mask4 + +! compress u & v components into 4th dimension +! this will create larger and more efficient halo updates + real, dimension(Hgrid%ilb:Hgrid%iub, Hgrid%jlb:Hgrid%jub, & + size(u,3),2) :: uvew, uvns, fuvew, fuvns + integer, parameter :: UCOMP=1, VCOMP=2 + + real, dimension(Hgrid%ilb:Hgrid%iub) :: x2, x4 + real, dimension(Hgrid%ilb:Hgrid%iub) :: y2, y4 + real :: z2, z4 + integer :: i, j, k, is, ie, js, je + +! fourth order centered differencing on B-grid momentum grid +! constant grid spacing assumed +! assumed halo size = 1 + + is = Hgrid % Vel % is; ie = Hgrid % Vel % ie + js = Hgrid % Vel % js; je = Hgrid % Vel % je + + + do k = 1, size(u,3) + do j = Hgrid%jlb ,Hgrid%jub + do i = Hgrid%ilb+1,Hgrid%iub + uvew(i,j,k,UCOMP) = u(i-1,j,k)+u(i,j,k) + uvew(i,j,k,VCOMP) = v(i-1,j,k)+v(i,j,k) + enddo + enddo + do j = Hgrid%jlb+1,Hgrid%jub + do i = Hgrid%ilb ,Hgrid%iub + uvns(i,j,k,UCOMP) = u(i,j-1,k)+u(i,j,k) + uvns(i,j,k,VCOMP) = v(i,j-1,k)+v(i,j,k) + enddo + enddo + enddo + ! assumed halosize = 1 + call update_halo (Hgrid,WIND,uvew,halos=WEST) + call update_halo (Hgrid,TEMP,uvns,halos=SOUTH) + + + !---- horizontal fluxes ---- + + if (present(mask4)) then + do k = 1, size(u,3) + do j = js, je + do i = is, Hgrid%iub-1 + x4(i) = mask4(i,j,k,1) + x2(i) = 1.0 - 2.*x4(i) + fuvew(i,j,k,UCOMP) = few(i,j,k) * ( x2(i) * uvew(i,j,k,UCOMP) & + + x4(i) * (uvew(i-1,j,k,UCOMP) + uvew(i+1,j,k,UCOMP)) ) + fuvew(i,j,k,VCOMP) = few(i,j,k) * ( x2(i) * uvew(i,j,k,VCOMP) & + + x4(i) * (uvew(i-1,j,k,VCOMP) + uvew(i+1,j,k,VCOMP)) ) + enddo + enddo + do j = js, Hgrid%jub-1 + do i = is, ie + y4(i) = mask4(i,j,k,2) + y2(i) = 1.0 - 2.*y4(i) + fuvns(i,j,k,UCOMP) = fns(i,j,k) * ( y2(i) * uvns(i,j,k,UCOMP) & + + y4(i) * (uvns(i,j-1,k,UCOMP) + uvns(i,j+1,k,UCOMP)) ) + fuvns(i,j,k,VCOMP) = fns(i,j,k) * ( y2(i) * uvns(i,j,k,VCOMP) & + + y4(i) * (uvns(i,j-1,k,VCOMP) + uvns(i,j+1,k,VCOMP)) ) + enddo + enddo + enddo + else + do k = 1, size(u,3) + do j = js, je + do i = is, Hgrid%iub-1 + fuvew(i,j,k,UCOMP) = few(i,j,k) * ( c2 * uvew(i,j,k,UCOMP) & + + c4 * (uvew(i-1,j,k,UCOMP) + uvew(i+1,j,k,UCOMP)) ) + fuvew(i,j,k,VCOMP) = few(i,j,k) * ( c2 * uvew(i,j,k,VCOMP) & + + c4 * (uvew(i-1,j,k,VCOMP) + uvew(i+1,j,k,VCOMP)) ) + enddo + enddo + do j = js, Hgrid%jub-1 + ! second order near poles + z4 = c4 + if (j <= Hgrid%Vel%jsg+1) z4 = 0. + if (j >= Hgrid%Vel%jeg ) z4 = 0. + z2 = 1.-2.*z4 + do i = is, ie + fuvns(i,j,k,UCOMP) = fns(i,j,k) * ( z2 * uvns(i,j,k,UCOMP) & + + z4 * (uvns(i,j-1,k,UCOMP) + uvns(i,j+1,k,UCOMP)) ) + fuvns(i,j,k,VCOMP) = fns(i,j,k) * ( z2 * uvns(i,j,k,VCOMP) & + + z4 * (uvns(i,j-1,k,VCOMP) + uvns(i,j+1,k,VCOMP)) ) + enddo + enddo + enddo + endif + ! assumed halosize = 1 + call update_halo (Hgrid,WIND,fuvew,halos=EAST) + call update_halo (Hgrid,TEMP,fuvns,halos=NORTH) + + !---- horizontal advective tendency ---- + + do k = 1, size(u,3) + do j = js, je + do i = is, ie + udt(i,j,k) = -0.5*Hgrid%Vel%rarea(j)* & + ((fuvew(i+1,j,k,UCOMP)+fuvns(i,j+1,k,UCOMP)) & + -(fuvew(i ,j,k,UCOMP)+fuvns(i,j ,k,UCOMP))) + vdt(i,j,k) = -0.5*Hgrid%Vel%rarea(j)* & + ((fuvew(i+1,j,k,VCOMP)+fuvns(i,j+1,k,VCOMP)) & + -(fuvew(i ,j,k,VCOMP)+fuvns(i,j ,k,VCOMP))) + enddo + enddo + enddo + + + end subroutine advect_vel_horiz_4th + +!####################################################################### +! computes advecting wind for horizontal finite-volume advection + + subroutine compute_advecting_wind ( Hgrid, dpo, dpn, few, fns, uc, vc ) + type(horiz_grid_type), intent(inout) :: Hgrid + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: dpo, dpn, few, fns + real, intent(out), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: uc, vc + + real :: dp + integer :: i, j, k + + do k = 1, size(uc,3) + do j = Hgrid%jlb, Hgrid%jub + do i = Hgrid%ilb, Hgrid%iub-1 + dp = (dpo(i,j,k)+dpn(i,j,k)+dpo(i+1,j,k)+dpn(i+1,j,k))*0.25 + uc(i,j,k) = few(i,j,k)/(dp*Hgrid%Tmp%dy) + enddo + enddo + enddo + + do k = 1, size(uc,3) + do j = Hgrid%jlb, Hgrid%jub-1 + do i = Hgrid%ilb, Hgrid%iub + dp = (dpo(i,j,k)+dpn(i,j,k)+dpo(i,j+1,k)+dpn(i,j+1,k))*0.25 + vc(i,j,k) = fns(i,j,k)/(dp*Hgrid%Vel%dx(j)) + enddo + enddo + enddo + + call update_halo ( Hgrid, TEMP, uc, halos=EAST ) + call update_halo ( Hgrid, VWND, vc, halos=NORTH ) + + end subroutine compute_advecting_wind + +!####################################################################### +!--- stability diagnostic (CFL for horizontal finite volume scheme) ---- + + subroutine stability_diag ( Hgrid, dt, few, dpo, dpn ) + type(horiz_grid_type), intent(inout) :: Hgrid + real, intent(in) :: dt + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: few, dpo, dpn + + real, dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub) :: uc + real :: cflmax, cfl, dpa + integer :: i, j, k + + cflmax = 0. + do k = 1, size(few,3) + ! compute zonal wind + do j = Hgrid%Tmp%js , Hgrid%Tmp%je + do i = Hgrid%Tmp%is-1, Hgrid%Tmp%ie + dpa = (dpo(i,j,k)+dpn(i,j,k)+dpo(i+1,j,k)+dpn(i+1,j,k))*0.25 + uc(i,j) = few(i,j,k)/(dpa*Hgrid%Tmp%dy) + enddo + enddo + do j = Hgrid%Tmp%js, Hgrid%Tmp%je + do i = Hgrid%Tmp%is, Hgrid%Tmp%ie + cfl = abs(uc(i,j)-uc(i-1,j))*dt/Hgrid%Tmp%dx(j) + cflmax = max(cflmax,cfl) + enddo + enddo + enddo + call mpp_max (cflmax) + if (mpp_pe() == mpp_root_pe()) then + if (cflmax > 1.0) then + print *, 'x-axis stability violated, cfl = ', cflmax + endif + endif + + end subroutine stability_diag + +!####################################################################### + + subroutine mask4_init (Hgrid, grid, sigma, mask, mask4) + + type(horiz_grid_type), intent(inout) :: Hgrid + integer, intent(in) :: grid + logical, intent(in) :: sigma + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: mask + real, intent(out), dimension(Hgrid%ilb:,Hgrid%jlb:,:,:) :: mask4 + real, dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub, & + size(mask,3)) :: mew, mns + + integer :: i,j,k,is,ie,js,je,n + + +! horizontal masks + + select case (grid) + + case (1) + if (sigma) then + mask4(:,:,:,1:2) = c4 + else + + ! initialize + mask4 = 0.0 + mns(:,Hgrid%jub,:) = 0.0 + + do k = 1, size(mask,3) + do j = Hgrid%jlb,Hgrid%jub + do i = Hgrid%ilb,Hgrid%iub-1 + mew(i,j,k) = mask(i+1,j,k)*mask(i,j,k) + enddo + enddo + do j = Hgrid%jlb,Hgrid%jub-1 + do i = Hgrid%ilb,Hgrid%iub + mns(i,j,k) = mask(i,j+1,k)*mask(i,j,k) + enddo + enddo + enddo + ! assumed halosize = 1 + call update_halo (Hgrid,TEMP,mew,halos=EAST) + call update_halo (Hgrid,UWND,mns,halos=NORTH,flags=NOPOLE) + + do k = 1, size(mask,3) + ! x-axis + do j = Hgrid%Tmp%js, Hgrid%Tmp%je + do i = Hgrid%ilb+1, Hgrid%Tmp%ie + !mask4(i,j,k,1) = mew(i-1,j,k)<.01 .or. mew(i,j,k)<.01 .or. mew(i+1,j,k)<.01 + !mask4(i,j,k,1) = mew(i-1,j,k) * mew(i,j,k) * mew(i+1,j,k) + mask4(i,j,k,1) = c4 * mew(i-1,j,k) * mew(i+1,j,k) + enddo + enddo + ! y-axis + do j = Hgrid%jlb+1, Hgrid%Tmp%je + do i = Hgrid%Tmp%is, Hgrid%Tmp%ie + !mask4(i,j,k,2) = mns(i,j-1,k)<.01 .or. mns(i,j,k)<.01 .or. mns(i,j-1,k)<.01 + !mask4(i,j,k,2) = mns(i,j-1,k) * mns(i,j,k) * mns(i,j+1,k) + mask4(i,j,k,2) = c4 * mns(i,j-1,k) * mns(i,j+1,k) + enddo + enddo + enddo + endif + + case (2) + if (sigma) then + mask4(:,:,:,1:2) = c4 + mns = 1.0 + else + ! initialize + mask4 = 0.0 + do k = 1, size(mask,3) + do j = Hgrid%jlb ,Hgrid%jub + do i = Hgrid%ilb+1,Hgrid%iub + mew(i,j,k) = mask(i-1,j,k)*mask(i,j,k) + enddo + enddo + do j = Hgrid%jlb+1,Hgrid%jub + do i = Hgrid%ilb ,Hgrid%iub + mns(i,j,k) = mask(i,j-1,k)*mask(i,j,k) + enddo + enddo + enddo + ! assumed halosize = 1 + call update_halo (Hgrid,UWND,mew,halos=WEST) + call update_halo (Hgrid,TEMP,mns,halos=SOUTH,flags=NOPOLE) + endif + ! use second order in meridional direction near poles + call vel_flux_boundary (Hgrid,mns) + + if (.not.sigma) then + do k = 1, size(mask,3) + do j = Hgrid%Vel%js, Hgrid%Vel%je + do i = Hgrid%Vel%is, Hgrid%iub-1 + mask4(i,j,k,1) = c4 * mew(i-1,j,k) * mew(i+1,j,k) + enddo + enddo + enddo + endif + + do k = 1, size(mask,3) + do j = Hgrid%Vel%js, Hgrid%jub-1 + do i = Hgrid%Vel%is, Hgrid%Vel%ie + mask4(i,j,k,2) = c4 * mns(i,j-1,k) * mns(i,j+1,k) + enddo + enddo + enddo + + end select + + + end subroutine mask4_init + +!####################################################################### +! initialization routine + + subroutine advection_init ( Hgrid ) + +! INPUT: Hgrid = horizontal grid constants +! RESULT: reads bgrid_advection_nml namelist +! defines advection control parameters (stored in advec_control_type) + + type(horiz_grid_type), intent(in) :: Hgrid + + real :: wt + integer :: n, m, np, ntrace, unit, ierr, io, logunit + character(len=32) :: advec_methods(2) = (/ 'advec_horiz', 'advec_vert ' /) + character(len=128) :: scheme, params, name +!----------------------------------------------------------------------- +! read namelist + if (file_exist('input.nml')) then +#ifdef INTERNAL_FILE_NML + read (input_nml_file, nml=bgrid_advection_nml, iostat=io) + ierr = check_nml_error(io,'bgrid_advection_nml') +#else + unit = open_namelist_file ( ) + ierr=1; do while (ierr /= 0) + read (unit, nml=bgrid_advection_nml, iostat=io, end=5) + ierr = check_nml_error (io, 'bgrid_advection_nml') + enddo + 5 call close_file (unit) +#endif + endif + logunit = stdlog() +! write version, namelist info to log file + if (do_log) then + call write_version_number (version,tagname) + if (mpp_pe() == mpp_root_pe()) write (logunit, nml=bgrid_advection_nml) + do_log = .false. + endif + + ! determine the number of prognostic tracers + call get_number_tracers ( MODEL_ATMOS, num_prog=ntrace ) + + ! allocate space for the control parameters + allocate ( Control%scheme (2,-1:ntrace), & + Control%weight (-1:ntrace) ) + allocate ( Control%Fill%fill_scheme (ntrace), & + Control%Fill%npass_horiz (ntrace), & + Control%Fill%npass_vert (ntrace) ) + + ! set namelist values of control parameters + + Control%scheme(1,-1) = set_advec_scheme( horiz_advec_scheme_wind ) + Control%scheme(2,-1) = set_advec_scheme( vert_advec_scheme_wind ) + Control%weight (-1) = advec_weight_wind + Control%scheme(1, 0) = set_advec_scheme( horiz_advec_scheme_temp ) + Control%scheme(2, 0) = set_advec_scheme( vert_advec_scheme_temp ) + Control%weight ( 0) = advec_weight_temp + do n = 1, ntrace + Control%scheme(1, n) = set_advec_scheme( horiz_advec_scheme_tracer ) + Control%scheme(2, n) = set_advec_scheme( vert_advec_scheme_tracer ) + Control%weight ( n) = advec_weight_tracer + ! parameters for tracer filling/borrowing + Control%Fill%npass_horiz(n) = num_fill_pass + Control%Fill%npass_vert (n) = num_fill_pass + Control%Fill%fill_scheme(n) = NONE + enddo + ! currently only one possible filling scheme + if (maxval(Control%Fill%npass_horiz) > 0 .or. maxval(Control%Fill%npass_vert) > 0) & + Control%Fill%fill_scheme = EQUAL_BORROW + + ! process tracer table information for advection methods + do n = 1, ntrace + do m = 1, 2 + if (query_method(trim(advec_methods(m)), MODEL_ATMOS, n, scheme, params)) then + Control%scheme(m,n) = set_advec_scheme( scheme ) + ! parse e-b weight + if (Control%scheme(m,n) == SECOND_CENTERED .or. & + Control%scheme(m,n) == FOURTH_CENTERED) then + if (parse(params,'wt', wt) == 1) Control%weight(n) = wt + endif + endif + enddo + enddo + + ! error check for all Euler weights + do n = -1, ntrace + if (Control%weight(n) < 0.0 .or. Control%weight(n) > 1.0) & + call error_mesg ('bgrid_advection_mod', & + 'E-B weight out of range [0,1]', FATAL) + enddo + + ! process tracer table information for filling method + do n = 1, ntrace + if (query_method('filling', MODEL_ATMOS, n, scheme, params)) then + if (uppercase(trim(scheme)) == 'LOCAL') then + Control%Fill%fill_scheme(n) = EQUAL_BORROW + Control%Fill%npass_horiz(n) = 1 + Control%Fill%npass_vert (n) = 1 + !else if (uppercase(trim(scheme)) == 'GLOBAL') then + ! Control%Fill%fill_scheme(n) = GLOBAL_BORROW + else if (uppercase(trim(scheme)) == 'NONE') then + Control%Fill%fill_scheme(n) = NONE + Control%Fill%npass_horiz(n) = 0 + Control%Fill%npass_vert (n) = 0 + else + call error_mesg ('bgrid_advection_mod', & + 'invalid filling scheme, '//uppercase(trim(scheme)), FATAL) + endif + ! parse number of filling passes + if (Control%Fill%fill_scheme(n) == EQUAL_BORROW) then + if (parse(params,'hp', np) == 1) Control%Fill%npass_horiz(n) = np + if (parse(params,'vp', np) == 1) Control%Fill%npass_vert (n) = np + endif + endif + enddo + + ! print results + if (mpp_pe() == mpp_root_pe()) then + write (logunit,10) 'momentum', & + (trim(echo_advec_scheme(Control%scheme(m,-1))),m=1,2), Control%weight(-1) + write (logunit,10) 'temperature', & + (trim(echo_advec_scheme(Control%scheme(m, 0))),m=1,2), Control%weight( 0) + do n = 1, ntrace + call get_tracer_names (MODEL_ATMOS, n, name) + write (logunit,11) n, trim(name), & + ( trim(echo_advec_scheme(Control%scheme(m,n))),m=1,2), & + Control%weight(n), & + Control%Fill%npass_horiz(n), & + Control%Fill%npass_vert(n) + 10 format (3x, a24, ', HORIZ=',a24, ', VERT=',a24, ', wt=',f7.3) + 11 format (i3, a24, ', HORIZ=',a24, ', VERT=',a24, ', wt=',f7.3, & + ', hp=',i2, ', vp=',i2) + enddo + endif + + ! check if fourth order centered horizontal scheme + Control%do_mask4_vel = Control%scheme(1,-1) == FOURTH_CENTERED + Control%do_mask4_tmp = .false. + do n = 0, ntrace + if (Control%scheme(1,n) == FOURTH_CENTERED) then + Control%do_mask4_tmp = .true. + exit + endif + enddo + ! check if finite_volume horizontal scheme for temperature + if (Control%scheme(1,0) == FINITE_VOLUME_LINEAR .or. & + Control%scheme(1,0) == FINITE_VOLUME_PARABOLIC) then + Control%do_finite_volume_tmp = .true. + else + Control%do_finite_volume_tmp = .false. + endif + ! check if finite_volume horizontal scheme for tracers + Control%do_finite_volume_trs = .false. + do n = 1, ntrace + if (Control%scheme(1,n) == FINITE_VOLUME_LINEAR .or. & + Control%scheme(1,n) == FINITE_VOLUME_PARABOLIC) then + Control%do_finite_volume_trs = .true. + exit + endif + enddo + ! error checks + ! many horizontal schemes are not support with this release + do n = -1, ntrace + if (Control%scheme(1,n) == FINITE_VOLUME_LINEAR .or. & + Control%scheme(1,n) == FINITE_VOLUME_PARABOLIC .or. & + Control%scheme(1,n) == SECOND_CENTERED_WTS .or. & + Control%scheme(1,n) == FOURTH_CENTERED_WTS ) then + call error_mesg ('bgrid_advection_mod', & + 'advection scheme not supported', FATAL) + endif + enddo + +! initialize code sections for performance timing + + if (do_clock_init) then + id_tmp = mpp_clock_id ('BGRID: temperature advection', & + flags=MPP_CLOCK_SYNC, grain=CLOCK_ROUTINE) + id_trs = mpp_clock_id ('BGRID: tracer advection', & + flags=MPP_CLOCK_SYNC, grain=CLOCK_ROUTINE) + id_vel = mpp_clock_id ('BGRID: momentum advection', & + flags=MPP_CLOCK_SYNC, grain=CLOCK_ROUTINE) + id_fill = mpp_clock_id ('BGRID: tracer borrowing', & + flags=MPP_CLOCK_SYNC, grain=CLOCK_ROUTINE) + do_clock_init = .false. + endif + +!----------------------------------------------------------------------- + + end subroutine advection_init + +!####################################################################### + + subroutine advection_end + + ! terminate vertical advection module + call vert_advection_end + + ! terminate finite-volume advection module + ! if (Control%do_finite_volume_tmp .or. Control%do_finite_volume_trs) then + ! call horiz_advection_end + ! endif + + ! free up memory used (although not much) + deallocate ( Control%scheme, Control%weight, & + Control%Fill%fill_scheme, & + Control%Fill%npass_horiz, & + Control%Fill%npass_vert ) + + end subroutine advection_end + +!####################################################################### +! converts character string names to integer parameters +! checks for all valid names, otherwise produces an error + + function set_advec_scheme ( scheme ) result ( advec_scheme ) + character(len=*), intent(in) :: scheme + integer :: advec_scheme + + if (uppercase(trim(scheme)) == 'SECOND_CENTERED') then + advec_scheme = SECOND_CENTERED + else if (uppercase(trim(scheme)) == 'FOURTH_CENTERED') then + advec_scheme = FOURTH_CENTERED + else if (uppercase(trim(scheme)) == 'FOURTH_CENTERED_WTS') then + advec_scheme = FOURTH_CENTERED_WTS + else if (uppercase(trim(scheme)) == 'SECOND_CENTERED_WTS') then + advec_scheme = SECOND_CENTERED_WTS + else if (uppercase(trim(scheme)) == 'FINITE_VOLUME_LINEAR') then + advec_scheme = FINITE_VOLUME_LINEAR + else if (uppercase(trim(scheme)) == 'FINITE_VOLUME_PARABOLIC') then + advec_scheme = FINITE_VOLUME_PARABOLIC + else if (uppercase(trim(scheme)) == 'NONE') then + advec_scheme = NONE + else + call error_mesg ('bgrid_advection_mod', & + 'invalid advection scheme, '//uppercase(trim(scheme)), FATAL) + endif + + end function set_advec_scheme +!----------------------------------------------- +! converts integer parameter values to character string names +! checks for all valid schemes, otherwise produces an error + + function echo_advec_scheme ( scheme_number ) result ( scheme_name ) + integer, intent(in) :: scheme_number + character(len=24) :: scheme_name + + select case (scheme_number) + case(NONE) + scheme_name = 'none ' + case(SECOND_CENTERED) + scheme_name = 'second_centered ' + case(FOURTH_CENTERED) + scheme_name = 'fourth_centered ' + case(SECOND_CENTERED_WTS) + scheme_name = 'second_centered_wts ' + case(FOURTH_CENTERED_WTS) + scheme_name = 'fourth_centered_wts ' + case(FINITE_VOLUME_LINEAR) + scheme_name = 'finite_volume_linear ' + case(FINITE_VOLUME_PARABOLIC) + scheme_name = 'finite_volume_parabolic ' + case default + call error_mesg ('bgrid_advection_mod', & + 'invalid advection scheme number', FATAL) + end select + + end function echo_advec_scheme + +!####################################################################### +! routines to minimize negative tracer values +! conservative horizontal and vertical borrowing +!####################################################################### + +subroutine horiz_borrow (Hgrid, dt, dpde, var, var_dt, mask, iters) + +!----------------------------------------------------------------------- +! +! removes negative values by borrowing from horizontal +! neighbors. (usually for specific humidity or tke ) +! +!----------------------------------------------------------------------- + type(horiz_grid_type), intent(inout) :: Hgrid + real, intent(in) :: dt + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: dpde + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:,:) :: var + real, intent(inout), dimension(Hgrid%ilb:,Hgrid%jlb:,:,:) :: var_dt + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:), optional :: mask +integer, intent(in), dimension(:), optional :: iters +!----------------------------------------------------------------------- +! ( note: 0.0 < flt <= 0.125 ) + real, parameter :: flt = 0.125 + real, parameter :: flt4 = flt*0.25 + real, parameter :: rmin = 0.0 +!----------------------------------------------------------------------- + + real, dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub,size(var,3)) :: & + hew, hns, radp, few, fns, rcur, rdif + + real, dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub) :: rew, rns + real, dimension(Hgrid%jlb:Hgrid%jub) :: areax, areay + +integer :: i, j, k, n, is, ie, js, je, nlev, ntrace, knt, mxknt(size(var,4)) +!----------------------------------------------------------------------- + + mxknt = 1; if (present(iters)) mxknt = iters + if (maxval(mxknt) == 0) return + + nlev = size(var,3) + ntrace = size(var,4) + + is = Hgrid%Tmp%is; ie = Hgrid%Tmp%ie + js = Hgrid%Tmp%js; je = Hgrid%Tmp%je + +!----------------------------------------------------------------------- +!------ compute flux coeff common to all variables ------- + + do j = js-1, je + areax(j) = Hgrid%Tmp%area(j)+Hgrid%Tmp%area(j) + areay(j) = Hgrid%Tmp%area(j)+Hgrid%Tmp%area(j+1) + enddo + + do k = 1, nlev + do j = js-1, je + do i = is-1, ie + hew(i,j,k) = areax(j)*(dpde(i,j,k)+dpde(i+1,j,k)) + hns(i,j,k) = areay(j)*(dpde(i,j,k)+dpde(i,j+1,k)) + enddo + enddo + enddo + ! apply step-mountain mask? + if (present(mask)) then + do k = 1, nlev + do j = js-1, je + do i = is-1, ie + hew(i,j,k) = hew(i,j,k)*mask(i,j,k)*mask(i+1,j,k) + hns(i,j,k) = hns(i,j,k)*mask(i,j,k)*mask(i,j+1,k) + enddo + enddo + enddo + endif + + do k = 1, nlev + do j = js, je + radp(:,j,k) = flt4/(Hgrid%Tmp%area(j)*dpde(:,j,k)) + enddo + enddo + +!----------------------------------------------------------------------- +!---- tracer loop ----- +!---- store current value of tracer in rcur ---- + + do n = 1, ntrace + + rcur(:,:,:) = var(:,:,:,n) + var_dt(:,:,:,n)*dt + +!---- iteration loop ----- + + few = 0.0; fns = 0.0 + + do knt = 1, mxknt(n) + +!--------------2-nd order lat/lon contributions------------------------- + +! --- do borrowing where adjacent values have opposite sign --- +! but do not turn off fluxes previously turned on + + do k = 1, nlev + do j = js-1, je + do i = is-1, ie + ! east-west fluxes + if ((rcur(i+1,j,k) < rmin .and. rcur(i,j,k) >= rmin) .or. & + (rcur(i+1,j,k) >= rmin .and. rcur(i,j,k) < rmin)) & + few(i,j,k) = hew(i,j,k) + rew(i,j) = (rcur(i+1,j,k)-rcur(i,j,k))*few(i,j,k) + ! north-south fluxes + if ((rcur(i,j+1,k) < rmin .and. rcur(i,j,k) >= rmin) .or. & + (rcur(i,j+1,k) >= rmin .and. rcur(i,j,k) < rmin)) & + fns(i,j,k) = hns(i,j,k) + rns(i,j) = (rcur(i,j+1,k)-rcur(i,j,k))*fns(i,j,k) + enddo + enddo + + do j = js, je + do i = is, ie + rdif(i,j,k) = (rew(i,j)-rew(i-1,j)+ & + rns(i,j)-rns(i,j-1))*radp(i,j,k) + enddo + enddo + enddo + + !---- halo update (assumed that halo size = 1) ---- + + call update_halo (Hgrid, TEMP, rdif) + + !---- update current value of tracer ---- + + rcur(:,:,:) = rcur(:,:,:) + rdif(:,:,:) + +!----------------------------------------------------------------------- + enddo ! iteration loop +!----------------------------------------------------------------------- + + !---- return the tendency ----- + + var_dt(:,:,:,n) = (rcur(:,:,:) - var(:,:,:,n)) / dt + +!----------------------------------------------------------------------- + enddo ! tracer loop +!----------------------------------------------------------------------- + +end subroutine horiz_borrow + +!####################################################################### + + subroutine vert_borrow (dt, dpde, var, var_dt, iters) + +!----------------------------------------------------------------------- +! +! This removes negative specific humidity/mixing ratios by borrowing +! from the grid boxes immediately above and below. If not enough +! is available to fill the negative then a negative will remain. +! +!----------------------------------------------------------------------- + real, intent(in) :: dt, dpde(:,:,:), var(:,:,:,:) + real, intent(inout) :: var_dt(:,:,:,:) +integer, intent(in), optional :: iters(:) +!----------------------------------------------------------------------- + real, dimension(size(var,3)) :: deficit, surplus, rdpdt + real :: divid, ratio_dn, ratio_up, var_dp + integer :: i, j, k, n, m, nlev, num_iters(size(var,4)), num, num_var +!----------------------------------------------------------------------- + + num_iters = 4; if (present(iters)) num_iters = iters + if (maxval(num_iters) == 0) return + + num_var = size(var,4) + if (num_var == 0) return + nlev = size(var,3) + +!---- variable loop and iteration loop ----- + + do n = 1, num_var + do m = 1, num_iters(n) + +!---- existing negatives will not be corrected ---- + + do j = 1, size(var,2) + do i = 1, size(var,1) + + do k = 1, nlev + var_dp = (var(i,j,k,n)+dt*var_dt(i,j,k,n))*dpde(i,j,k) + deficit(k) = min(var_dp,0.0) + surplus(k) = max(var_dp,0.0) + rdpdt(k) = 1./(dpde(i,j,k)*dt) + enddo + +!---- top level ---- + + if (deficit(1) < 0.0) then + divid = max(-surplus(2)/deficit(1),1.0) + ratio_dn = surplus(2)/divid + var_dt(i,j,1,n) = var_dt(i,j,1,n) + ratio_dn*rdpdt(1) + var_dt(i,j,2,n) = var_dt(i,j,2,n) - ratio_dn*rdpdt(2) + surplus(2) = max(surplus(2)-ratio_dn,0.) + endif + +!---- interior levels ---- + + do k = 2, nlev-1 + if (deficit(k) < 0.0) then + divid = max(-(surplus(k-1)+surplus(k+1))/deficit(k),1.0) + ratio_up = surplus(k-1)/divid + ratio_dn = surplus(k+1)/divid + var_dt(i,j,k,n) = var_dt(i,j,k,n)+(ratio_up+ratio_dn)*rdpdt(k) + var_dt(i,j,k-1,n) = var_dt(i,j,k-1,n)-ratio_up*rdpdt(k-1) + var_dt(i,j,k+1,n) = var_dt(i,j,k+1,n)-ratio_dn*rdpdt(k+1) + surplus(k+1) = max(surplus(k+1)-ratio_dn,0.) + endif + enddo + +!---- bottom level ---- + + if (deficit(nlev) < 0.0) then + divid = max(-surplus(nlev-1)/deficit(nlev),1.0) + ratio_up = surplus(nlev-1)/divid + var_dt(i,j,nlev ,n) = var_dt(i,j,nlev ,n)+ratio_up*rdpdt(nlev) + var_dt(i,j,nlev-1,n) = var_dt(i,j,nlev-1,n)-ratio_up*rdpdt(nlev-1) + endif + + enddo + enddo + + enddo + enddo + +!----------------------------------------------------------------------- + + end subroutine vert_borrow + +!####################################################################### + +subroutine compute_etadot_vel ( Hgrid, Vgrid, Masks, few, fns, etadot ) +!subroutine compute_etadot_vel ( Hgrid, Vgrid, Masks, res, few, fns, etadot ) + +type(horiz_grid_type), intent(in) :: Hgrid +type (vert_grid_type), intent(in) :: Vgrid +type (grid_mask_type), intent(in) :: Masks +!real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:) :: res +real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: few, fns +real, intent(out), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: etadot + +real, dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub) :: sdiv +integer :: i, j, k, is, ie, js, je, nlev + +! this code will not work with the eta coordinate +! the variable res need to be added as an argument + if (.not.Masks%sigma) call error_mesg ('bgrid_advection_mod', & + 'etadot cannot be recomputed for the eta coordinate', FATAL) + + + is = Hgrid%Vel%is; ie = Hgrid%Vel%ie + js = Hgrid%Vel%js; je = Hgrid%Vel%je + nlev = size(few,3) + + etadot = 0. + sdiv = 0. + + do k = 1, nlev + + ! vertical integral of divergence at velocity points + ! only need etadot for velocity compute domain + do j = js, je + do i = is, ie + sdiv(i,j) = sdiv(i,j) + ((few(i+1,j,k)+fns(i,j+1,k))- & + (few(i ,j,k)+fns(i,j ,k))) & + *Hgrid%Vel%rarea(j) + enddo + enddo + + if (k < nlev) etadot(:,:,k+1) = -sdiv(:,:) + + enddo + + ! finally include d(ps)/dt term + do k = 2, nlev + !etadot(:,:,k) = etadot(:,:,k) + sdiv(:,:)*res(:,:)*Vgrid%eta(k)) + etadot(:,:,k) = etadot(:,:,k) + sdiv(:,:)*Vgrid%eta(k) + if (.not.Masks%sigma) etadot(:,:,k) = etadot(:,:,k)*Masks%Vel%mask(:,:,k) + enddo + +end subroutine compute_etadot_vel + +!####################################################################### + +end module bgrid_advection_mod + diff --git a/MOM_code/src/atmos_bgrid/model/bgrid_conserve_energy.F90 b/MOM_code/src/atmos_bgrid/model/bgrid_conserve_energy.F90 new file mode 100644 index 0000000..a7ae6ae --- /dev/null +++ b/MOM_code/src/atmos_bgrid/model/bgrid_conserve_energy.F90 @@ -0,0 +1,189 @@ + +module bgrid_conserve_energy_mod + +!------------------------------------------------------------------ +! Enforces energy conservation by computing a correction term +!------------------------------------------------------------------ +! This module computes a correction to the temperature tendency to +! conserve the globally-averaged total energy, TE = cp*T + KE. +! The assumption is made that the input tendencies are only +! due to the dynamical core. +! +! The global average of TE is weighted by pressure and area, +! and therefore the time rate of change of pressure must also be +! considered. The correction is applied as a global constant value. +! +! Diagnostics fields that are available (through the diag_manager) +! have few spatial patterns because of the uniform global correction. +!------------------------------------------------------------------ + +use bgrid_horiz_mod, only: horiz_grid_type, update_np, VELGRID => VGRID +use bgrid_vert_mod, only: vert_grid_type, compute_pres_depth +use bgrid_masks_mod, only: grid_mask_type +use bgrid_prog_var_mod, only: prog_var_type +use bgrid_change_grid_mod, only: change_grid, TEMP_GRID, WIND_GRID + +use time_manager_mod, only: time_type +use diag_manager_mod, only: register_diag_field, send_data +use fms_mod, only: error_mesg, FATAL, stdlog, & + write_version_number, & + mpp_pe, mpp_root_pe, & + mpp_clock_id, & + mpp_clock_begin, & + mpp_clock_end, & + MPP_CLOCK_SYNC, CLOCK_MODULE +use constants_mod, only: CP_AIR, GRAV +use mpp_domains_mod, only: mpp_global_sum, BITWISE_EXACT_SUM + + implicit none + private + + public :: bgrid_conserve_energy_init, bgrid_conserve_energy, & + bgrid_conserve_energy_end + +!------------------------------------------------------------------ +! private module data + character(len=128) :: version = '$Id: bgrid_conserve_energy.F90,v 19.0 2012/01/06 19:53:25 fms Exp $' + character(len=128) :: tag = '$Name: tikal $' + +! saves the total correction for the entire run + real :: total_correction + +! for diagnostics + character(len=8) :: mod_name = 'dynamics' + integer :: id_tdt_diss, id_diss_heat + + integer :: id_clock + logical :: do_init = .true. + +contains +!################################################################ + + subroutine bgrid_conserve_energy ( dt, Time, Hgrid, Vgrid, Masks, & + Var, Var_dt ) + real, intent(in) :: dt + type (time_type), intent(in) :: Time + type(horiz_grid_type), intent(in) :: Hgrid + type (vert_grid_type), intent(in) :: Vgrid + type (grid_mask_type), intent(in) :: Masks + type (prog_var_type), intent(in) :: Var + type (prog_var_type), intent(inout) :: Var_dt + + real, dimension(Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub, Vgrid%nlev) :: tcor, vcor, pwt, dpde, dpde_vel, & + dpde_old, dpde_old_vel + real, dimension(Hgrid%ilb:Hgrid%iub, Hgrid%jlb:Hgrid%jub) :: diss_heat, pssl_new + real :: sum_tcor, sum_vcor, sum_pwt, correction + integer :: j, k + logical :: used + + if (do_init) call error_mesg ('bgrid_conserve_energy', & + 'initializtion not called', FATAL) + call mpp_clock_begin (id_clock) + + ! compute mass weights (at tau and tau+1) + pssl_new = Var%pssl + dt*Var_dt%pssl + call compute_pres_depth ( Vgrid, Var%pssl, dpde_old ) + call compute_pres_depth ( Vgrid, pssl_new, dpde ) + call change_grid ( Hgrid, TEMP_GRID, WIND_GRID, dpde_old, dpde, & + dpde_old_vel, dpde_vel ) + + ! compute local correction terms + ! also need to take into account time rate of change of pressure + vcor = ((Var%u+.5*dt*Var_dt%u)*Var_dt%u + & + (Var%v+.5*dt*Var_dt%v)*Var_dt%v) * dpde_vel + & + 0.5*(Var%u**2+Var%v**2)*(dpde_vel-dpde_old_vel)/dt + tcor = Var_dt%t*dpde + Var%t*(dpde-dpde_old)/dt + do k = 1, Vgrid%nlev + do j = Hgrid%jlb, Hgrid%jub + vcor(:,j,k) = Hgrid%Vel%area(j) * vcor (:,j,k) + tcor(:,j,k) = Hgrid%Tmp%area(j) * tcor (:,j,k) + pwt (:,j,k) = Hgrid%Tmp%area(j) * dpde (:,j,k) + enddo + enddo + + ! compute bit-reproducible global sums + ! pass only data domain for velocity grid + sum_vcor = mpp_global_sum ( Hgrid%Vel%Domain, vcor(:,Hgrid%Vel%jsd:Hgrid%Vel%jed,:), & + flags=BITWISE_EXACT_SUM ) + sum_tcor = mpp_global_sum ( Hgrid%Tmp%Domain, tcor, flags=BITWISE_EXACT_SUM ) + sum_pwt = mpp_global_sum ( Hgrid%Tmp%Domain, pwt, flags=BITWISE_EXACT_SUM ) + + ! global correction + correction = -( sum_tcor + sum_vcor/CP_AIR ) / sum_pwt + + ! add on tendency + Var_dt%t = Var_dt%t + correction + ! save total correction (as a potential diagnostic) + total_correction = total_correction + correction + + !------ diagnostics section ------ + + if ( id_tdt_diss > 0 .or. id_diss_heat > 0 ) then + tcor = correction + if (.not.Masks%sigma) tcor = tcor*Masks%Tmp%mask ! zero-out below surface + endif + + if ( id_tdt_diss > 0 ) then + ! this will be a very boring 3d diagnostic + used = send_data ( id_tdt_diss, tcor(Hgrid%Tmp%is:Hgrid%Tmp%ie,Hgrid%Tmp%js:Hgrid%Tmp%je,:), & + Time, mask=Masks%Tmp%mask(Hgrid%Tmp%is:Hgrid%Tmp%ie,Hgrid%Tmp%js:Hgrid%Tmp%je,:) > 0.5 ) + endif + + if ( id_diss_heat > 0 ) then + ! vertical integral of ke dissipation + diss_heat = CP_AIR/GRAV * sum( tcor*dpde, 3 ) + used = send_data ( id_diss_heat, & + diss_heat(Hgrid%Tmp%is:Hgrid%Tmp%ie,Hgrid%Tmp%js:Hgrid%Tmp%je), Time ) + endif + + call mpp_clock_end (id_clock) + + end subroutine bgrid_conserve_energy + +!################################################################ + + subroutine bgrid_conserve_energy_init ( Time, axes ) + type(time_type), intent(in) :: Time + integer, intent(in) :: axes(3) + + call write_version_number (version,tag) + + id_clock = mpp_clock_id ('BGRID: conserve_energy', & + flags=MPP_CLOCK_SYNC, grain=CLOCK_MODULE) + +! initialize diagnostics related to the energy conservation + + id_tdt_diss = register_diag_field ( mod_name, 'tdt_diss_dynam', axes(1:3), Time, & + 'Dissipative heating from dynamical core', & + 'deg_k/s', missing_value=-1.e10 ) + + id_diss_heat = register_diag_field & + ( mod_name, 'diss_heat_dynam', axes(1:2), Time, & + 'Integrated dissipative heating for dynamical core', & + 'W/m2' ) + + total_correction = 0. + + do_init = .false. + + end subroutine bgrid_conserve_energy_init + +!################################################################ + + subroutine bgrid_conserve_energy_end + + integer :: logunit + ! rewrite module name and version info to log file + call write_version_number (version,tag) + ! write diagnostic to log file + logunit = stdlog() + if (mpp_pe() == mpp_root_pe()) write (logunit,*) & + 'Total dissipative heating from dynamical core (deg/s) = ', total_correction + + end subroutine bgrid_conserve_energy_end + +!################################################################ + +end module bgrid_conserve_energy_mod + diff --git a/MOM_code/src/atmos_bgrid/model/bgrid_core.F90 b/MOM_code/src/atmos_bgrid/model/bgrid_core.F90 new file mode 100644 index 0000000..16a4e69 --- /dev/null +++ b/MOM_code/src/atmos_bgrid/model/bgrid_core.F90 @@ -0,0 +1,655 @@ + +module bgrid_core_mod + +!----------------------------------------------------------------------- +! +! gfdl global b-grid dynamical core +! +! (with eta and hybrid pressure coordinate) +! +!----------------------------------------------------------------------- +!--------------------------- modules ----------------------------------- +!----------------------------------------------------------------------- + +use bgrid_prog_var_mod , only: prog_var_type, var_init, & + prog_var_times_scalar +use bgrid_horiz_mod , only: horiz_grid_type +use bgrid_vert_mod , only: vert_grid_type, compute_pres_depth, & + compute_pressures +use bgrid_masks_mod , only: grid_mask_type, grid_masks_init +use bgrid_advection_mod , only: advection_init, advection, advection_end +use bgrid_horiz_diff_mod , only: horiz_diff_init, horiz_diff +use bgrid_horiz_adjust_mod, only: horiz_adjust_vel, horiz_adjust_mass, & + press_grad, compute_grad_pres, div_damping, & + press_grad_fv +use bgrid_vert_adjust_mod , only: vert_adjust +use bgrid_polar_filter_mod, only: pfilt_control_type, polar_filter_init, & + polar_filter, polar_filter_wind, TGRID +use bgrid_halo_mod , only: update_halo, TEMP, UWND, VWND +use bgrid_sponge_mod , only: sponge_driver, sponge_init + +use fms_mod, only: error_mesg, FATAL, write_version_number, & + mpp_clock_id, mpp_clock_begin, mpp_clock_end, & + MPP_CLOCK_SYNC, CLOCK_MODULE_DRIVER, uppercase, & + stdlog +use constants_mod, only: CP_AIR, RDGAS, RVGAS + +use field_manager_mod, only: MODEL_ATMOS +use tracer_manager_mod, only: get_tracer_index + +!----------------------------------------------------------------------- + +implicit none +private + +public update_bgrid_core, bgrid_core_init, bgrid_core_end + +public bgrid_dynam_type + +!----------------------------------------------------------------------- +! ----- defined data types ----- +! Hgrid = horizontal grid constants +! Vgrid = vertical grid constants +! Masks = eta coordinate topography masks and indices +! Pfilt = polar filter constants +! +! ----- 2-dimensional (nlon,nlat) fields ----- +! fis = geopotential height of the surface +! fisl = geopotential height at eta=1. (for eta coord = 0.0, +! res = reciprical of eta at the surface +! +! ----- time step terms ---- +! nt_adv = no. of advection time steps per atmosphere step (integer) +! nt_adj = no. of adjustment time steps per advection step (integer) +! dt_adj = adjustment time step in seconds (real) +! +! ----- miscellaneous ---- +! fopt = filtering option [integer] +! pgf_method = pressure gradient algorithm [integer] +! sphum = tracer index for specific humidity [integer] +! coeff_ddamp = coefficient for divergence damping [real] +! avg_omega = omega averaging flag [logical] +! verbose = verbose flag [integer] +!----------------------------------------------------------------------- + +type bgrid_dynam_type + type(horiz_grid_type), pointer :: Hgrid => NULL() + type (vert_grid_type), pointer :: Vgrid => NULL() + type (grid_mask_type) :: Masks + type (pfilt_control_type) :: Pfilt + real, pointer, dimension(:,:) :: fis => NULL(), & + fisl => NULL(), & + res => NULL() + real :: dt_adj + real :: coeff_ddamp + integer :: nt_adv, nt_adj + integer :: fopt, verbose + integer :: pgf_method + integer :: sphum + logical :: avg_omega +end type bgrid_dynam_type + +!----------------------------------------------------------------------- +!------- internal options ---------! alpha_implicit determines how the + ! coriolis and press grad force + real :: alpha_implicit = 0.5 ! terms are solved + ! = 0.5 trapezoidal implicit + ! = 1.0 fully implicit + + +! parameters for pressure gradient scheme + integer, parameter :: SIMMONS_BURRIDGE=0, FINITE_VOLUME=1 + +!---- internal parameters ---- + + real, parameter :: d608 = (RVGAS-RDGAS)/RDGAS + +!---- version number ---- + + character(len=128) :: version='$Id: bgrid_core.F90,v 19.0 2012/01/06 19:53:27 fms Exp $' + character(len=128) :: tagname='$Name: tikal $' + +!---- performance timing info ---- + + integer :: id_advect, id_adjust + logical :: do_clock_init = .true. + +!----------------------------------------------------------------------- + +contains + +!####################################################################### + + subroutine bgrid_core_init (Dynam, Hgrid, Vgrid, fis, res, dt, ntadj, ntadv, & + pgf_scheme, filter_option, filter_weight, & + ref_lat_filter, ddamp_coeff, avg_omega, & + verbose) + + type(bgrid_dynam_type), intent(inout) :: Dynam + type(horiz_grid_type), intent(in), target :: Hgrid + type (vert_grid_type), intent(in), target :: Vgrid + real, intent(in), dimension(:,:), target :: fis, res + real, intent(in) :: dt + integer, intent(in) :: ntadj, ntadv + +! ---- optional arguments ---- + + character(len=*),intent(in), optional :: pgf_scheme + integer, intent(in), optional :: filter_option, & + filter_weight, & + verbose + real, intent(in), optional :: ref_lat_filter, & + ddamp_coeff + logical, intent(in), optional :: avg_omega + +!----------------------------------------------------------------------- +! +! performs initialization for b-grid dynamics type +! +! input: Hgrid horizontal grid constants +! Vgrid vertical grid constants +! fis geopotential height of the surface +! res reciprocal of eta at the surface +! +! dt adjustment time step in seconds +! ntadj number of adjustment time steps for each +! advective time step [integer] +! ntadv number of advection time steps for each +! update call [integer] +! +! IMPORTANT: The input arguments (Hgrid, Vgrid, fis, res) +! must have space in memory for the entire +! duration of the model integration +! +! input (optional): +! +! filter_option Determines how polar filtering is performed. +! +! filter_weight Weight applied to the polar filter that will +! increase (or decrease) the strength of the standard +! polar filter response function. +! +! ref_lat_filter The reference latitude at which polar filtering +! (in each hemisphere) will begin to be applied. +! +! ddamp_coeff Coefficient for divergence damping. +! +! verbose Flag that control additional printed output +! Currently, this option is not being used. +! +! avg_omega return the omega diagnostic averaged over all +! adjustment time steps +! +! NOTE: also see bgrid_core_driver for description of optional arguments +! +!----------------------------------------------------------------------- + integer :: logunit +! ---- required time step arguments ----- + + Dynam % nt_adj = ntadj + if (Dynam % nt_adj <= 0) call error_mesg ('bgrid_core_init', & + 'input argument ntadj must be >= 1', FATAL) + + Dynam % nt_adv = ntadv + if (Dynam % nt_adv <= 0) call error_mesg ('bgrid_core_init', & + 'input argument ntadv must be >= 1', FATAL) + + Dynam % dt_adj = dt / float(Dynam%nt_adv*Dynam%nt_adj) + if (Dynam % dt_adj <= 0.0) call error_mesg ('bgrid_core_init', & + 'input argument dt must be > 0.', FATAL) + +! ---- optional arguments ---- + + Dynam % fopt = 2 + if (present(filter_option)) Dynam % fopt = filter_option + + Dynam % verbose = 0 + if (present(verbose)) Dynam % verbose = max(0, verbose) + + Dynam % avg_omega = .false. + if (present(avg_omega)) Dynam % avg_omega = avg_omega + +! initialize performance clock + if (do_clock_init) then + ! initialize performance timing + id_advect = mpp_clock_id ('BGRID: advect loop', & + flags=MPP_CLOCK_SYNC, grain=CLOCK_MODULE_DRIVER) + id_adjust = mpp_clock_id ('BGRID: adjust loop', & + flags=MPP_CLOCK_SYNC, grain=CLOCK_MODULE_DRIVER) + do_clock_init = .false. + endif +!----------------------------------------------------------------------- +! ------ pointers ------ + + Dynam % Hgrid => Hgrid + Dynam % Vgrid => Vgrid + Dynam % fis => fis + Dynam % res => res + +!----------------------------------------------------------------------- +! ------- allocate space for other variables ------- + + Dynam%fisl => var_init (Dynam%Hgrid) + +!----------------------------------------------------------------------- +! ---- eta coordinate masks ---- + + call grid_masks_init ( Dynam%Hgrid, Dynam%Vgrid, Dynam%res, Dynam%Masks ) + +! ---- define sea level geop height ---- + if (Dynam%Masks%sigma) then + Dynam%fisl = Dynam%fis + else + Dynam%fisl = 0.0 + endif + +!----------------------------------------------------------------------- +! ---- initialize polar filtering ----- + + call polar_filter_init ( Dynam%Pfilt, Dynam%Hgrid, Dynam%Vgrid%nlev, & + reflat=ref_lat_filter, weight=filter_weight, & + sigma=Dynam%Masks%sigma, verbose=Dynam%verbose ) + +!----------------------------------------------------------------------- +!------- initialization of other bgrid_core modules ---------- + + call advection_init ( Dynam%Hgrid ) + call horiz_diff_init ( Dynam%Hgrid ) + call sponge_init ( Dynam%Hgrid ) + +!----------------------------------------------------------------------- +!------- save other settings ----- + + ! divergence damping + Dynam % coeff_ddamp = ddamp_coeff + ! tracer index for specific humidity + Dynam % sphum = get_tracer_index ( MODEL_ATMOS, 'sphum' ) + ! pressure gradient scheme option + if (uppercase(trim(pgf_scheme)) == 'SIMMONS_BURRIDGE') then + Dynam % pgf_method = SIMMONS_BURRIDGE + else if (uppercase(trim(pgf_scheme)) == 'FINITE_VOLUME') then + Dynam % pgf_method = FINITE_VOLUME + ! cannot use FV pgf with shallow water version (nlev=1) + if (Dynam%Vgrid%nlev == 1) call error_mesg ('bgrid_core_init', & + 'invalid PGF scheme when nlev=1', FATAL) + else if (uppercase(trim(pgf_scheme)) == 'DEFAULT') then + Dynam % pgf_method = SIMMONS_BURRIDGE + else + call error_mesg ('bgrid_core_init', & + 'invalid PGF scheme', FATAL) + endif + +!----------------------------------------------------------------------- + + call write_version_number (version,tagname) + + logunit = stdlog() + write (logunit,10) dt, dt/real(Dynam%nt_adv), Dynam%dt_adj + 10 format (/,'dynamical core time step (seconds) = ',f7.2, & + /,' advective time step (seconds) = ',f7.2, & + /,' adjustment time step (seconds) = ',f7.2,/) + +!----------------------------------------------------------------------- + + end subroutine bgrid_core_init + +!####################################################################### + + subroutine update_bgrid_core (Var, Var_dt, Dynam, omega, div, mfew, mfns ) + +!----------------------------------------------------------------------- +! Var = prognostic variables +! Var_dt = prognostic variable tendencies +! Dynam = data type for dynamical core constants and data +! omega = omega (vertical velocity) diagnostic (Pa/s) +!----------------------------------------------------------------------- + type (prog_var_type), intent(in) :: Var + type (prog_var_type), intent(inout) :: Var_dt + type(bgrid_dynam_type), intent(inout) :: Dynam + real, intent(out), dimension(Dynam%Hgrid%ilb:Dynam%Hgrid%iub, & + Dynam%Hgrid%jlb:Dynam%Hgrid%jub, & + Dynam%Vgrid%nlev) :: omega, div, mfew, mfns +!----------------------------------------------------------------------- + +real, dimension(Dynam%Hgrid%ilb:Dynam%Hgrid%iub, & + Dynam%Hgrid%jlb:Dynam%Hgrid%jub) :: psdt + +real, dimension(Dynam%Hgrid%ilb:Dynam%Hgrid%iub, & + Dynam%Hgrid%jlb:Dynam%Hgrid%jub) :: pssl + +real, dimension(Dynam%Hgrid%ilb:Dynam%Hgrid%iub, & + Dynam%Hgrid%jlb:Dynam%Hgrid%jub, Dynam%Vgrid%nlev) :: & + dpde, few, fns, divp, pgfew, pgfns, dpde_old, & + pfull, wta, wtb, cew, cns, u, v, tq, uo, vo, to, omgalf + +real, dimension(Dynam%Hgrid%ilb:Dynam%Hgrid%iub, & + Dynam%Hgrid%jlb:Dynam%Hgrid%jub, Dynam%Vgrid%nlev+1) & + :: phalf, etadot + + real :: fadv, tdt_adj, scale + integer :: i, k, n, m, nt +!----------------------------------------------------------------------- +! ---- definition of local variables ---- +! +! psdt = surface pressure tendency (Pa/s) +! pssl = surface pressure adjusted to eta=1. +! tq = (virtual) temperature +! divp = mass divergence (Pa/s) +! pgfew = zonal pressure gradient force (at v pts) (m/s2) +! pgfns = meridional pressure gradient force (at v pts) (m/s2) +! dpde = pressure thickness of model layers (Pa) +! pfull = pressure at full model levels +! phalf = pressure at half model levels (between full levels) +! wta, +! wtb = weights for obtaining the pressure at full levels (no units) +! cew, +! cns = grad(p)/p term (zonal and meridional components) (no units) +! few, +! fns = mass fluxes time summed over advection interval (Pa-m2/s) +! (zonal and meridional components) +! etadot = vertical mass flux summed over advection interval (Pa/s) +! omgalf = thermodynamic (omega-alpha) term (Pa/s) +! uo,vo,to = momentum and temperature at the start of an advective time step +! dpde_old = pressure thickness of model layers at the start of an advective time step +! +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!------- number of tracers and variable (time) levels --------- + + nt = Var%ntrace + +! ---- set-up time step ---- + + tdt_adj = Dynam % dt_adj + +! ------ pressure variables ------ + + pssl = Var % pssl + tdt_adj * Var_dt % pssl + + call compute_pressures ( Dynam%Vgrid, pssl, & + phalf, pfull, dpde, wta, wtb ) + + call compute_grad_pres ( Dynam%Hgrid, Dynam%Vgrid%nplev, & + phalf, dpde, wta, wtb, cew, cns ) + +! ------ zero fluxes and diagnostic output ----- + + few = 0.0; fns = 0.0; etadot = 0.0 + + omega = 0.0; div = 0.0; mfew = 0.0; mfns = 0.0 + +!----------------------------------------------------------------------- +!************** start of bgrid_core time step loop ********************* +call mpp_clock_begin (id_advect) + + do m = 1, Dynam % nt_adv + +! ------ save this time level for advection ------ + + dpde_old = dpde + + to = Var % t + tdt_adj * Var_dt % t + uo = Var % u + tdt_adj * Var_dt % u + vo = Var % v + tdt_adj * Var_dt % v + +! ------ variables at current time level ------ + + tq = to + call compute_virt_temp ( Dynam%sphum, tq, Var%r, Var_dt%r, tdt_adj ) + u = uo + v = vo + +!----------------------------------------------------------------------- +!*************** start of adjustment time step loop ******************** +call mpp_clock_end (id_advect) +call mpp_clock_begin (id_adjust) + + do n = 1, Dynam % nt_adj + +!----------------------------------------------------------------------- +!------------------------- compute mass divergence --------------------- +!--------------------- horizontal alpha-omega term --------------------- + + call horiz_adjust_mass ( Dynam%Vgrid%nplev, Dynam%Hgrid, & + Dynam%Masks, u, & + v, dpde, & + cew, cns, & + few, fns, & + divp, omgalf ) + + +! ---- polar filtering ----- + + if (Dynam%fopt >= 1) then + call polar_filter (Dynam%Pfilt, divp, omgalf, TGRID, Dynam%Masks%Tmp%mask) + endif + + call update_halo (Dynam%Hgrid, TEMP, divp ) + call update_halo (Dynam%Hgrid, TEMP, omgalf) + +!--- save divergence diagnostic (units: 1/sec) --- + div = div + divp/dpde + +!----------------------------------------------------------------------- +!------- compute sfc pres tendency, vert. alpha-omega, & vert vel.------ + + call vert_adjust ( Dynam%Vgrid, Dynam%res, divp, wta, wtb, & + Dynam%Masks%Tmp%mask, omgalf, etadot, psdt ) + +!----------------------------------------------------------------------- +!-------- update surface pressure tendency ----------------------------- + + Var_dt % ps = Var_dt % ps + psdt + Var_dt % pssl = Var_dt % pssl + psdt * Dynam % res + +!-------- recompute pressure variables at next time level ----------- + + pssl = Var % pssl + tdt_adj * Var_dt % pssl + call compute_pressures ( Dynam%Vgrid, pssl, phalf, pfull, dpde, & + wta, wtb ) + +!----- do not execute the following code ----- +! with the shallow water version (nlev=1) + if (Dynam%Vgrid%nlev > 1) then +!-------- update thermodynamic tendency ---------- + + omgalf = omgalf/dpde + Var_dt % t = Var_dt % t + omgalf * tq * RDGAS/CP_AIR + +! ---- compute omega diagnostic (Pa/s) ---- + + if (Dynam%avg_omega) then + omega = omgalf * pfull + omega + else + omega = omgalf * pfull + endif + + endif + +!----------------------------------------------------------------------- +!------------ compute geopotential height and rt/p --------------------- +! ----- (use smoothed value for pssl if leapfrog) ---- + + tq = Var % t + tdt_adj * Var_dt % t + call compute_virt_temp ( Dynam%sphum, tq, Var%r, Var_dt%r, tdt_adj ) + + call compute_grad_pres ( Dynam%Hgrid, Dynam%Vgrid%nplev, & + phalf, dpde, wta, wtb, cew, cns ) + + + select case (Dynam%pgf_method) + case (SIMMONS_BURRIDGE) + call press_grad ( Dynam%Hgrid, Dynam%Vgrid, Dynam%Masks, & + Dynam%fisl, tq, dpde, wta, wtb, cew, cns, & + pgfew, pgfns ) + case (FINITE_VOLUME) + call press_grad_fv ( Dynam%Hgrid, Dynam%Vgrid, Dynam%Masks, & + Dynam%fisl, tq, phalf, wta, wtb, & + pgfew, pgfns ) + end select + +!------------------- adjustment of wind components --------------------- + + call horiz_adjust_vel ( Dynam%Hgrid, Dynam%Masks, & + tdt_adj, pgfew, pgfns, & + u, v, Var_dt%u, Var_dt%v, alpha_implicit ) + + ! polar filtering of momentum (new scheme) + if (Dynam%fopt == 2) & + call prog_var_filter_vel ( Dynam%Pfilt, tdt_adj, Dynam%Masks%Vel%mask, & + Var%u, Var%v, Var_dt%u, Var_dt%v ) + +!----------------------------------------------------------------------- +!----------------------- advection ------------------------------------- + + if (n == Dynam%nt_adj) then + call mpp_clock_end (id_adjust) + call mpp_clock_begin (id_advect) + + ! accumulate mass fluxes for diagnostic output + mfew = mfew + few + mfns = mfns + fns + + call advection ( Dynam%Pfilt, & + Dynam%Hgrid, Dynam%Vgrid, Dynam%Masks, & + Dynam%fopt, tdt_adj, dpde_old, dpde, & + few, fns, etadot, & + uo, vo, to, Var, Var_dt ) + + call mpp_clock_end (id_advect) + call mpp_clock_begin (id_adjust) + endif + +!----------------------------------------------------------------------- + + ! polar filtering of momentum (old scheme) + if (Dynam%fopt == 1) & + call prog_var_filter_vel ( Dynam%Pfilt, tdt_adj, Dynam%Masks%Vel%mask, & + Var%u, Var%v, Var_dt%u, Var_dt%v ) + + ! damping using filtered divergence + if (abs(Dynam % coeff_ddamp) > 1.e-8) then + call div_damping ( Dynam%Hgrid, Dynam%Vgrid, Dynam%Masks, & + tdt_adj, Dynam % coeff_ddamp, & + dpde, divp, Var_dt%u, Var_dt%v ) + endif + +! ---- recompute momentum at next time level ---- + + call update_halo (Dynam%Hgrid, UWND, Var_dt%u ) + call update_halo (Dynam%Hgrid, VWND, Var_dt%v ) + + u = Var % u + tdt_adj * Var_dt % u + v = Var % v + tdt_adj * Var_dt % v + +!----------------------------------------------------------------------- + + enddo + call mpp_clock_end (id_adjust) + call mpp_clock_begin (id_advect) + +!----------------------------------------------------------------------- +!----------------- horizontal diffusion -------------------------------- + + call horiz_diff ( Dynam%Hgrid, Dynam%Masks, Dynam%Vgrid%nplev, & + tdt_adj, dpde, pfull, Var, Var_dt ) + +!----------------------------------------------------------------------- +!----------------- sponge at top of model ------------------- + + call sponge_driver ( Dynam%Hgrid, Dynam%Vgrid%nplev, & + tdt_adj, dpde, Var, Var_dt ) + +! ---------------- halo updates -------------------- +! skip on the last pass will update last when needed + + if (m == Dynam % nt_adv) cycle + call update_halo (Dynam%Hgrid, TEMP, Var_dt%t ) + call update_halo (Dynam%Hgrid, TEMP, Var_dt%r ) + call update_halo (Dynam%Hgrid, UWND, Var_dt%u ) + call update_halo (Dynam%Hgrid, VWND, Var_dt%v ) + +!----------------------------------------------------------------------- + + enddo + call mpp_clock_end (id_advect) + +!----------------------------------------------------------------------- +! ---- scale tendencies before physics for time step difference ---- + + scale = 1.0 / float(Dynam%nt_adj*Dynam%nt_adv) + call prog_var_times_scalar (Var_dt, scale) + + !-- return time averaged diagnostic quantities -- + if (Dynam%avg_omega) omega = omega * scale + div = div * scale + mfew = mfew * scale + mfns = mfns * scale + +!----------------------------------------------------------------------- + + end subroutine update_bgrid_core + +!####################################################################### + + subroutine bgrid_core_end (Dynam) + +!----------------------------------------------------------------------- + type(bgrid_dynam_type), intent(inout) :: Dynam +!----------------------------------------------------------------------- +! Dynam = data type for dynamical core constants and data + + call advection_end + +!----------------------------------------------------------------------- + + end subroutine bgrid_core_end + +!####################################################################### + + subroutine compute_virt_temp ( sphum, tq, r, rdt, dt ) + + integer, intent(in) :: sphum + real, intent(inout) :: tq(:,:,:) + real, intent(in) :: r (:,:,:,:), rdt(:,:,:,:), dt + + real, dimension(size(r,1),size(r,2),size(r,3)) :: q + +! compute virtual temperature +! using temperature and specific humidity (in the tracer array) + + if ( size(r,4) == 0 ) return + if ( sphum <= 0 ) return + + q = r(:,:,:,sphum) + dt * rdt(:,:,:,sphum) + tq = tq * ( 1. + d608 * q ) + + end subroutine compute_virt_temp + +!####################################################################### +!-------- polar filter routine for momentum components --------- + + subroutine prog_var_filter_vel ( Pfilt, dt, mask, u, v, udt, vdt ) + + type(pfilt_control_type), intent(in) :: Pfilt + real, intent(in) :: dt + real, dimension(:,:,:), intent(in) :: mask + real, dimension(:,:,:), intent(in) :: u, v + real, dimension(:,:,:), intent(inout) :: udt, vdt + + real, dimension(size(u,1),size(u,2),size(u,3)) :: ut, vt + +! ---- momentum ---- + ut = u + dt*udt + vt = v + dt*vdt + call polar_filter_wind ( Pfilt, ut, vt, mask ) + udt = (ut-u)/dt + vdt = (vt-v)/dt + + end subroutine prog_var_filter_vel + +!####################################################################### +!####################################################################### + +end module bgrid_core_mod + diff --git a/MOM_code/src/atmos_bgrid/model/bgrid_core_driver.F90 b/MOM_code/src/atmos_bgrid/model/bgrid_core_driver.F90 new file mode 100644 index 0000000..81a16dd --- /dev/null +++ b/MOM_code/src/atmos_bgrid/model/bgrid_core_driver.F90 @@ -0,0 +1,475 @@ + +module bgrid_core_driver_mod + +!----------------------------------------------------------------------- +! +! Driver module for running the FMS B-grid dynamical core. +! +! * reads namelist +! * sets up the B-grid core +! * packages the B-grid core with diagnostic routines +! +!----------------------------------------------------------------------- + +use mpp_mod, only: input_nml_file +use bgrid_core_mod , only: bgrid_dynam_type, & + bgrid_core_init, update_bgrid_core, & + bgrid_core_end +use bgrid_horiz_mod , only: horiz_grid_type, horiz_grid_init +use bgrid_vert_mod , only: vert_grid_type, vert_grid_init +use bgrid_prog_var_mod , only: prog_var_type, prog_var_init, & + prog_var_time_diff, var_init, & + open_prog_var_file, & + read_prog_var, write_prog_var +use bgrid_diagnostics_mod , only: bgrid_diagnostics, & + bgrid_diagnostics_tend, & + bgrid_diagnostics_init +use bgrid_integrals_mod , only: bgrid_integrals, bgrid_integrals_init, & + bgrid_integrals_end +use bgrid_conserve_energy_mod, only: bgrid_conserve_energy_init, & + bgrid_conserve_energy, & + bgrid_conserve_energy_end + +use field_manager_mod, only: MODEL_ATMOS +use tracer_manager_mod, only: get_number_tracers +use time_manager_mod, only: time_type, get_time +use fms_mod, only: error_mesg, FATAL, file_exist, open_namelist_file, & + check_nml_error, write_version_number, & + mpp_pe, mpp_root_pe, close_file, stdlog + +use mpp_domains_mod, only: domain2d +!----------------------------------------------------------------------- + +implicit none +private + +public bgrid_dynam_type, bgrid_core_driver_init, & + bgrid_core_driver, bgrid_core_driver_end, & + bgrid_core_time_diff, get_bottom_data, put_bottom_data, & + atmosphere_domain + +!----------------------------------------------------------------------- +character(len=128) :: version = '$Id: bgrid_core_driver.F90,v 19.0 2012/01/06 19:53:59 fms Exp $' +character(len=128) :: tag = '$Name: tikal $' +!----------------------------------------------------------------------- +! +! NAMELIST INPUT: bgrid_core_driver_nml +! +! This namelist is read from file input.nml. +! See the on-line documentation for more details. +! +!----------------------------------------------------------------------- +! +! num_adjust_dt The number of adjustment time steps for each advection +! time step, where num_adjust_dt >= 1. +! +! num_advec_dt The number of advection time steps for each +! atmospheric/physics time step, where num_advec_dt >= 1. + + integer :: num_adjust_dt = 3 + integer :: num_advec_dt = 3 + +! layout The domain decomposition, where layout(1) = x-axis +! decomposition, layout(2) = y-axis decomposition. +! * If layout(1)*layout(2) does not equal the number +! of processors the model will fail. +! * If layout(1)=layout(2)=0 then the decomposition is +! determined by MPP_DEFINE_LAYOUT. + + integer, dimension(2) :: layout = (/0,0/) + +! filter_option Determines how polar filtering is performed. +! Possible values are : +! filter_option = 0, no polar filtering (decrease time step) +! filter_option = 1, obsolete scheme (NO NOT USE) +! filter_option = 2, default scheme (refer to technical doc) +! +! filter_weight Weight applied to the polar filter that will +! increase (or decrease) the strength of the standard +! polar filter response function. +! +! ref_lat_filter The reference latitude at which polar filtering +! (in each hemisphere) will begin to be applied. + + integer :: filter_option = 2 + integer :: filter_weight = 1 + real :: ref_lat_filter = 60. + +! do_conserve_energy If TRUE the temperature tendency will be updated to +! guarantee that the dynamical core conserves total energy. +! The correction is applied as a global uniform value. + + logical :: do_conserve_energy = .false. + +! pgf_scheme The scheme used to compute the pressure gradient. +! Specify one of the following: 'default', 'finite_volume'. +! The default scheme is that of Simmons and Burridge. + + character(len=24) :: pgf_scheme = 'default' ! default, finite_volume + +! restart_output_format Format used for the output restart file. +! The only possible values are: 'native' or 'netcdf'. + + character(len=24) :: restart_output_format = 'netcdf' ! native, netcdf + +! do_average_omega If TRUE the omega diagostic returned by the dynamical core +! is averaged over all adjustment time steps. If FALSE then +! omega for the last adjustment step is returned. + + logical :: do_average_omega = .false. + +! ddamp_coeff Damping coefficient for divergence damping. + + real :: ddamp_coeff = 0.0 + +! verbose Flag that control additional printed output. +! Currently, this option is not being used. + + integer :: verbose = 0 + + + namelist /bgrid_core_driver_nml/ num_adjust_dt, num_advec_dt, & + layout, filter_option, & + filter_weight, ref_lat_filter, & + do_conserve_energy, & + pgf_scheme, & + restart_output_format, & + do_average_omega, & + ddamp_coeff, verbose + +!----------------------------------------------------------------------- +!------ private data ------ + +real, dimension(:,:), pointer :: fis, res ! topography data +real, dimension(:,:,:), pointer :: div, mfew, mfns ! diagnostic fields +real, dimension(:), allocatable :: eta, peta ! vertical grid + + +! derived type data containing horizonal and vertical grid constants +! other pointer data may "point at" these data at any time +type (horiz_grid_type), target, save :: Hgrid +type (vert_grid_type), target, save :: Vgrid + +! axis indices returned by diagnostics manager +integer, dimension(4) :: mass_axes, vel_axes + +real :: dt_atmos ! atmospheric time step + +!----------------------------------------------------------------------- + +contains + +!####################################################################### + + subroutine bgrid_core_driver_init ( Time_init, Time, Time_step, & + Var, Var_dt, Dynam, phys_axes ) + +!----------------------------------------------------------------------- +! Time_init = initial time +! Time = current time +! Time_step = atmospheric model time step +! Var = prognostic variables +! Var_dt = prognostic variable tendencies +! Dynam = data type for dynamical core constants and data +! phys_axes = axis indices for the grid used by the atmospheric physics +!----------------------------------------------------------------------- + + type (time_type), intent(in) :: Time_init, Time, Time_step + type (prog_var_type), intent(inout) :: Var, Var_dt + type(bgrid_dynam_type), intent(inout) :: Dynam + integer, intent(out) :: phys_axes(4) + + integer :: unit, io, ierr, logunit + integer :: ix, jx, kx + integer :: sec, ntrace, ntprog, ntdiag +!----------------------------------------------------------------------- +! ----- read namelist ----- + + if (file_exist('input.nml')) then +#ifdef INTERNAL_FILE_NML + read (input_nml_file, nml=bgrid_core_driver_nml, iostat=io) + ierr = check_nml_error(io,'bgrid_core_driver_nml') +#else + unit = open_namelist_file ( ) + ierr=1; do while (ierr /= 0) + read (unit, nml=bgrid_core_driver_nml, iostat=io, end=10) + ierr = check_nml_error (io, 'bgrid_core_driver_nml') + enddo + 10 call close_file (unit) +#endif + endif + logunit = stdlog() + +!----------------------------------------------------------------------- +! ----- read restart header records and set up grid resolution ----- + + call open_prog_var_file (ix, jx, kx) + +! ---- horizontal grid initialization ---- + + call horiz_grid_init ( Hgrid, ix, jx, layout=layout ) + +! how many tracers have been registered? + call get_number_tracers ( MODEL_ATMOS, num_tracers=ntrace, num_prog=ntprog, num_diag=ntdiag ) + +! ----- write version, namelist and tracer info to log file ----- + + call write_version_number (version, tag) + if (mpp_pe() == mpp_root_pe()) then + write (logunit, nml=bgrid_core_driver_nml) + write (logunit, '(a,i3)') 'Number of tracers =', ntrace + write (logunit, '(a,i3)') 'Number of prognostic tracers =', ntprog + write (logunit, '(a,i3)') 'Number of diagnostic tracers =', ntdiag + endif + +! ---- prognostic variable initialization ----- + + call prog_var_init (Hgrid, kx, ntrace, Var) ! prognostic+diagnostic tracers + call prog_var_init (Hgrid, kx, ntprog, Var_dt) + +!----- read data ----- + + fis => var_init (Hgrid) + res => var_init (Hgrid) + + allocate (eta(kx+1), peta(kx+1)) + + call read_prog_var ( Hgrid, Var, eta, peta, fis, res ) + + +!---- vertical grid initialization ---- + + call vert_grid_init ( Vgrid, eta, peta ) + + deallocate (eta, peta) + +!---- diagnostic fields ---- + + div => var_init (Hgrid,kx) + mfew => var_init (Hgrid,kx) + mfns => var_init (Hgrid,kx) + +!---- compute time step in seconds ---- + + call get_time (Time_step, sec) + dt_atmos = real(sec) + +!----------------------------------------------------------------------- +! ----- initialize dynamical core ----- + + call bgrid_core_init ( Dynam, Hgrid, Vgrid, fis, res, dt_atmos, & + num_adjust_dt, num_advec_dt, pgf_scheme, & + filter_option, filter_weight, ref_lat_filter,& + ddamp_coeff, do_average_omega, verbose ) + +!----------------------------------------------------------------------- +!---- initialize history (netcdf) file and integrals ------- + + call bgrid_diagnostics_init ( Time, Hgrid, Vgrid, Var, & + fis, res, mass_axes, vel_axes ) + phys_axes = mass_axes + + call bgrid_integrals_init (Time_init, Time) + +!---- initialize integrals ---- + + call bgrid_integrals (Time, Hgrid, Vgrid, Var, Dynam%Masks) + +!---- initialize energy conservation module ---- + + if (do_conserve_energy) call bgrid_conserve_energy_init (Time, mass_axes) + +!----------------------------------------------------------------------- + + end subroutine bgrid_core_driver_init + +!####################################################################### + + subroutine bgrid_core_driver (Time_diag, Var, Var_dt, Dynam, omega) + +!----------------------------------------------------------------------- +! Time_diag = time used for diagnostic output +! (typically time at end of time step) +! Var = prognostic variables +! Var_dt = prognostic variable tendencies +! Dynam = data type for dynamical core constants and data +! omega = omega (vertical velocity) diagnostic (Pa/s) +!----------------------------------------------------------------------- + type (time_type), intent(in) :: Time_diag + type (prog_var_type), intent(in) :: Var + type (prog_var_type), intent(inout) :: Var_dt + type(bgrid_dynam_type), intent(inout) :: Dynam + real, intent(out) :: omega(:,:,:) +!----------------------------------------------------------------------- +! dynamics + + call update_bgrid_core (Var, Var_dt, Dynam, omega, div, mfew, mfns ) + +! energy conservation + + if (do_conserve_energy) then + call bgrid_conserve_energy ( dt_atmos, Time_diag, Hgrid, Vgrid, & + Dynam%Masks, Var, Var_dt ) + endif + +! diagnostics for dynamics tendencies + + call bgrid_diagnostics_tend ( Hgrid, Var_dt, Dynam%Masks, Time_diag ) + +!----------------------------------------------------------------------- + + end subroutine bgrid_core_driver + +!####################################################################### + + subroutine bgrid_core_time_diff ( omega, Time_diag, Dynam, Var, Var_dt ) + +!----------------------------------------------------------------------- +! omega = omega (vertical velocity) diagnostic (Pa/s) +! Time_diag = time used for diagnostic output +! (typically time at end of time step) +! Dynam = data type for dynamical core constants and data +! Var = prognostic variables +! Var_dt = prognostic variable tendencies +!----------------------------------------------------------------------- + real, intent(in) :: omega(:,:,:) + type (time_type), intent(in) :: Time_diag + type(bgrid_dynam_type), intent(in) :: Dynam + type (prog_var_type), intent(inout) :: Var + type (prog_var_type), intent(inout) :: Var_dt +!----------------------------------------------------------------------- + +! time differencing + + call prog_var_time_diff ( dt_atmos, Dynam%Masks, Var_dt, Var ) + +! global integrals and diagnostics + + call bgrid_integrals ( Time_diag, Hgrid, Vgrid, Var, Dynam%Masks ) + + call bgrid_diagnostics ( Hgrid, Vgrid, Var, Dynam%Masks, & + Time_diag, omega, div, mfew, mfns ) + +!----------------------------------------------------------------------- + + end subroutine bgrid_core_time_diff + +!####################################################################### + + subroutine bgrid_core_driver_end ( Var, Dynam ) + +!----------------------------------------------------------------------- +! Var = prognostic variables +! Dynam = data type for dynamical core constants and data +!----------------------------------------------------------------------- + type (prog_var_type), intent(in) :: Var + type(bgrid_dynam_type), intent(inout) :: Dynam +!----------------------------------------------------------------------- +! terminate dynamics + + call bgrid_core_end ( Dynam ) + +! write restart for prognostic variables + + call write_prog_var ( Var, Hgrid, Vgrid, fis, res, & + format=restart_output_format ) + +! terminate integrals + call bgrid_integrals_end + +! only prints diagnostics + call bgrid_conserve_energy_end + +!----------------------------------------------------------------------- + + end subroutine bgrid_core_driver_end + +!####################################################################### +! The following routines do not really belong in this module but since +! they are not used within the core itself they will reside here. +!####################################################################### + + subroutine get_bottom_data ( a, b, a_bot, b_bot, k_bot ) + +!-------- Extract data from the lowest model level --------- +! a, b = 3-D data fields +! a_bot, +! b_bot = 2-D data fields containing data at lowest level +! k_bot = index of lowest model level (optional) +!----------------------------------------------------------- + + real , intent(in) , dimension(:,:,:) :: a , b + real , intent(out), dimension(:,:) :: a_bot, b_bot + integer, intent(in) , dimension(:,:), optional :: k_bot + +! returns the lowest level data (a_bot,b_bot) from 3d fields (a,b) + + integer :: i, j, kb, kb_min + + kb_min = size(a,3) + if (present(k_bot)) kb_min = minval (k_bot) + + if ( kb_min == size(a,3) ) then + a_bot = a(:,:,kb_min) + b_bot = b(:,:,kb_min) + else + do j = 1, size(a,2) + do i = 1, size(a,1) + kb = k_bot(i,j) + a_bot(i,j) = a(i,j,kb) + b_bot(i,j) = b(i,j,kb) + enddo + enddo + endif + + end subroutine get_bottom_data + +!####################################################################### + + subroutine put_bottom_data ( a_bot, b_bot, a, b, k_bot ) + +!-------- Insert data into the lowest model level --------- +! a_bot, +! b_bot = 2-D data fields containing data for the lowest level +! a, b = 3-D data fields with data inserted into lowest level +! k_bot = index of lowest model level (optional) +!----------------------------------------------------------- + + real , intent(in) , dimension(:,:) :: a_bot, b_bot + real , intent(inout), dimension(:,:,:) :: a , b + integer, intent(in) , dimension(:,:), optional :: k_bot + +! inserts the lowest level data (a_bot,b_bot) into 3d fields (a,b) + + integer :: i, j, kb, kb_min + + kb_min = size(a,3) + if (present(k_bot)) kb_min = minval (k_bot) + + if ( kb_min == size(a,3) ) then + a(:,:,kb_min) = a_bot + b(:,:,kb_min) = b_bot + else + do j = 1, size(a,2) + do i = 1, size(a,1) + kb = k_bot(i,j) + a(i,j,kb) = a_bot(i,j) + b(i,j,kb) = b_bot(i,j) + enddo + enddo + endif + + end subroutine put_bottom_data + +!####################################################################### + + subroutine atmosphere_domain(Domain) + type(domain2d), intent(inout) :: Domain + + Domain = Hgrid%Tmp%Domain + + end subroutine atmosphere_domain +!####################################################################### + +end module bgrid_core_driver_mod + diff --git a/MOM_code/src/atmos_bgrid/model/bgrid_horiz_adjust.F90 b/MOM_code/src/atmos_bgrid/model/bgrid_horiz_adjust.F90 new file mode 100644 index 0000000..0217d98 --- /dev/null +++ b/MOM_code/src/atmos_bgrid/model/bgrid_horiz_adjust.F90 @@ -0,0 +1,684 @@ + +module bgrid_horiz_adjust_mod + +!----------------------------------------------------------------------- +! This modules has interfaces for computing various +! horizontal adjustment processes. +! +! 1) momentum adjustment using coriolis and pressure gradient +! 2) mass fluxes (used for divergence and advection) +! 3) mass divergence +! 4) thermodynamic term (horizontal part of omega-alpha term) +! 4) pressure gradient (several options) +! 5) grad(p)/p term (used for energy conservation) +! 6) divergence damping +! +!----------------------------------------------------------------------- + +use bgrid_horiz_mod , only: horiz_grid_type +use bgrid_vert_mod , only: vert_grid_type, compute_pres_depth, & + compute_geop_height, compute_pres_half +use bgrid_masks_mod , only: grid_mask_type +use bgrid_halo_mod , only: update_halo, TEMP +use bgrid_change_grid_mod, only: change_grid, TEMP_GRID, WIND_GRID, & + UFLX_GRID, VFLX_GRID + +use constants_mod, only: OMEGA, RADIUS, RDGAS +use fms_mod, only: error_mesg, FATAL + +implicit none +private + +public :: horiz_adjust_vel, horiz_adjust_mass, press_grad, & + div_damping, compute_grad_pres, press_grad_fv + +!----------------------------------------------------------------------- + + real, parameter :: RADIUS_INV = 1.0/RADIUS + +!----------------------------------------------------------------------- + +contains + +!####################################################################### + +subroutine horiz_adjust_vel ( Hgrid, Masks, dt, & + pgfew, pgfns, um, vm, udt, vdt, & + alpha_implicit ) + +!----------------------------------------------------------------------- +! update momentum tendencies using coriolis and pressure gradient +! +! IN: Hgrid = horizontal grid constants +! Masks = grid masking constants +! dt = time step +! pgfew, +! pgfns = pressure gradient force components (m/s2) +! um,vm = zonal and meridional wind components +! +! INOUT: udt,vdt = tendency of zonal and meridional wind components +! +! IN (opt): alpha_implicit = coefficient for coriolis/pgf time diff +! 0.0 = explicit (not recommended) +! 0.5 = trapezoidal implicit (default) +! 1.0 = fully implicit +! +!----------------------------------------------------------------------- +type(horiz_grid_type), intent(in) :: Hgrid +type (grid_mask_type), intent(in) :: Masks + real, intent(in) :: dt + real, intent(in), dimension(Hgrid%ilb:, Hgrid%jlb:, :) :: & + pgfew, pgfns, um, vm + real, intent(inout), dimension(Hgrid%ilb:, Hgrid%jlb:, :) :: & + udt, vdt +real, optional, intent(in) :: alpha_implicit +!----------------------------------------------------------------------- + + real, dimension (Hgrid%ilb:Hgrid%iub, Hgrid%jlb:Hgrid%jub) :: & + pgfu, pgfv, f0, fa, fb, cu, cv, up, vp, un, vn + + integer :: i, j, k + real :: alpha +!----------------------------------------------------------------------- + + alpha = 0.5; if (present(alpha_implicit)) alpha = alpha_implicit + alpha = min(max(0.0,alpha),1.0) + +!----------------------------------------------------------------------- +!-----------------update u and v (coriolis & pgf)----------------------- + + do k = 1, size(um,3) + do j = Hgrid%Vel%js, Hgrid%Vel%je + do i = Hgrid%Vel%is, Hgrid%Vel%ie + +! --------- pressure gradient force components--------------- + + pgfu(i,j) = dt*pgfew(i,j,k) + pgfv(i,j) = dt*pgfns(i,j,k) + +! ------------coriolis & curvature terms---------------------- + + f0(i,j) = (um(i,j,k)*RADIUS_INV*Hgrid%tanphv(i,j)+ & + 2.*OMEGA*Hgrid%sinphv(i,j))*dt + fa(i,j) = f0(i,j)*(1.0-alpha) + fb(i,j) = f0(i,j)*alpha + + cu(i,j) = vm(i,j,k)*fa(i,j) + cv(i,j) = -um(i,j,k)*fa(i,j) + +! ------------compute new u and v (coriolis & pgf)------------ + + up(i,j) = pgfu(i,j) + cu(i,j) + um(i,j,k) + vp(i,j) = pgfv(i,j) + cv(i,j) + vm(i,j,k) + + un(i,j) = ((fb(i,j)*vp(i,j)+up(i,j))/ & + (fb(i,j)*fb(i,j)+1.0))*Masks%Vel%mask(i,j,k) + vn(i,j) = (vp(i,j)-fb(i,j)*un(i,j))*Masks%Vel%mask(i,j,k) + +! ---- return unfiltered tendencies with halos not updated ---- + + udt(i,j,k) = udt(i,j,k) + (un(i,j)-um(i,j,k))/dt + vdt(i,j,k) = vdt(i,j,k) + (vn(i,j)-vm(i,j,k))/dt + enddo + enddo + enddo + +!----------------------------------------------------------------------- + +end subroutine horiz_adjust_vel + +!####################################################################### + + subroutine horiz_adjust_mass ( nplev, Hgrid, Masks, & + u, v, dpde, cew, cns, & + flew, flns, div, omgalf ) + +!----------------------------------------------------------------------- +! Computes: mass fluxes, divergence, thermodynamic term (horiz part) +! +! IN: nplev = vertical index of uppermost pure pressure level +! (use nplev=0 for sigma models) +! Hgrid = horizontal grid constants +! Masks = grid masking constants +! u, v = prognostic variables for zonal and meridional wind +! dpde = pressure thickness of model layers +! cew, +! cns = zonal and meridional components of grad(p)/p (no units) +! +! INOUT: flew, +! flns = zonal, meridional mass fluxes (summation) (Pa-m2/s) +! +! OUT: div = mass divergence (Pa/s) +! omgalf = horizontal part of omega-alpha term (Pa/s) +! +!----------------------------------------------------------------------- +integer, intent(in) :: nplev +type(horiz_grid_type), intent(inout) :: Hgrid +type (grid_mask_type), intent(in) :: Masks + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: u, v, & + dpde, cew, cns + real, intent(inout), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: flew, flns + real, intent(out), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: div, omgalf +!----------------------------------------------------------------------- + + real, dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub) :: & + few, fns, udy, vdx, tew, tns, adpdxy + + integer :: i, j, k, is, ie, js, je + + + is = Hgrid%Tmp%is; ie = Hgrid%Tmp%ie + js = Hgrid%Tmp%js; je = Hgrid%Tmp%je + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- + + few = 0.0; fns = 0.0 + + do k = 1, size(u,3) + + !---- average mass weights for mass fluxes ---- + call change_grid ( Hgrid, TEMP_GRID, WIND_GRID, dpde(:,:,k), adpdxy ) + +!---- compute mass fluxes, divergence & horizontal omega-alpha term ---- +!-------add in compute flux corrections for grid separation ------------ +!---- sum input/output mass fluxes ------- + + do j = js-1, je+1 + udy(:,j)=Hgrid%Vel%dy *u(:,j,k)*adpdxy(:,j) *Masks%Vel%mask(:,j,k) + vdx(:,j)=Hgrid%Vel%dx(j)*v(:,j,k)*adpdxy(:,j) *Masks%Vel%mask(:,j,k) + enddo + + do j = js, je + do i = is-1, ie + few(i,j) = (udy(i,j)+udy(i,j-1))*0.5 + tew(i,j) = few(i,j)*cew(i,j,k) + enddo + enddo + do j = js-1, je + do i = is, ie + fns(i,j) = (vdx(i,j)+vdx(i-1,j))*0.5 + tns(i,j) = fns(i,j)*cns(i,j,k) + enddo + enddo + +!----------------------------------------------------------------------- +! ------ sum fluxes (output needed for advection) ------ +! ------ (halos will be updated in advection) ------ + + flew(:,:,k) = flew(:,:,k) + few + flns(:,:,k) = flns(:,:,k) + fns + +!---------------------------divergence---------------------------------- + + do j = js, je + do i = is, ie + div(i,j,k) = ((few(i ,j)+fns(i,j ))- & + (few(i-1,j)+fns(i,j-1))) & + *Hgrid%Tmp%rarea(j)*Masks%Tmp%mask(i,j,k) + enddo + enddo + +!-------------- horizontal part of omega-alpha ------------------------- +! ------ do not do for pure pressure levels ----- + + if (k > nplev) then + do j = js, je + do i = is, ie + omgalf(i,j,k)=(tew(i,j)+tew(i-1,j)+tns(i,j)+tns(i,j-1)) & + *0.50*Hgrid%Tmp%rarea(j)*Masks%Tmp%mask(i,j,k) + enddo + enddo + else + omgalf(:,:,k) = 0.0 + endif + +!----------------------------------------------------------------------- +!---- end level loop ----- + + enddo + +!----------------------------------------------------------------------- + + end subroutine horiz_adjust_mass + +!####################################################################### +! Simmons and Burridge (1981) pressure gradient + +subroutine press_grad ( Hgrid, Vgrid, Masks, fssl, tq, & + dpde, wta, wtb, cew, cns, pgfew, pgfns ) + +!----------------------------------------------------------------------- +! IN: Hgrid = horizontal constants +! Vgrid = vertical constants +! Masks = grid masking constants +! fssl = geopotential height (m2/s2) at eta=1. +! tq = virtual temperature +! dpde = pressure thickness of model layers +! wta, +! wtb = weights for computing geopotential height +! (same as weight for computing full pressures) +! cew, +! cns = zonal and meridional components of grad(p)/p +! +! OUT: pgfew, +! pgfns = pressure gradient force components (m/s2) +! +!----------------------------------------------------------------------- +type(horiz_grid_type), intent (inout) :: Hgrid +type (vert_grid_type), intent (in) :: Vgrid +type (grid_mask_type), intent (in) :: Masks + real, intent (in) , dimension(Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub) :: fssl + real, intent (in), dimension(Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub,Vgrid%nlev) :: & + tq, dpde, wta, wtb, cew, cns + real, intent (out), dimension(Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub,Vgrid%nlev) :: & + pgfew, pgfns + +!----------------------------------------------------------------------- + real, dimension (Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub) :: & + pew, pns, tew, tns + + real, dimension (Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub, & + size(tq,3)) :: fim, ppcew, ppcns + + integer :: i, j, k, is, ie, js, je +!----------------------------------------------------------------------- +!------------- integration of geopotential height----------------------- +! fim = geopotential height at model levels + + if (Vgrid%nlev /= size(tq,3)) call error_mesg ('geop_height', & + 'wrong number of vertical levels', FATAL) + + if (Vgrid%nlev > 1) then + + call compute_geop_height (Vgrid, fssl, tq, wta, wtb, fim, & + mask=Masks%Tmp%mask) + + else + + fim(:,:,:) = dpde(:,:,:) ! special case for shallow water model + + endif + +!----------- lat/lon contributions to pressure gradient ---------------- +! -------- two loops: pressure only, pressure/sigma ------- +! ppcew,ppcns = zonal and meridional auxillary pressure gradient +! force components (i.e., not on velocity grid) + + is = Hgrid%Vel%is; ie = Hgrid%Vel%ie + js = Hgrid%Vel%js; je = Hgrid%Vel%je + + ! compute at pure pressure levels + do k = 1, Vgrid%nplev + do j = js, je+1 + do i = is, ie + ppcew(i,j,k) = fim(i+1,j,k)-fim(i,j,k) + enddo + enddo + do j = js, je + do i = is, ie+1 + ppcns(i,j,k) = fim(i,j+1,k)-fim(i,j,k) + enddo + enddo + enddo + + ! compute at sigma/pressure levels + do k = Vgrid%nplev+1, Vgrid%nlev + do j = js, je+1 + do i = is, ie + pew(i,j) = fim(i+1,j,k)-fim(i,j,k) + tew(i,j) = RDGAS*0.50*(tq(i+1,j,k)+tq(i,j,k)) + ppcew(i,j,k) = pew(i,j)+tew(i,j)*cew(i,j,k) + enddo + enddo + do j = js, je + do i = is, ie+1 + pns(i,j) = fim(i,j+1,k)-fim(i,j,k) + tns(i,j) = RDGAS*0.50*(tq(i,j+1,k)+tq(i,j,k)) + ppcns(i,j,k) = pns(i,j)+tns(i,j)*cns(i,j,k) + enddo + enddo + enddo + +!--------------compute pressure gradient force components--------------- + + do k = 1, Vgrid%nlev + do j = js, je + do i = is, ie + pgfew(i,j,k)=-0.50*(ppcew(i,j,k)+ppcew(i,j+1,k))*Hgrid%Vel%rdx(j) + pgfns(i,j,k)=-0.50*(ppcns(i,j,k)+ppcns(i+1,j,k))*Hgrid%Vel%rdy + enddo + enddo + enddo + +!----------------------------------------------------------------------- + + end subroutine press_grad + +!####################################################################### +! code for Lin (1997) finite volume pressure gradient + + subroutine press_grad_fv ( Hgrid, Vgrid, Masks, fssl, tq, phalf, & + wta, wtb, pgfew, pgfns ) + +!----------------------------------------------------------------------- +! IN: Hgrid = horizontal constants +! Vgrid = horizontal constants +! Masks = grid masking constants +! fssl = geopotential height (m2/s2) at eta=1. +! tq = virtual temperature +! phalf = pressure at model layer interfaces +! wta, +! wtb = weights for computing geopotential height +! (same as weight for computing full pressures) +! OUT: pgfew, +! pgfns = pressure gradient force components (m/s2) +!----------------------------------------------------------------------- +type(horiz_grid_type), intent (inout) :: Hgrid +type (vert_grid_type), intent (in) :: Vgrid +type (grid_mask_type), intent (in) :: Masks + real, intent (in) , dimension(Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub) :: fssl + real, intent (in), dimension(Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub,Vgrid%nlev+1) :: & + phalf + real, intent (in), dimension(Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub,Vgrid%nlev) :: & + tq, wta, wtb + real, intent (out), dimension(Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub,Vgrid%nlev) :: & + pgfew, pgfns + +!----------------------------------------------------------------------- + real, dimension (Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub) :: & + few, pew, fns, pns + real, dimension (Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub, & + size(tq,3)+1) :: fi, pi + real :: dp1, dp2 + integer :: i, j, k, is, ie, js, je + +!------------- integration of geopotential height----------------------- +! fi = geopotential height at half levels +! pi = ln pressure at half levels + + if (Vgrid%nlev /= size(tq,3)) call error_mesg ('geop_height', & + 'wrong number of vertical levels', FATAL) + + ! initialize + is = Hgrid%Vel%is; ie = Hgrid%Vel%ie + js = Hgrid%Vel%js; je = Hgrid%Vel%je + + ! define ln pressure + pi(:,:,2:Vgrid%nlev+1) = log(phalf(:,:,2:Vgrid%nlev+1)) + if (Vgrid%pzero) then + ! extrapolate when pressure at top = 0 + ! following simmons & burridge scheme + pi(:,:,1) = 2.*pi(:,:,2)*phalf(:,:,2)/(phalf(:,:,2)-phalf(:,:,1)) - & + pi(:,:,2) - 2. + else + pi(:,:,1) = log(phalf(:,:,1)) + endif + + ! compute geop height at model layer interfaces + ! integrate up from surface + fi(:,:,Vgrid%nlev+1) = fssl + if (Masks%sigma) then + do k = Vgrid%nlev, 1, -1 + fi(:,:,k) = fi(:,:,k+1) + RDGAS*tq(:,:,k)*(pi(:,:,k+1)-pi(:,:,k)) + enddo + else + do k = Vgrid%nlev, 1, -1 + where (Masks%Tmp%mask(:,:,k) < 0.5) + fi(:,:,k) = Vgrid%fhalf(k) + elsewhere + fi(:,:,k) = fi(:,:,k+1) + RDGAS*tq(:,:,k)*(pi(:,:,k+1)-pi(:,:,k)) + endwhere + enddo + endif + + ! loop over levels + do k = 1, Vgrid%nlev + + ! compute pressure gradient at intermediate points + ! E/W component + do j = js, je+1 + do i = is, ie + dp1 = pi(i+1,j,k+1) - pi(i ,j,k) + dp2 = pi(i ,j,k+1) - pi(i+1,j,k) + few(i,j) = (dp1*(fi(i,j,k+1)-fi(i+1,j,k)) + dp2*(fi(i,j,k)-fi(i+1,j,k+1))) + pew(i,j) = dp1+dp2 + enddo + enddo + ! N/S component + do j = js, je + do i = is, ie+1 + dp1 = pi(i,j+1,k+1) - pi(i,j ,k) + dp2 = pi(i,j ,k+1) - pi(i,j+1,k) + fns(i,j) = (dp1*(fi(i,j,k+1)-fi(i,j+1,k)) + dp2*(fi(i,j,k)-fi(i,j+1,k+1))) + pns(i,j) = dp1+dp2 + enddo + enddo + + ! compute pressure gradient at velocity points + do j = js, je + do i = is, ie + pgfew(i,j,k) = (few(i,j)+few(i,j+1))/(pew(i,j)+pew(i,j+1))*Hgrid%Vel%rdx(j) + pgfns(i,j,k) = (fns(i,j)+fns(i+1,j))/(pns(i,j)+pns(i+1,j))*Hgrid%Vel%rdy + enddo + enddo + + enddo + + end subroutine press_grad_fv + +!####################################################################### +! compute grad P term consistent with Simmons and Burridge + + subroutine compute_grad_pres (Hgrid, nplev, phalf, dpde, & + wta, wtb, cew, cns) + +!----------------------------------------------------------------------- +! IN: Hgrid = horizontal constants +! nplev = vertical index of uppermost pure pressure level +! (use nplev=0 for sigma models) +! phalf = pressure at model layer interfaces +! dpde = pressure thickness of model layers +! wta, +! wtb = weights for computing geopotential height +! (same as weight for computing full pressures) +! OUT: cew, +! cns = zonal and meridional components of grad(p)/p (no units) +!----------------------------------------------------------------------- + + type(horiz_grid_type), intent(in) :: Hgrid + integer, intent(in) :: nplev + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: & + phalf, dpde, wta, wtb + real, intent(out), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: cew, cns + + real, dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub) :: & + pewa, pewb, pnsa, pnsb + real, dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub, & + size(dpde,3)) :: adpdx, adpdy + integer :: i, j, k + + ! special case for one level model + if (size(dpde,3) == 1) then + cew(:,:,:) = 0.0 + cns(:,:,:) = 0.0 + return + endif + + ! term vanishes on pressure levels + do k = 1, nplev + cew(:,:,k) = 0.0 + cns(:,:,k) = 0.0 + enddo + +!---- compute pressure depth at uflx and vflx points ---- + + call change_grid (Hgrid, TEMP_GRID, UFLX_GRID, dpde(:,:,:), adpdx) + call change_grid (Hgrid, TEMP_GRID, VFLX_GRID, dpde(:,:,:), adpdy) + + +! --- compute pressure differences ---- + + do j = Hgrid%Tmp%js, Hgrid%Tmp%je+1 + do i = Hgrid%Tmp%is-1, Hgrid%Tmp%ie + pewa(i,j) = phalf(i+1,j,nplev+1)-phalf(i,j,nplev+1) + enddo + enddo + + do j = Hgrid%Tmp%js-1, Hgrid%Tmp%je + do i = Hgrid%Tmp%is, Hgrid%Tmp%ie+1 + pnsa(i,j) = phalf(i,j+1,nplev+1)-phalf(i,j,nplev+1) + enddo + enddo + +! --- compute grad pressure term at model levels ---- + + do k = nplev+1, size(phalf,3)-1 + + !---- east-west contribution ---- + do j = Hgrid%Tmp%js, Hgrid%Tmp%je+1 + do i = Hgrid%Tmp%is-1, Hgrid%Tmp%ie + pewb(i,j) = phalf(i+1,j,k+1)-phalf(i,j,k+1) + cew(i,j,k) = (wta(i+1,j,k)+wta(i,j,k)) * pewa(i,j) + & + (wtb(i+1,j,k)+wtb(i,j,k)) * pewb(i,j) + cew(i,j,k) = 0.5 * cew(i,j,k) / adpdx(i,j,k) + pewa(i,j) = pewb(i,j) + enddo + enddo + !---- north-south contribution ---- + do j = Hgrid%Tmp%js-1, Hgrid%Tmp%je + do i = Hgrid%Tmp%is, Hgrid%Tmp%ie+1 + pnsb(i,j) = phalf(i,j+1,k+1)-phalf(i,j,k+1) + cns(i,j,k) = (wta(i,j+1,k)+wta(i,j,k)) * pnsa(i,j) + & + (wtb(i,j+1,k)+wtb(i,j,k)) * pnsb(i,j) + cns(i,j,k) = 0.5 * cns(i,j,k) / adpdy(i,j,k) + pnsa(i,j) = pnsb(i,j) + enddo + enddo + enddo + + end subroutine compute_grad_pres + +!####################################################################### + + subroutine div_damping (Hgrid, Vgrid, Masks, dt, coeff, dpde, div, & + u_dt, v_dt) + +!----------------------------------------------------------------------- +! +! Computes divergence damping tendency for momentum fields +! +! IN: Hgrid = horizontal constants +! Vgrid = horizontal constants +! Masks = grid masking constants +! dt = time step +! coeff = coefficient for divergence damping +! dpde = model layer pressure thickness +! div = mass divergence (Pa/s) +! +! INOUT: u_dt, +! v_dt = zonal and meridional momentum tendencies (m/s2) +! +!----------------------------------------------------------------------- + +type(horiz_grid_type), intent (inout) :: Hgrid +type (vert_grid_type), intent (in) :: Vgrid +type (grid_mask_type), intent (in) :: Masks + real, intent (in) :: dt, coeff + real, intent (in) , dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: dpde, div + real, intent (inout), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: u_dt, v_dt + +!----------------------------------------------------------------------- + + real, dimension (Hgrid%jlb:Hgrid%jub) :: scoeff + real, dimension (Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub) :: dew, dns, adpdxy + real, dimension (Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub,size(div,3)) :: adiv + + real :: dcoeff + integer :: i, j, k, is, ie, hs, he, vs, ve, ks, ke + logical :: fourth_order +!----------------------------------------------------------------------- + + is = Hgrid % Vel % is; ie = Hgrid % Vel % ie + vs = Hgrid % Vel % js; ve = Hgrid % Vel % je + hs = Hgrid % Tmp % js; he = Hgrid % Tmp % je + ks = 1 + ke = size(div,3) + fourth_order = .false. + if (coeff < 0.0) fourth_order = .true. + scoeff = abs(coeff) + ! maximum damping at the sub-pole row + ! if (vs == Hgrid%Vel%jsg) scoeff(vs) = 1.0 + ! if (ve == Hgrid%Vel%jeg) scoeff(ve) = 1.0 + + if (fourth_order) then + ! additional 5-pt smoother when fourth-order + scoeff = -0.50*(scoeff/8.)**2/dt + do k = ks, ke + do j = hs-1, he + do i = is-1, ie + dew(i,j) = div(i+1,j,k)-div(i,j,k) + dns(i,j) = div(i,j+1,k)-div(i,j,k) + enddo + enddo + + do j = hs, he + do i = is, ie + adiv(i,j,k) = (dew(i,j)+dns(i,j)-dew(i-1,j)-dns(i,j-1)) + enddo + enddo + enddo + + call update_halo ( Hgrid, TEMP, adiv ) + else + ! second order + scoeff = 0.50*(scoeff/8.)/dt + do k = ks, ke + do j = hs-1, he+1 + adiv(:,j,k) = div(:,j,k) + enddo + enddo + endif + +! second-order scheme (only the gradient) + do k = ks, ke + do j = vs, ve+1 + do i = is, ie + dew(i,j) = adiv(i+1,j,k)-adiv(i,j,k) + enddo + enddo + do j = vs, ve + do i = is, ie+1 + dns(i,j) = adiv(i,j+1,k)-adiv(i,j,k) + enddo + enddo + + call change_grid ( Hgrid, TEMP_GRID, WIND_GRID, dpde(:,:,k), adpdxy ) + + do j = vs, ve + do i = is, ie + dcoeff = scoeff(j) / adpdxy(i,j) * Masks%Vel%mask(i,j,k) + u_dt(i,j,k) = u_dt(i,j,k) + (dew(i,j)+dew(i,j+1)) * dcoeff * Hgrid%Vel%dx(j) + v_dt(i,j,k) = v_dt(i,j,k) + (dns(i,j)+dns(i+1,j)) * dcoeff * Hgrid%Vel%dx(j) + enddo + enddo + enddo + +!----------------------------------------------------------------------- + + end subroutine div_damping + +!####################################################################### + +end module bgrid_horiz_adjust_mod + diff --git a/MOM_code/src/atmos_bgrid/model/bgrid_horiz_diff.F90 b/MOM_code/src/atmos_bgrid/model/bgrid_horiz_diff.F90 new file mode 100644 index 0000000..e1e10fe --- /dev/null +++ b/MOM_code/src/atmos_bgrid/model/bgrid_horiz_diff.F90 @@ -0,0 +1,1028 @@ + +module bgrid_horiz_diff_mod + +!======================================================================= +! +! linear horizontal mixing +! with option for any order accuracy +! +!======================================================================= + +use mpp_mod, only: input_nml_file +use bgrid_horiz_mod , only: horiz_grid_type +use bgrid_masks_mod , only: grid_mask_type +use bgrid_prog_var_mod , only: prog_var_type, var_init +use bgrid_halo_mod , only: update_halo, vel_flux_boundary, & + EAST, NORTH, NOPOLE, POLEONLY, & + TEMP, UWND, VWND +use bgrid_change_grid_mod, only: change_grid, TEMP_GRID, WIND_GRID + +use fms_mod, only: error_mesg, FATAL, write_version_number, & + open_namelist_file, check_nml_error, close_file, & + mpp_clock_id, mpp_clock_begin, mpp_clock_end, & + MPP_CLOCK_SYNC, CLOCK_MODULE, file_exist, & + mpp_pe, mpp_root_pe, uppercase, stdlog +use constants_mod, only: RADIUS + +use field_manager_mod, only: MODEL_ATMOS, parse +use tracer_manager_mod, only: query_method, get_tracer_names, get_number_tracers + +implicit none +private + +!--------- public interfaces ---------- + +public horiz_diff, horiz_diff_init + +!----------------------------------------------------------------------- +! namelist bgrid_horiz_diff_nml + +! damp_scheme_wind Determines how horizontal damping coefficients +! damp_scheme_temp vary with latitude. Possible values are: 0,1,2,3. +! [0 = no damping; 1 = coeff are uniform with latitude; +! 2 = coeffs vary as 1/(dx**2+dy**2); +! 3 = coeffs vary as 1/(dx**2); +! 4 = same as scheme 1 but with scheme 2 applied +! poleward of reflat] +! Notes: Schemes 2-4 provide increased damping in +! higher latitudes. Temperature and tracers are +! controlled using "damp_scheme_temp". + + integer :: damp_scheme_temp = 1 + integer :: damp_scheme_wind = 1 + +! reflat Latitude cutoff (in degrees) at which increased +! high latitude damping is applied. Equatorward of +! this latitude uniform damping (scheme=1) is applied; +! poleward of this latitude enhanced damping (scheme=2) +! is applied. This variable is only used when +! damp_scheme_wind=4 or damp_scheme_temp=4. + + real :: reflat = 85. + +! damp_order_wind The horizontal damping order for momentum, +! damp_order_temp temperature, and default order for all +! damp_order_tracer prognostic tracers. Only even numbers are allowed. + + integer :: damp_order_wind = 4 ! use: 0, 2, 4,.... + integer :: damp_order_temp = 4 + integer :: damp_order_tracer = 4 + +! damp_coeff_wind The horizontal damping coefficients for +! damp_coeff_temp momentum, temperature, and default value for +! damp_coeff_tracer all prognostic tracers. Only positive values +! are allowed. + + real :: damp_coeff_wind = 0.35 + real :: damp_coeff_temp = 0.35 + real :: damp_coeff_tracer = 0.35 + +! slope_corr_wind The topography slope correction for horizontal +! slope_corr_temp damping of momentum, temperature, and default +! slope_corr_tracer for all prognostic tracers. + + real, dimension(4) :: slope_corr_wind = (/0.,0.,0.,0./) + real, dimension(4) :: slope_corr_temp = (/0.,0.,0.,0./) + real, dimension(4) :: slope_corr_tracer = (/0.,0.,0.,0./) + +namelist /bgrid_horiz_diff_nml/ damp_scheme_temp, damp_scheme_wind, & + damp_order_wind, damp_order_temp, damp_order_tracer, & + damp_coeff_wind, damp_coeff_temp, damp_coeff_tracer, & + slope_corr_wind, slope_corr_temp, slope_corr_tracer, & + reflat + +!----------------------------------------------------------------------- +!--------- private data ---------- + +! control parameters for horizontal damping +! set via the namelist or field table + type hdiff_control_type + integer, pointer :: order(:) =>NULL() + real , pointer :: coeff(:) =>NULL() + real , pointer :: slope(:,:) =>NULL() + logical, pointer :: do_slope_adj(:) =>NULL() + logical :: do_damping, do_slope_adj_temp + integer :: damping_scheme_wind, damping_scheme_temp + real, dimension(:), pointer :: areahx =>NULL(), & + areahy =>NULL(), & + areavx =>NULL(), & + areavy => NULL() + real, dimension(:,:), pointer :: wth => NULL(), & + wtv =>NULL() + end type hdiff_control_type + + type(hdiff_control_type), save :: Control + + integer :: nlev ! number of model levels + + character(len=128) :: version='$Id: bgrid_horiz_diff.F90,v 19.0 2012/01/06 19:54:01 fms Exp $' + character(len=128) :: tagname='$Name: tikal $' + logical :: do_log = .true. + +! timing data + integer :: id_total + logical :: do_clock_init = .true. + +!----------------------------------------------------------------------- + +contains + +!####################################################################### + + subroutine horiz_diff ( Hgrid, Masks, nplev, dt, dpde, pres, Var, Var_dt ) + +!----------------------------------------------------------------------- +! +! Hgrid = horizontal grid constants +! Masks = grid masking constants for eta coordinate +! nplev = number of "pure" pressure levels at the top of the model +! dt = adjustment time step +! dpde = pressure weight for model layers +! pres = pressure at full model levels +! Var = prognostic variables at the last updated time level +! Var_dt = tendency of prognostic variables since the last +! updated time level +! +!----------------------------------------------------------------------- + +type(horiz_grid_type), intent(inout) :: Hgrid +type (grid_mask_type), intent(in) :: Masks + +integer, intent(in) :: nplev + real, intent(in) :: dt + real, intent(in) :: dpde(Hgrid%ilb:,Hgrid%jlb:,:),& + pres(Hgrid%ilb:,Hgrid%jlb:,:) + type (prog_var_type), intent(in) :: Var + type (prog_var_type), intent(inout) :: Var_dt + +!----------------------------------------------------------------------- + + real, dimension(Hgrid%ilb:Hgrid%iub, Hgrid%jlb:Hgrid%jub, & + size(dpde,3)) :: hkew3, hkns3, hkew, hkns, & + hcew, hcns, dat, vdat, hdac + + real, dimension(Hgrid%ilb:Hgrid%iub, Hgrid%jlb:Hgrid%jub, & + size(dpde,3),3) :: pterms + + real :: dt_inv, hsign, xcoeff, ycoeff + integer :: i, j, k, n, is, ie, js, je, ntp + +!======================================================================= +! --- should damping be done ??? ---- + + if ( .not. Control%do_damping ) return + if ( Control%damping_scheme_wind+Control%damping_scheme_temp == 0 ) return + call mpp_clock_begin (id_total) + +!----------------------------------------------------------------------- +! --- check the horizontal dimensions of the input array --- + + nlev = size(dpde,3) + + if (size(dpde,1) /= Hgrid%isize .or. & + size(dpde,2) /= Hgrid%jsize ) call error_mesg & + ('bgrid_horiz_diff', 'input array has the wrong dimensions.', FATAL) + +! ---- time step related values ---- + + dt_inv = 1./dt + +! ---- initialize flux weights ---- + + hkew3 = 0.0; hkns3 = 0.0 + +!----------------------------------------------------------------------- +!-------------setup temperature and tracer damping --------------------- +!----------------------------------------------------------------------- + ntp = count( Control%order(1:Var_dt%ntrace) > 0 ) + if (Control%order(0) > 0 .or. ntp > 0) then + + ! compute grid indiecs + is = Hgrid%Tmp%is; ie = Hgrid%Tmp%ie + js = Hgrid%Tmp%js; je = Hgrid%Tmp%je + + do j = js, je + hdac(:,j,:) = Hgrid%Tmp%rarea(j) + enddo + do k = nplev+1, nlev + do j = js, je + hdac(:,j,k) = hdac(:,j,k) / (2.0*dpde(:,j,k)) + enddo + enddo + +! ----- mass-weighted fluxes ----- + do j = js-1, je + hkew3(:,j,1:nplev) = Control%areahx(j) + hkns3(:,j,1:nplev) = Control%areahy(j) + enddo + + do k = nplev+1, nlev + do j = js-1, je + do i = is-1, ie + hkew3(i,j,k) = Control%areahx(j) * (dpde(i,j,k)+dpde(i+1,j,k)) + hkns3(i,j,k) = Control%areahy(j) * (dpde(i,j,k)+dpde(i,j+1,k)) + enddo + enddo + enddo + +! ----- mask out fluxes below step-mountain ---- + + if (.not.Masks%sigma) then + do k = 1, nlev + do j = js-1, je + do i = is-1, ie + hkew3(i,j,k) = hkew3(i,j,k)*Masks%Tmp%mask(i,j,k)*Masks%Tmp%mask(i+1,j,k) + hkns3(i,j,k) = hkns3(i,j,k)*Masks%Tmp%mask(i,j,k)*Masks%Tmp%mask(i,j+1,k) + enddo + enddo + enddo + hdac(:,js:je,:) = hdac(:,js:je,:) * Masks%Tmp%mask(:,js:je,:) + endif + +!----------------------------------------------------------------------- +!----- slope adjustment ------------------------------------------------ + + if ( Control % do_slope_adj_temp ) then + call slope_correction_init ( Hgrid, Masks, nplev, pres, pterms ) + else + hcew = 0.0 + hcns = 0.0 + endif + +!----------------------------------------------------------------------- +!------------------temperature damping---------------------------------- + + if (Control%order(0) > 0) then + + ! setting up flux weights - limit to 1/8 + do k = 1, nlev + do j = Hgrid%jlb, Hgrid%jub + xcoeff = min(0.125,Control%coeff(0)*Control%wth(j,1)) + ycoeff = min(0.125,Control%coeff(0)*Control%wth(j,2)) + hkew(:,j,k) = hkew3(:,j,k) * xcoeff + hkns(:,j,k) = hkns3(:,j,k) * ycoeff + enddo + enddo + + dat = Var%t + dt*Var_dt%t +! --- slope adjustent --- + if ( Control%do_slope_adj(0) ) & + call slope_correction ( Hgrid, Masks, nplev, Control%slope(:,0), & + pterms, dat, hcew, hcns ) + call diff_mass (Hgrid, dat, hcew, hcns, hkew, hkns, hdac, & + Control%order(0)) + hsign = 1.; if (mod(Control%order(0),4) == 0) hsign = -1. + Var_dt%t = Var_dt%t + hsign * dt_inv * dat + + endif + +!----------------------------------------------------------------------- +!------------ tracer damping (prognostic tracers only) --------------- + + if (ntp > 0) then + + do n = 1, Var_dt%ntrace + + ! setting up flux weights - limit to 1/8 + do k = 1, nlev + do j = Hgrid%jlb, Hgrid%jub + xcoeff = min(0.125,Control%coeff(n)*Control%wth(j,1)) + ycoeff = min(0.125,Control%coeff(n)*Control%wth(j,2)) + hkew(:,j,k) = hkew3(:,j,k) * xcoeff + hkns(:,j,k) = hkns3(:,j,k) * ycoeff + enddo + enddo + + if (Control%order(n) == 0) cycle + dat = Var%r(:,:,:,n) + dt*Var_dt%r(:,:,:,n) + !--- slope adjustent --- + if ( Control%do_slope_adj(n) ) & + call slope_correction ( Hgrid, Masks, nplev, Control%slope(:,n), & + pterms, dat, hcew, hcns ) + call diff_mass (Hgrid, dat, hcew, hcns, hkew, hkns, & + hdac, Control%order(n)) + hsign = 1.; if (mod(Control%order(n),4) == 0) hsign = -1. + Var_dt%r(:,:,:,n) = Var_dt%r(:,:,:,n) + hsign * dt_inv * dat + enddo + + endif + + endif +!----------------------------------------------------------------------- +!*********************************************************************** +!-----------------setup momentum damping ------------------------------- + + if (Control%order(-1) > 0) then + + is = Hgrid%Vel%is; ie = Hgrid%Vel%ie + js = Hgrid%Vel%js; je = Hgrid%Vel%je + + call change_grid (Hgrid, TEMP_GRID, WIND_GRID, & + dpde(:,:,nplev+1:nlev), vdat(:,:,nplev+1:nlev)) + call update_halo (Hgrid, UWND, vdat(:,:,nplev+1:nlev), & + halos=EAST+NORTH, flags=NOPOLE) + + do j = js, je + hdac(:,j,:) = Hgrid%Vel%rarea(j) + enddo + do k = nplev+1, nlev + hdac(:,js:je,k) = hdac(:,js:je,k) / (2.*vdat(:,js:je,k)) + enddo + +! ----- mass-weighted fluxes ----- + do j = js, je+1 + hkew3(:,j,1:nplev) = Control%areavx(j) + hkns3(:,j,1:nplev) = Control%areavy(j) + enddo + + do k = nplev+1, nlev + do j = js, je+1 + do i = is, ie+1 + hkew3(i,j,k) = Control%areavx(j)*(vdat(i,j,k)+vdat(i-1,j,k)) + hkns3(i,j,k) = Control%areavy(j)*(vdat(i,j,k)+vdat(i,j-1,k)) + enddo + enddo + enddo + +! ----- mask out fluxes below step-mountain ---- + + if (.not.Masks%sigma) then + do k = 1, nlev + do j = js, je+1 + do i = is, ie+1 + hkew3(i,j,k) = hkew3(i,j,k)*Masks%Vel%mask(i,j,k)*Masks%Vel%mask(i-1,j,k) + hkns3(i,j,k) = hkns3(i,j,k)*Masks%Vel%mask(i,j,k)*Masks%Vel%mask(i,j-1,k) + enddo + enddo + enddo + hdac(:,js:je,:) = hdac(:,js:je,:) * Masks%Tmp%mask(:,js:je,:) + endif + +!----------------------------------------------------------------------- +!----- slope adjustment setup ------ + + if ( Control % do_slope_adj(-1) ) then +! ---- pressure at velocity points ---- + vdat(:,:,1:nplev) = pres(:,:,1:nplev) + call change_grid ( Hgrid, TEMP_GRID, WIND_GRID, & + pres(:,:,nplev+1:nlev), vdat(:,:,nplev+1:nlev) ) + call update_halo (Hgrid, UWND, vdat(:,:,nplev+1:nlev), & + halos=EAST+NORTH, flags=NOPOLE) + + call vel_slope_correction_init ( Hgrid, Masks, nplev, & + Control%slope(:,-1), & + vdat, pterms ) + endif + +!----------------------------------------------------------------------- + + ! setting up flux weights - limit to 1/8 + do k = 1, nlev + do j = js, je+1 + xcoeff = min(0.125,Control%coeff(-1)*Control%wtv(j,1)) + ycoeff = min(0.125,Control%coeff(-1)*Control%wtv(j,2)) + hkew(:,j,k) = hkew3(:,j,k) * xcoeff + hkns(:,j,k) = hkns3(:,j,k) * ycoeff + enddo + enddo + ! zero-out cross polar fluxes + call vel_flux_boundary (Hgrid, hkns) + +!----------------------------------------------------------------------- +!-------------------------momentum damping------------------------------ + + dat = Var%u + dt*Var_dt%u + vdat = Var%v + dt*Var_dt%v + if ( Control % do_slope_adj(-1) ) then + if (Masks%sigma) then + call diff_vel (Hgrid, dat,vdat, hkew,hkns, hdac, & + Control%order(-1), pterms) + else + call diff_vel (Hgrid, dat,vdat, hkew,hkns, hdac, & + Control%order(-1), pterms, Masks%Vel%kbot) + endif + else + call diff_vel (Hgrid, dat,vdat, hkew,hkns, hdac, & + Control%order(-1)) + endif + hsign = 1.; if (mod(Control%order(-1),4) == 0) hsign = -1. + Var_dt%u = Var_dt%u + hsign * dt_inv * dat + Var_dt%v = Var_dt%v + hsign * dt_inv * vdat + + endif + + call mpp_clock_end (id_total) + +!----------------------------------------------------------------------- + + end subroutine horiz_diff + +!####################################################################### +!####################################################################### + + subroutine diff_mass (Hgrid, rdat, hcew, hcns, hkew, hkns, hdac, & + order) + +!---------------------------------------------------------------------- +! +! diff_mass is a private interface that performs multiple +! 2nd order lapacians. +! +!---------------------------------------------------------------------- + + type(horiz_grid_type), intent(inout) :: Hgrid + integer, intent(in) :: order + real , intent(inout), dimension(Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub, & + nlev) :: rdat + real , intent(in), dimension(Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub, & + nlev) :: hcew, hcns, & + hkew, hkns, hdac + +!---------------------------------------------------------------------- +! hcew, hcns are weighted corrections to the diffusive fluxes for +! sloping sigma surfaces +!---------------------------------------------------------------------- + + real, dimension(Hgrid%ilb:Hgrid%iub, Hgrid%jlb:Hgrid%jub) :: & + rew, rns + integer :: i, j, k, n, is, ie, js, je, nordr + +!----------------------------------------------------------------------- + + is = Hgrid%Tmp%is; ie = Hgrid%Tmp%ie + js = Hgrid%Tmp%js; je = Hgrid%Tmp%je + +!----------------------------------------------------------------------- +!------------loop for order of damping scheme------------------------- + + do n = 1, order/2 + + do k = 1, nlev + +!------------------contributions (fluxes) ------------------------------ + + if ( n == 1 ) then + do j = js-1, je + do i = is-1, ie + rew(i,j) = (rdat(i+1,j,k)-rdat(i,j,k)+hcew(i,j,k))*hkew(i,j,k) + rns(i,j) = (rdat(i,j+1,k)-rdat(i,j,k)+hcns(i,j,k))*hkns(i,j,k) + enddo + enddo + else + do j = js-1, je + do i = is-1, ie + rew(i,j) = (rdat(i+1,j,k)-rdat(i,j,k))*hkew(i,j,k) + rns(i,j) = (rdat(i,j+1,k)-rdat(i,j,k))*hkns(i,j,k) + enddo + enddo + endif + +!----------------------------------------------------------------------- + + do j = js, je + do i = is, ie + rdat(i,j,k)=(rew(i,j)-rew(i-1,j)+rns(i,j)-rns(i,j-1)) & + *hdac(i,j,k) + enddo + enddo + + enddo + +!----------------------------------------------------------------------- +!---- update all halo rows ? ---- +! do not update on last pass, halos will updated in the main program + + if ( n < order/2 ) then + call update_halo (Hgrid, TEMP, rdat) + endif + +!----------------------------------------------------------------------- + + enddo + +!----------------------------------------------------------------------- + + end subroutine diff_mass + +!####################################################################### + + subroutine diff_vel (Hgrid, udat, vdat, vkew, vkns, hdac, order, terms, kbot) + +!---------------------------------------------------------------------- +! +! diff_vel is a private interface that performs multiple +! 2nd order lapacians for the momentum components. +! +!---------------------------------------------------------------------- + + type(horiz_grid_type), intent(inout) :: Hgrid + integer, intent(in) :: order + real , intent(inout), dimension(Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub, & + nlev) :: udat, vdat + real , intent(in), dimension(Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub, & + nlev) :: vkew, vkns, hdac + real , intent(in), dimension(Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub, & + nlev, 3), optional :: terms + integer, intent(in), dimension(Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub), & + optional :: kbot + +!---------------------------------------------------------------------- + + real, dimension(Hgrid%ilb:Hgrid%iub, Hgrid%jlb:Hgrid%jub) :: & + uew, uns, vew, vns, dudp, dvdp, ucew, ucns, vcew, vcns + integer :: i, j, k, n, is, ie, js, je, k1, k2 + +!----------------------------------------------------------------------- + + is = Hgrid%Vel%is; ie = Hgrid%Vel%ie + js = Hgrid%Vel%js; je = Hgrid%Vel%je + +!------------loop for order of damping scheme--------------------------- + + do n = 1, order/2 + + do k = 1, nlev + +!------------------contributions (fluxes) ------------------------------ + + if ( n == 1 .and. present(terms) ) then + + k1 = max(k-1,1) + if (present(kbot)) then + do j = Hgrid%jlb, Hgrid%jub + do i = Hgrid%ilb, Hgrid%iub + k2 = min(k+1,kbot(i,j)) + dudp(i,j) = (udat(i,j,k2)-udat(i,j,k1))*terms(i,j,k,1) + dvdp(i,j) = (vdat(i,j,k2)-vdat(i,j,k1))*terms(i,j,k,1) + enddo + enddo + else + k2 = min(k+1,nlev) + dudp(:,:) = (udat(:,:,k2)-udat(:,:,k1))*terms(:,:,k,1) + dvdp(:,:) = (vdat(:,:,k2)-vdat(:,:,k1))*terms(:,:,k,1) + endif + + do j = js, je+1 + do i = is, ie+1 +! ---- slope correction terms ---- + ucew(i,j) = (dudp(i,j)+dudp(i-1,j))*terms(i,j,k,2) + ucns(i,j) = (dudp(i,j)+dudp(i,j-1))*terms(i,j,k,3) + vcew(i,j) = (dvdp(i,j)+dvdp(i-1,j))*terms(i,j,k,2) + vcns(i,j) = (dvdp(i,j)+dvdp(i,j-1))*terms(i,j,k,3) + + uew(i,j) = (udat(i,j,k)-udat(i-1,j ,k)+ucew(i,j))*vkew(i,j,k) + uns(i,j) = (udat(i,j,k)-udat(i ,j-1,k)+ucns(i,j))*vkns(i,j,k) + vew(i,j) = (vdat(i,j,k)-vdat(i-1,j ,k)+vcew(i,j))*vkew(i,j,k) + vns(i,j) = (vdat(i,j,k)-vdat(i ,j-1,k)+vcns(i,j))*vkns(i,j,k) + enddo + enddo + + else + + do j = js, je+1 + do i = is, ie+1 + uew(i,j) = (udat(i,j,k)-udat(i-1,j ,k))*vkew(i,j,k) + uns(i,j) = (udat(i,j,k)-udat(i ,j-1,k))*vkns(i,j,k) + vew(i,j) = (vdat(i,j,k)-vdat(i-1,j ,k))*vkew(i,j,k) + vns(i,j) = (vdat(i,j,k)-vdat(i ,j-1,k))*vkns(i,j,k) + enddo + enddo + + endif + +!----------------------------------------------------------------------- + do j = js, je + do i = is, ie + udat(i,j,k) = (uew(i+1,j )-uew(i,j)+ & + uns(i ,j+1)-uns(i,j))*hdac(i,j,k) + vdat(i,j,k) = (vew(i+1,j )-vew(i,j)+ & + vns(i ,j+1)-vns(i,j))*hdac(i,j,k) + enddo + enddo + + enddo +!----------------------------------------------------------------------- +!---- update all halo rows ? ---- +! do not update on last pass, halos will updated in the main program + + if ( n < order/2 ) then + call update_halo (Hgrid, UWND, udat) + call update_halo (Hgrid, VWND, vdat) + endif + +!----------------------------------------------------------------------- + + enddo + +!----------------------------------------------------------------------- + + end subroutine diff_vel + +!####################################################################### + + subroutine horiz_diff_init ( Hgrid ) + +!----------------------------------------------------------------------- +! initialization of horizontal damping coefficients +!----------------------------------------------------------------------- + + type(horiz_grid_type), intent(in) :: Hgrid ! horizontal grid constants + +!----------------------------------------------------------------------- + +real :: eps = 1.e-6 +integer :: j + + integer :: n, nv, order, ntrace, unit, ierr, io, logunit + real :: coeff, slope(4) + character(len=128) :: scheme, params, tname + +!----------------------------------------------------------------------- +! read namelist + if (file_exist('input.nml')) then +#ifdef INTERNAL_FILE_NML + read (input_nml_file, nml=bgrid_horiz_diff_nml, iostat=io) + ierr = check_nml_error(io,'bgrid_horiz_diff_nml') +#else + unit = open_namelist_file ( ) + ierr=1; do while (ierr /= 0) + read (unit, nml=bgrid_horiz_diff_nml, iostat=io, end=5) + ierr = check_nml_error (io, 'bgrid_horiz_diff_nml') + enddo + 5 call close_file (unit) +#endif + endif + + logunit = stdlog() + if (do_log) then + call write_version_number (version,tagname) + if (mpp_pe() == mpp_root_pe()) write (logunit, nml=bgrid_horiz_diff_nml) + do_log = .false. + endif + + call get_number_tracers ( MODEL_ATMOS, num_prog=ntrace ) + + allocate ( Control%order (-1:ntrace), & + Control%coeff (-1:ntrace), & + Control%do_slope_adj (-1:ntrace), & + Control%slope (4,-1:ntrace) ) + + ! defaults + Control%order = 4 + Control%coeff = .35 + Control%slope = 0. + + ! namelist arguments + Control%order (-1) = damp_order_wind + Control%coeff (-1) = damp_coeff_wind + Control%slope(:,-1) = slope_corr_wind + + Control%order (0) = damp_order_temp + Control%coeff (0) = damp_coeff_temp + Control%slope(:,0) = slope_corr_temp + + Control%order (1:ntrace) = damp_order_tracer + Control%coeff (1:ntrace) = damp_coeff_tracer + Control%slope(:,1:ntrace) = spread(slope_corr_tracer,2,ntrace) + + ! set the damping scheme (check for errors below) + Control % damping_scheme_wind = damp_scheme_wind + Control % damping_scheme_temp = damp_scheme_temp + + ! process tracer table information for horizontal damping methods + do n = 1, ntrace + if (query_method('diff_horiz', MODEL_ATMOS, n, scheme, params)) then + if (uppercase(trim(scheme)) /= 'LINEAR' .and. uppercase(trim(scheme)) /= 'NONE') & + call error_mesg ('bgrid_horiz_diff_mod', & + 'invalid damping method, '//uppercase(trim(scheme)), FATAL) + if (parse(params,'order', order) == 1) Control%order(n) = order + if (uppercase(trim(scheme)) == 'NONE') Control%order(n) = 0 + if (parse(params,'coeff', coeff) == 1) Control%coeff(n) = coeff + nv = parse(params,'slope', slope) + Control%slope (1:nv,n) = slope(1:nv) + endif + if (mpp_pe() == mpp_root_pe()) then + call get_tracer_names (MODEL_ATMOS, n, tname) + write (logunit,10) n, trim(tname), Control%order(n), Control%coeff(n), Control%slope(:,n) + 10 format (i3, a24, ', Order=',i2, ', Coeff=',f10.5, ', Slope=',4f10.5) + endif + enddo + + ! error checking + do n = -1, ntrace + !-- order + if (Control%order(n) < 0 .or. mod(Control%order(n),2) /= 0) & + call error_mesg ('bgrid_horiz_diff_mod', 'invalid damping order', FATAL) + !-- non-dimension, normalized coefficient + if (Control%coeff(n) < 0. .or. Control%coeff(n) > 1.) call error_mesg & + ('bgrid_horiz_diff_mod', 'invalid damping coeff', FATAL) + !-- slope correction weights + if (minval(Control%slope(:,n)) < 0. .or. maxval(Control%slope(:,n)) > 1.) & + call error_mesg ('bgrid_horiz_diff_mod', 'invalid slope correction coeff', FATAL) + enddo + + ! set flags + Control%do_damping = maxval(Control%order) > 0 + Control%do_slope_adj_temp = .false. + do n = -1, ntrace + Control%do_slope_adj(n) = maxval(Control%slope(:, n)) > 1.e-6 + ! set flag for temp OR tracer slope adjustment + if (n >= 0 .and. Control%do_slope_adj(n)) Control%do_slope_adj_temp = .true. + enddo + +!----------------------------------------------------------------------- +!----- pre-compute metric terms ------ + + allocate ( Control%areahx (Hgrid%jlb:Hgrid%jub), & + Control%areahy (Hgrid%jlb:Hgrid%jub), & + Control%areavx (Hgrid%jlb:Hgrid%jub), & + Control%areavy (Hgrid%jlb:Hgrid%jub), & + Control%wth (Hgrid%jlb:Hgrid%jub,2), & + Control%wtv (Hgrid%jlb:Hgrid%jub,2) ) + +! ---- areas averaged along axes ---- + + do j = Hgrid%Tmp%jsd, Hgrid%Tmp%jed-1 + Control%areahx(j) = 0.5*(Hgrid%Tmp%area(j)+Hgrid%Tmp%area(j)) + Control%areahy(j) = 0.5*(Hgrid%Tmp%area(j)+Hgrid%Tmp%area(j+1)) + enddo + + do j = Hgrid%Vel%jsd+1, Hgrid%Vel%jed + Control%areavx(j) = 0.5*(Hgrid%Vel%area(j)+Hgrid%Vel%area(j)) + Control%areavy(j) = 0.5*(Hgrid%Vel%area(j)+Hgrid%Vel%area(j-1)) + enddo + + +! ---- damping weight of x and y axis varies ---- +! ---- depending which damping scheme is used ---- + + call damp_scheme_init ( Hgrid, WIND_GRID, & + Control%damping_scheme_wind, Control%wtv ) + call damp_scheme_init ( Hgrid, TEMP_GRID, & + Control%damping_scheme_temp, Control%wth ) + +! initialize code sections for performance timing + + if (do_clock_init) then + id_total = mpp_clock_id ('BGRID: horiz_diff (TOTAL)', & + flags=MPP_CLOCK_SYNC, grain=CLOCK_MODULE) + do_clock_init = .false. + endif + +!----------------------------------------------------------------------- + + end subroutine horiz_diff_init + +!####################################################################### + + subroutine damp_scheme_init ( Hgrid, grid, scheme, weights ) + type(horiz_grid_type), intent(in) :: Hgrid + integer, intent(in) :: grid, scheme + real, intent(out) :: weights(Hgrid%jlb:Hgrid%jub,2) + + real, dimension(Hgrid%jlb:Hgrid%jub) :: dx2 + real :: dxdy2eq, dx2eq, dy2, factor2 + integer :: j + + +! ---- damping weight of x and y axis varies ---- +! ---- depending which damping scheme is used ---- +! +! scheme 1: equal/constant +! scheme 2: function of diagonal grid distance +! scheme 3: function of x-axis grid distance +! + + select case (scheme) + +! ---- uniform damping ---- + case (1) + weights = 0.125 + + case (2:5) + dx2=0.0 + if (grid == TEMP_GRID) then + do j = Hgrid%jlb, Hgrid%jub-1 + dx2(j) = Hgrid%Tmp%dx(j)**2 + enddo + dy2 = Hgrid%Tmp%dy**2 + else if (grid == WIND_GRID) then + do j = Hgrid%jlb+1, Hgrid%jub + dx2(j) = Hgrid%Vel%dx(j)**2 + enddo + dy2 = Hgrid%Vel%dy**2 + else + ! error condition needed + endif + + ! function of diagonal distance (poleward of reflat) + if (scheme == 2 .or. scheme == 4) then + factor2 = 1./cos(reflat*acos(0.)/90.)**2 + dxdy2eq = RADIUS**2*(Hgrid%dlm**2+Hgrid%dph**2) + weights(:,1) = 0.125*max(1.,dxdy2eq/(factor2*dx2+dy2)) + if (scheme == 2) then + weights(:,2) = weights(:,1) + else + weights(:,2) = 0.125 + endif + endif + + ! function of x-distance + if (scheme == 3 .or. scheme == 5) then + dx2eq = (RADIUS*Hgrid%dlm*cos(reflat*acos(0.)/90.))**2 + where (dx2 /= 0.0) weights(:,1) = 0.125*max(1.,dx2eq/dx2) + if (scheme == 3) then + weights(:,2) = weights(:,1) + else + weights(:,2) = 0.125 + endif + endif + + + case default + + call error_mesg ('bgrid_horiz_diff_mod', 'invalid damping scheme', & + FATAL) + + end select + + end subroutine damp_scheme_init + +!####################################################################### + + subroutine slope_correction_init ( Hgrid, Masks, nplev, pres, terms ) + + type(horiz_grid_type), intent(in) :: Hgrid + type (grid_mask_type), intent(in) :: Masks + integer, intent(in) :: nplev + real, intent(in) :: pres (Hgrid%ilb:,Hgrid%jlb:,:) + real, intent(out) :: terms(Hgrid%ilb:,Hgrid%jlb:,:,:) + integer :: i, j, k, k1, k2, nlev + +! initialization of pressure terms for the sigma slope correction +! these pressure terms do not change between mass variables +! may want make weight a function of variable and/or level +! USE ONE-HALF OF SPECIFIED WEIGHT AT LOWEST LEVEL + + nlev = size(pres,3) + + do k = nplev+1, nlev + !--- reciprocal of vert gradient --- + k1 = max(k-1,1) + if (Masks%sigma) then + k2 = min(k+1,nlev) + terms(:,:,k,1) = 1.0/(pres(:,:,k2)-pres(:,:,k1)) + else + do j = Hgrid%jlb, Hgrid%jub + do i = Hgrid%ilb, Hgrid%iub + k2 = min(k+1,Masks%Tmp%kbot(i,j)) + if (k2 > k1) then + terms(i,j,k,1) = 1.0/(pres(i,j,k2)-pres(i,j,k1)) + else + terms(i,j,k,1) = 0.0 + endif + enddo + enddo + endif + +! --- horiz gradients (flip sign) --- + do j = Hgrid%jlb, Hgrid%jub-1 + do i = Hgrid%ilb, Hgrid%iub-1 + terms(i,j,k,2) = (pres(i,j,k)-pres(i+1,j,k)) + terms(i,j,k,3) = (pres(i,j,k)-pres(i,j+1,k)) + enddo + enddo + enddo + + end subroutine slope_correction_init + +!####################################################################### + + subroutine vel_slope_correction_init ( Hgrid, Masks, nplev, weights, pres, terms ) + + type(horiz_grid_type), intent(in) :: Hgrid + type (grid_mask_type), intent(in) :: Masks + integer, intent(in) :: nplev + real, intent(in) :: weights(4) + real, intent(in) :: pres (Hgrid%ilb:,Hgrid%jlb:,:) + real, intent(out) :: terms(Hgrid%ilb:,Hgrid%jlb:,:,:) + real :: wt2 + integer :: i, j, k, k1, k2, ks, nlev, isd, ied, jsd, jed + real :: dp(size(pres,1),size(pres,2)) + +! initialization of pressure terms for the sigma slope correction +! these pressure terms do not change between mass variables +! may want make weight a function of variable and/or level +! USE ONE-HALF OF SPECIFIED WEIGHT AT LOWEST LEVEL + + nlev = size(pres,3) + isd = Hgrid%Vel%isd; ied = Hgrid%Vel%ied + jsd = Hgrid%Vel%jsd; jed = Hgrid%Vel%jed + + do k = 1, nplev + terms(:,:,k,:) = 0.0 + enddo + + do k = nplev+1, nlev + k1 = max(k-1,1) + if (Masks%sigma) then + k2 = min(k+1,nlev) + dp = (pres(:,:,k2)-pres(:,:,k1)) + else + do j = Hgrid%jlb, Hgrid%jub + do i = Hgrid%ilb, Hgrid%iub + k2 = min(k+1,Masks%Vel%kbot(i,j)) + dp(i,j) = (pres(i,j,k2)-pres(i,j,k1)) + enddo + enddo + endif + !--- reciprocal of vert gradient --- + where (dp > 0.) + terms(:,:,k,1) = 1.0/dp + elsewhere + terms(:,:,k,1) = 1.e30 ! these values should not be used where it counts + endwhere + +! --- horiz gradients (flip sign) --- + ks = max(1,k-nlev+4) + wt2 = 0.5*weights(ks) + do j = Hgrid%jlb+1, Hgrid%jub + do i = Hgrid%ilb+1, Hgrid%iub + terms(i,j,k,2) = wt2*(pres(i-1,j,k)-pres(i,j,k)) + terms(i,j,k,3) = wt2*(pres(i,j-1,k)-pres(i,j,k)) + enddo + enddo + enddo + + end subroutine vel_slope_correction_init + +!####################################################################### + + subroutine slope_correction ( Hgrid, Masks, nplev, weights, terms, temp, cew, cns ) + + type(horiz_grid_type), intent(in) :: Hgrid + type (grid_mask_type), intent(in) :: Masks + integer, intent(in) :: nplev + real, intent(in) :: weights(4) + real, intent(in) :: terms(Hgrid%ilb:,Hgrid%jlb:,:,:) + real, intent(in) :: temp (Hgrid%ilb:,Hgrid%jlb:,:) + real, intent(out) :: cew (Hgrid%ilb:,Hgrid%jlb:,:),& + cns (Hgrid%ilb:,Hgrid%jlb:,:) + integer :: i, j, k, k1, k2, ks, nlev + real :: wt2 + real, dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub) :: dtdp + +! computes weighted-corrections for the slope of sigma surfaces +! to east-west and north-south fluxes of field temp + + ! check for no correction + do k = 1, 4 + if (weights(k) > 1.e-6) go to 10 + enddo + cew = 0.0; cns = 0.0 + return + +10 nlev = size(temp,3) + + do k = 1, nplev + cew(:,:,k) = 0.0 + cns(:,:,k) = 0.0 + enddo + + do k = nplev+1, nlev + k1 = max(k-1,1) + if (Masks%sigma) then + k2 = min(k+1,nlev) ! one-sided derivative at surface + dtdp(:,:) = (temp(:,:,k2)-temp(:,:,k1))*terms(:,:,k,1) + else + do j = Hgrid%jlb, Hgrid%jub + do i = Hgrid%ilb, Hgrid%iub + k2 = min(k+1,Masks%Tmp%kbot(i,j)) + dtdp(i,j) = (temp(i,j,k2)-temp(i,j,k1))*terms(i,j,k,1) + enddo + enddo + endif + + ks = max(1,k-nlev+4) + wt2 = 0.5*weights(ks) + do j = Hgrid%jlb, Hgrid%jub-1 + do i = Hgrid%ilb, Hgrid%iub-1 + ! note: terms are grouped for reproducibility with previous version + cew(i,j,k) = (dtdp(i,j)+dtdp(i+1,j))*(terms(i,j,k,2)*wt2) + cns(i,j,k) = (dtdp(i,j)+dtdp(i,j+1))*(terms(i,j,k,3)*wt2) + enddo + enddo + enddo + + end subroutine slope_correction + +!####################################################################### + +end module bgrid_horiz_diff_mod + diff --git a/MOM_code/src/atmos_bgrid/model/bgrid_sponge.F90 b/MOM_code/src/atmos_bgrid/model/bgrid_sponge.F90 new file mode 100644 index 0000000..f1e239b --- /dev/null +++ b/MOM_code/src/atmos_bgrid/model/bgrid_sponge.F90 @@ -0,0 +1,498 @@ + +module bgrid_sponge_mod + +!----------------------------------------------------------------------- +! +! Eddy damping of prognostic fields at the top level of the model +! +! Damping is done using a 5-point Shapiro filter. +! For temperature, tracers, and zonal wind the zonal mean is +! removed before applying the filter. For meridional wind, +! the entire field is damped. +! +!----------------------------------------------------------------------- + +use mpp_mod, only: input_nml_file + use bgrid_horiz_mod, only: horiz_grid_type + use bgrid_masks_mod, only: grid_mask_type + use bgrid_prog_var_mod, only: prog_var_type + use bgrid_change_grid_mod, only: change_grid, TEMP_GRID, WIND_GRID + use bgrid_halo_mod, only: update_halo, vel_flux_boundary, & + TEMP, UWND, VWND, & + NORTH, EAST, NOPOLE + + use fms_mod, only: error_mesg, FATAL, write_version_number, & + file_exist, open_namelist_file, stdlog, & + check_nml_error, close_file, mpp_pe, & + mpp_npes, mpp_root_pe, mpp_clock_id, & + mpp_clock_begin, mpp_clock_end, & + MPP_CLOCK_SYNC, CLOCK_MODULE + + use mpp_mod, only: mpp_transmit, mpp_sync_self + + use mpp_domains_mod, only: domain2d, domain1d, & + mpp_update_domains, & + mpp_get_layout, & + mpp_get_pelist, & + mpp_get_global_domain, & + mpp_get_compute_domain, & + mpp_get_compute_domains, & + mpp_get_domain_components, & + WUPDATE, EUPDATE, & + CYCLIC_GLOBAL_DOMAIN + + implicit none + private + + public sponge_driver, sponge_init + +!----------------------------------------------------------------------- +! namelist + +! num_sponge_levels The number of uppermost model levels where +! the sponge damping is applied. Currently, +! this cannot exceed one level. +! [integer, default = 0] +! +! sponge_coeff_wind Normalized [0,1] sponge damping coefficients +! sponge_coeff_temp for the top model level. +! sponge_coeff_tracer [real, default = 0.] +! + + integer :: num_sponge_levels = 0 + real :: sponge_coeff_wind = 0.0 + real :: sponge_coeff_temp = 0.0 + real :: sponge_coeff_tracer = 0.0 + + namelist /bgrid_sponge_nml/ num_sponge_levels, sponge_coeff_wind, & + sponge_coeff_temp, sponge_coeff_tracer + +!----------------------------------------------------------------------- + + character(len=128) :: version='$Id: bgrid_sponge.F90,v 19.0 2012/01/06 19:54:03 fms Exp $' + character(len=128) :: tagname='$Name: tikal $' + logical :: do_log = .true. + logical :: do_init = .true. + integer :: id_clock + + real :: small = .000001 ! damping coefficients larger than this + ! activate the sponge + +!--- module storage for computing exact/reproducible zonal means --- + type zsum_type + integer :: is , ie , js , je, isize, jsize, & + isg, ieg, nlon, imaxsize + integer, pointer :: pelist(:) => NULL(), & + sizelist(:) => NULL() + end type + + +!--- module storage for sponge control parameters --- + type sponge_control_type + real :: coeff_vel, coeff_tmp, coeff_trs + integer :: numlev + type(zsum_type) :: Zdomain_tmp, Zdomain_vel + end type sponge_control_type + + type(sponge_control_type),save :: Control + +!----------------------------------------------------------------------- + +contains + +!####################################################################### + + subroutine sponge_driver ( Hgrid, nplev, dt, dpde, Var, Var_dt ) + +!----------------------------------------------------------------------- +! Hgrid = horizontal grid constants +! nplev = number of "pure" pressure levels at the top of the model +! dt = adjustment time step +! dpde = pressure weight for model layers +! Var = prognostic variables at the last updated time level +! Var_dt = tendency of prog variables since the last updated time level +!----------------------------------------------------------------------- + type (horiz_grid_type), intent(inout) :: Hgrid + integer, intent(in) :: nplev + real, intent(in) :: dt + real, intent(in) :: dpde(Hgrid%ilb:,Hgrid%jlb:,:) + type (prog_var_type), intent(in) :: Var + type (prog_var_type), intent(inout) :: Var_dt +!----------------------------------------------------------------------- + + real, dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub,Control%numlev) :: dpxy + integer :: n, np, nt + +!----------------------------------------------------------------------- + + if (do_init) call error_mesg ('bgrid_sponge_mod', & + 'initialization not called', FATAL) + + if ( Control%numlev == 0 ) return + + call mpp_clock_begin (id_clock) +!----------------------------------------------------------------------- + + n = Control%numlev ! number of sponge levels + np = nplev ! number of pressure levels at top of model + +!---- temperature and tracers ----- + + if ( Control%coeff_tmp > small .or. Control%coeff_trs > small ) then + nt = Var_dt%ntrace + call local_filter_mass ( Hgrid, np, dt, dpde(:,:,1:n), & + Var %t(:,:,1:n), Var %r(:,:,1:n,1:nt), & + Var_dt%t(:,:,1:n), Var_dt%r(:,:,1:n,1:nt) ) + endif + +!---- momentum components ----- + + if ( Control%coeff_vel > small ) then + ! compute pressure weights at velocity points + dpxy(:,:,:) = dpde(:,:,1:n) + if (np < n) then + call change_grid (Hgrid, TEMP_GRID, WIND_GRID, & + dpxy(:,:,np+1:n), dpxy(:,:,np+1:n)) + call update_halo (Hgrid, UWND, dpxy(:,:,np+1:n), & + halos=EAST+NORTH, flags=NOPOLE) + endif + + call local_filter_vel ( Hgrid, np, dt, dpxy, & + Var %u(:,:,1:n), Var %v(:,:,1:n), & + Var_dt%u(:,:,1:n), Var_dt%v(:,:,1:n) ) + endif + + call mpp_clock_end (id_clock) +!----------------------------------------------------------------------- + + end subroutine sponge_driver + +!####################################################################### + + subroutine sponge_init (Hgrid ) + type (horiz_grid_type), intent(in) :: Hgrid ! horizontal grid constants + + integer :: unit, ierr, io, logunit +!----------------------------------------------------------------------- +! read namelist + if (file_exist('input.nml')) then +#ifdef INTERNAL_FILE_NML + read (input_nml_file, nml=bgrid_sponge_nml, iostat=io) + ierr = check_nml_error(io,'bgrid_sponge_nml') +#else + unit = open_namelist_file ( ) + ierr=1; do while (ierr /= 0) + read (unit, nml=bgrid_sponge_nml, iostat=io, end=5) + ierr = check_nml_error (io, 'bgrid_sponge_nml') + enddo + 5 call close_file (unit) +#endif + endif +! write version and namelist to log + if (do_log) then + call write_version_number (version,tagname) + logunit=stdlog() + if (mpp_pe() == mpp_root_pe()) write (logunit, nml=bgrid_sponge_nml) + do_log = .false. + endif + +! timing routine initialization + id_clock = mpp_clock_id ('BGRID: sponge', flags=MPP_CLOCK_SYNC, & + grain=CLOCK_MODULE) + +! set values for optional arguments + Control%coeff_vel = min(max(sponge_coeff_wind ,0.),1.) + Control%coeff_tmp = min(max(sponge_coeff_temp ,0.),1.) + Control%coeff_trs = min(max(sponge_coeff_tracer,0.),1.) + Control%numlev = max(num_sponge_levels,0) + +! do not allow more than one sponge layer in this version + if (Control%numlev > 1) call error_mesg ('bgrid_sponge_mod', & + 'numlev > 1 ', FATAL) + +! set up domain2d types for computing bit-reproducible zonal means + + if ( Control%coeff_tmp > small .or. Control%coeff_trs > small ) then + call zsum_init ( Hgrid%Tmp%Domain, Control%Zdomain_tmp ) + endif + if ( Control%coeff_vel > small ) then + call zsum_init ( Hgrid%Vel%Domain, Control%Zdomain_vel ) + endif + + do_init=.false. + +!----------------------------------------------------------------------- + + end subroutine sponge_init + +!####################################################################### +! sponge/filter for temperature and tracers fields + + subroutine local_filter_mass ( Hgrid, nplev, dt, dp, t, tr, tdt, trdt ) + + type (horiz_grid_type), intent(inout) :: Hgrid + integer, intent(in) :: nplev + real, intent(in) :: dt + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: dp, t + real, intent(inout), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: tdt + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:,:) :: tr + real, intent(inout), dimension(Hgrid%ilb:,Hgrid%jlb:,:,:) :: trdt + + real, dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub,size(t,3)) :: & + tmp, akew, akns, akdp + real, dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub) :: tew, tns + real, dimension(Hgrid%jlb:Hgrid%jub) :: akew2, akns2 + integer :: i, j, k, is, ie, js, je, n + + is = Hgrid%Tmp%is; ie = Hgrid%Tmp%ie + js = Hgrid%Tmp%js; je = Hgrid%Tmp%je + + ! 2D geometric constants + do j = js-1, je + akew2(j) = 0.0625 * (Hgrid%Tmp%area(j)+Hgrid%Tmp%area(j)) + akns2(j) = 0.0625 * (Hgrid%Tmp%area(j)+Hgrid%Tmp%area(j+1)) + enddo + + ! 3D mass weighted constants + do k = 1, size(t,3) + do j = js-1, je + akew(is-1:ie,j,k) = akew2(j) + akns(is-1:ie,j,k) = akns2(j) + akdp(:,j,k) = Hgrid%Tmp%rarea(j)/dt + enddo + enddo + do k = nplev+1, size(t,3) + do j = js-1, je + do i = is-1, ie + akew(i,j,k) = akew(i,j,k) * (dp(i,j,k)+dp(i+1,j,k)) + akns(i,j,k) = akns(i,j,k) * (dp(i,j,k)+dp(i,j+1,k)) + akdp(i,j,k) = akdp(i,j,k) / (2.*dp(i,j,k)) + enddo + enddo + enddo + + + ! temperature + + if ( Control%coeff_tmp > small ) then + tmp = t + dt*tdt + !---- remove zonal mean ---- + call remove_mean ( Control%Zdomain_tmp, tmp(is:ie,js:je,:) ) + call update_halo ( Hgrid, TEMP, tmp ) + do k = 1, size(t,3) + do j = js-1, je + do i = is-1, ie + tew(i,j) = akew(i,j,k) * (tmp(i+1,j,k)-tmp(i,j,k)) + tns(i,j) = akns(i,j,k) * (tmp(i,j+1,k)-tmp(i,j,k)) + enddo + enddo + do j = js, je + do i = is, ie + tdt(i,j,k) = tdt(i,j,k) + & + Control%coeff_tmp*(tew(i,j)-tew(i-1,j)+tns(i,j)-tns(i,j-1))*akdp(i,j,k) + enddo + enddo + enddo + endif + + ! tracers + + if ( Control%coeff_trs > small ) then + do n = 1, size(tr,4) + tmp = tr(:,:,:,n) + dt*trdt(:,:,:,n) + !---- remove zonal mean ---- + call remove_mean ( Control%Zdomain_tmp, tmp(is:ie,js:je,:) ) + call update_halo ( Hgrid, TEMP, tmp ) + do k = 1, size(tr,3) + do j = js-1, je + do i = is-1, ie + tew(i,j) = akew(i,j,k) * (tmp(i+1,j,k)-tmp(i,j,k)) + tns(i,j) = akns(i,j,k) * (tmp(i,j+1,k)-tmp(i,j,k)) + enddo + enddo + do j = js, je + do i = is, ie + trdt(i,j,k,n) = trdt(i,j,k,n) + & + Control%coeff_trs*(tew(i,j)-tew(i-1,j)+tns(i,j)-tns(i,j-1))*akdp(i,j,k) + enddo + enddo + enddo + enddo + endif + + end subroutine local_filter_mass + +!####################################################################### +! sponge/filter for momentum components + + subroutine local_filter_vel ( Hgrid, nplev, dt, dp, u, v, udt, vdt ) + + type (horiz_grid_type), intent(inout) :: Hgrid + integer, intent(in) :: nplev + real, intent(in) :: dt + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: dp, u, v + real, intent(inout), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: udt, vdt + + real, dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub,size(u,3)) :: & + akew, akns, akdp, uu, vv + real, dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub) :: uew, vew, uns, vns + real, dimension(Hgrid%jlb:Hgrid%jub) :: akew2, akns2 + integer :: i, j, k, is, ie, js, je + + is = Hgrid%Tmp%is; ie = Hgrid%Tmp%ie + js = Hgrid%Vel%js; je = Hgrid%Vel%je + + ! 2D geometric constants + do j = js, je+1 + akew2(j) = 0.0625 * Control%coeff_vel * (Hgrid%Vel%area(j)+Hgrid%Vel%area(j)) + akns2(j) = 0.0625 * Control%coeff_vel * (Hgrid%Vel%area(j-1)+Hgrid%Vel%area(j)) + enddo + + ! 3D mass weighted constants + do k = 1, size(u,3) + do j = js, je+1 + akew(is:ie+1,j,k) = akew2(j) + akns(is:ie+1,j,k) = akns2(j) + akdp(:,j,k) = Hgrid%Vel%rarea(j)/dt + enddo + enddo + do k = nplev+1, size(u,3) + do j = js, je+1 + do i = is, ie+1 + akew(i,j,k) = akew(i,j,k) * (dp(i,j,k)+dp(i-1,j,k)) + akns(i,j,k) = akns(i,j,k) * (dp(i,j,k)+dp(i,j-1,k)) + akdp(i,j,k) = akdp(i,j,k) / (2.*dp(i,j,k)) + enddo + enddo + enddo + + uu = u + dt*udt + vv = v + dt*vdt + !---- remove zonal mean from u comp ---- + call remove_mean ( Control%Zdomain_vel, uu(is:ie,js:je,:) ) + call update_halo ( Hgrid, UWND, uu ) + call update_halo ( Hgrid, VWND, vv ) + + do k = 1, size(u,3) + do j = js, je+1 + do i = is, ie+1 + uew(i,j) = akew(i,j,k) * (uu(i,j,k)-uu(i-1,j,k)) + vew(i,j) = akew(i,j,k) * (vv(i,j,k)-vv(i-1,j,k)) + uns(i,j) = akns(i,j,k) * (uu(i,j,k)-uu(i,j-1,k)) + vns(i,j) = akns(i,j,k) * (vv(i,j,k)-vv(i,j-1,k)) + enddo + enddo + !---- remove meridional gradients adjacent to poles ---- + call vel_flux_boundary (Hgrid, uns) + call vel_flux_boundary (Hgrid, vns) + + do j = js, je + do i = is, ie + udt(i,j,k) = udt(i,j,k) + (uew(i+1,j)-uew(i,j)+uns(i,j+1)-uns(i,j))*akdp(i,j,k) + vdt(i,j,k) = vdt(i,j,k) + (vew(i+1,j)-vew(i,j)+vns(i,j+1)-vns(i,j))*akdp(i,j,k) + enddo + enddo + enddo + + end subroutine local_filter_vel + +!####################################################################### +! initializes domain2d type for summation in zonal direction + + subroutine zsum_init ( Domain, Zonal ) + type(domain2d), intent(in) :: Domain + type(zsum_type), intent(out) :: Zonal + integer :: layout(2) + type(domain1D) :: Domx, Domy + +! create new domain2d type with large global halo along x-axis + call mpp_get_layout ( Domain, layout ) + allocate ( Zonal%pelist(layout(1)), Zonal%sizelist(layout(1)) ) + + call mpp_get_domain_components ( Domain, Domx, Domy ) + call mpp_get_pelist ( Domx, Zonal%pelist ) + call mpp_get_compute_domains ( Domx, size=Zonal%sizelist ) + +! get compute domain + call mpp_get_global_domain ( Domain, Zonal%isg, Zonal%ieg ) + call mpp_get_compute_domain ( Domain, Zonal%is , Zonal%ie , & + Zonal%js , Zonal%je ) + Zonal%imaxsize = maxval(Zonal%sizelist) + Zonal%isize = Zonal%ie-Zonal%is+1 + Zonal%jsize = Zonal%je-Zonal%js+1 + Zonal%nlon = Zonal%ieg-Zonal%isg+1 + + end subroutine zsum_init + +!####################################################################### + + subroutine remove_mean ( Zonal, local ) + type(zsum_type), intent(in) :: Zonal + real, intent(inout):: local(Zonal%is:,Zonal%js:,:) ! compute domain only + real, dimension(Zonal%js:Zonal%je,size(local,3)) :: zsum + real, dimension(Zonal%imaxsize*Zonal%jsize*size(local,3)) :: data_get + real, dimension(Zonal%isize*Zonal%jsize*size(local,3)) :: data_put + integer :: i, j, k, m, n, is, ie, npts_put, npts_get + + zsum = 0. + ie = Zonal%isg - 1 + ! loop thru PEs in zonal direction + do n = 1, size(Zonal%pelist(:)) + is = ie + 1 + ie = is + Zonal%sizelist(n) - 1 + if (Zonal%pelist(n) == mpp_pe()) then + ! data is local to current PE + do k = 1, size(local,3) + do j = Zonal%js, Zonal%je + do i = is, ie + zsum(j,k) = zsum(j,k) + local(i,j,k) + enddo + enddo + enddo + else + ! reshape input array into 1d array (data must be contiguous) + m = 0 + do k = 1, size(local,3) + do j = Zonal%js, Zonal%je + do i = Zonal%is, Zonal%ie + m = m+1 + data_put(m) = local(i,j,k) + enddo + enddo + enddo + npts_put = size(data_put(:)) + npts_get = Zonal%sizelist(n)*size(local,2)*size(local,3) + ! data is not local (communication required) + call mpp_transmit ( put_data=data_put, put_len=npts_put, to_pe=Zonal%pelist(n), & + get_data=data_get, get_len=npts_get, from_pe=Zonal%pelist(n) ) + ! reshape (with summation) + m = 0 + do k = 1, size(local,3) + do j = Zonal%js, Zonal%je + do i = is, ie + m = m+1 + zsum(j,k) = zsum(j,k) + data_get(m) + enddo + enddo + enddo + endif + enddo + + ! remove zonal mean + do k = 1, size(local,3) + do j = Zonal%js, Zonal%je + do i = Zonal%is, Zonal%ie + local(i,j,k) = local(i,j,k) - zsum(j,k)/real(Zonal%nlon) + enddo + enddo + enddo + + ! required after a call to mpp_transmit + call mpp_sync_self() + + end subroutine remove_mean + +!####################################################################### + +end module bgrid_sponge_mod + diff --git a/MOM_code/src/atmos_bgrid/model/bgrid_vert_adjust.F90 b/MOM_code/src/atmos_bgrid/model/bgrid_vert_adjust.F90 new file mode 100644 index 0000000..3147377 --- /dev/null +++ b/MOM_code/src/atmos_bgrid/model/bgrid_vert_adjust.F90 @@ -0,0 +1,203 @@ + +module bgrid_vert_adjust_mod + +!----------------------------------------------------------------------- +! This module computes the following terms: +! * surface pressure tendency +! * vertical part of thermodynamic term (aka, omega-alpha term) +! * vertical mass flux (sigma-dot) +!----------------------------------------------------------------------- + +use bgrid_vert_mod, only: vert_grid_type +use fms_mod, only: write_version_number, & + mpp_clock_id, mpp_clock_begin, mpp_clock_end, & + MPP_CLOCK_SYNC, CLOCK_MODULE + +implicit none +private + +!----------------------------------------------------------------------- +!---- public interfaces ----- + +public :: vert_adjust, vert_adjust_init + +!----------------------------------------------------------------------- + +character(len=128) :: version='$Id: bgrid_vert_adjust.F90,v 11.0 2004/09/28 19:07:04 fms Exp $' +character(len=128) :: tagname='$Name: tikal $' + +integer :: id_clock +logical :: initialized = .false. + +!----------------------------------------------------------------------- + +contains + +!####################################################################### + +subroutine vert_adjust ( Vgrid, res, div, wta, wtb, mask, & + omgalf, etadot, psdt) + +!----------------------------------------------------------------------- +! INPUT +! Vgrid = vertical grid constants +! res = reciprocal of eta at the surface (=1 for sigma) +! div = mass divergence (Pa/s) +! wta,wtb = weights for obtaining full level values +! mask = grid box mask for eta coordinate mountains +! INPUT/OUTPUT +! omgalf = thermodynamic (omega-alpha) term (Pa/s) +! (input: horiz part; output: horiz+vert part) +! etadot = vertical mass flux (a summation) (Pa/s) +! OUTPUT +! psdt = surface pressure tendency (Pa/s) +!----------------------------------------------------------------------- + +type(vert_grid_type), intent(in) :: Vgrid +real, intent(in), dimension(:,:) :: res +real, intent(in), dimension(:,:,:) :: div, wta, wtb, mask +real, intent(inout), dimension(:,:,:) :: omgalf +real, intent(inout), dimension(:,:,:) :: etadot +real, intent(out), dimension(:,:) :: psdt + +! sdiv = vertical integral of div +real, dimension(size(div,1),size(div,2),size(div,3)) :: sdiv +!----------------------------------------------------------------------- + if (.not.initialized) call vert_adjust_init + call mpp_clock_begin (id_clock) + +!----- vertical adjustments ---- + + call ps_tendency (div, psdt, sdiv) + call vert_omgalf (Vgrid, res, wta, wtb, sdiv, mask, omgalf) + +!----- compute "eta-dot", the vertical velocity ----- + + call vert_velocity (res, sdiv, mask, Vgrid%eta, etadot) + + call mpp_clock_end (id_clock) +!----------------------------------------------------------------------- + +end subroutine vert_adjust + +!####################################################################### + +subroutine vert_adjust_init + + call write_version_number (version,tagname) + + id_clock = mpp_clock_id ('BGRID: vert_adjust', flags=MPP_CLOCK_SYNC, & + grain=CLOCK_MODULE) + initialized=.true. + +end subroutine vert_adjust_init + +!####################################################################### + +subroutine ps_tendency (div, psdt, sdiv) + +!----------------------------------------------------------------------- +! +! Routine for calculating the vertical integral +! of divergence and surface pressure tendency +! +!----------------------------------------------------------------------- + + real, intent(in) :: div(:,:,:) + real, intent(out) :: psdt(:,:), sdiv(:,:,:) + + integer k, kdim +!----------------------------------------------------------------------- + + kdim = size(div,3) + +!---------integrate divergence to get surface pressure tendency--------- + + sdiv(:,:,1) = div(:,:,1) + do k = 2, kdim + sdiv(:,:,k) = sdiv(:,:,k-1) + div(:,:,k) + enddo + psdt(:,:) = -sdiv(:,:,kdim) + +!----------------------------------------------------------------------- + +end subroutine ps_tendency + +!####################################################################### + +subroutine vert_velocity (res, sdiv, mask, eta, etadot) + +!----------------------------------------------------------------------- +! +! Routine for calculating the vertical velocity ("eta-dot") +! +!----------------------------------------------------------------------- + + real, intent(in) :: res(:,:), sdiv(:,:,:), & + mask(:,:,:), eta(:) + real, intent(inout) :: etadot(:,:,:) + + real, dimension(size(res,1),size(res,2)) :: pret + integer k, kdim + +!---- computation of etadot (add onto previous value) ---- + + kdim = size(sdiv,3) + + pret(:,:) = -sdiv(:,:,kdim)*res(:,:) + + do k = 2, kdim + etadot(:,:,k) = etadot(:,:,k) & + - (pret(:,:)*eta(k)+sdiv(:,:,k-1))*mask(:,:,k) + enddo + +!----------------------------------------------------------------------- + +end subroutine vert_velocity + +!####################################################################### + +subroutine vert_omgalf (Vgrid, res, wta, wtb, sdiv, mask, omgalf) + +!----------------------------------------------------------------------- +! +! Routine for calculating the vertical part of the omega-alpha term +! +!----------------------------------------------------------------------- + + type(vert_grid_type), intent(in) :: Vgrid + real, intent(in), dimension(:,:) :: res + real, intent(in), dimension(:,:,:) :: wta, wtb, sdiv, mask + real, intent(inout), dimension(:,:,:) :: omgalf + + real, dimension(size(res,1),size(res,2)) :: pret + integer k, kdim + +!----------------------------------------------------------------------- +!-----kinetic energy generation terms in the thermodynamic equation----- + + kdim = size(sdiv,3) + + omgalf(:,:,1) = omgalf(:,:,1) - wtb(:,:,1)*sdiv(:,:,1)*mask(:,:,1) + +!!!do k=2,kdim-1 + do k=2,kdim + omgalf(:,:,k) = omgalf(:,:,k) - mask(:,:,k)* & + (wta(:,:,k)*sdiv(:,:,k-1)+wtb(:,:,k)*sdiv(:,:,k)) + enddo + +! --- may need to add/modify for eta coordinate? --- +! if (kdim > 1) then +! pret(:,:) = -sdiv(:,:,kdim)*res(:,:) +! omgalf(:,:,kdim) = omgalf(:,:,kdim) + mask(:,:,kdim)* & +! (wtb(:,:,k)*pret(:,:)-wta(:,:,k)*sdiv(:,:,kdim-1)) +! endif + +!----------------------------------------------------------------------- + +end subroutine vert_omgalf + +!####################################################################### + +end module bgrid_vert_adjust_mod + diff --git a/MOM_code/src/atmos_bgrid/tools/bgrid_change_grid.F90 b/MOM_code/src/atmos_bgrid/tools/bgrid_change_grid.F90 new file mode 100644 index 0000000..39dcd33 --- /dev/null +++ b/MOM_code/src/atmos_bgrid/tools/bgrid_change_grid.F90 @@ -0,0 +1,716 @@ + +module bgrid_change_grid_mod + +! interpolates data between grids + +use bgrid_horiz_mod, only: horiz_grid_type +use fms_mod, only: error_mesg, FATAL, WARNING, & + mpp_pe, mpp_root_pe +implicit none +private + + public :: change_grid + + interface change_grid + module procedure change_grid_2d, change_grid_2flds_2d, & + change_grid_3d, change_grid_2flds_3d + end interface + +! Grid identifiers for the four basic horizontal grids: +! +! TEMP_GRID = temperature (mass) grid +! WIND_GRID = velocity (momentum) grid +! UFLX_GRID = zonal mass flux grid; grid points are located +! between temperature points along the x-axis +! VFLX_GRID = meridional mass flux grid; grid points are located +! between temperature points along the y-axis +! +! Grid boxes with the same (i,j) indexing have the following +! proximity to one another: +! +! VFLX(i,j) WIND(i,j) +! +! TEMP(i,j) UFLX(i,j) + + integer, parameter, public :: TEMP_GRID=101, WIND_GRID=102, & + UFLX_GRID=104, VFLX_GRID=105 + +! identifiers for the type of interpolation weighting + integer, public, parameter :: AREA = 1, EQUAL = 2 + +!---------------------------------------------------------------- +!------ private data ------- + +! indexing for interpolation weights array + integer, parameter :: SOUTH = 1, NORTH = 2 + +! module variables (used between internal interfaces) + integer :: ilb, iub, jlb, jub + real, pointer :: weights(:,:) =>NULL() + integer :: option + +contains + +!############################################################################## +! Routine to interpolate one field + +subroutine change_grid_3d ( Hgrid, grid_inp, grid_out, data_inp, data_out, & + weight, mask_inp ) + +! Arguments +! Hgrid = horizontal grid constants +! grid_inp = grid identifier for the input grid +! grid_out = grid identifier for the output grid +! data_inp = input data +! data_out = output data +! Optional +! weight = integer flag that type of interpolation +! weight=AREA for area weighting (the default) or +! weight=EQUAL for simple 4-pt (or 2pt) averaging +! mask_inp = grid box mask (typically for step-coordinate model) + +type(horiz_grid_type), intent(in) :: Hgrid +integer, intent(in) :: grid_inp, grid_out +real, intent(in) :: data_inp(Hgrid%ilb:,Hgrid%jlb:,:) +real, intent(out) :: data_out(Hgrid%ilb:,Hgrid%jlb:,:) +integer, intent(in), optional :: weight +real, intent(in), optional :: mask_inp(Hgrid%ilb:,Hgrid%jlb:,:) + + call set_options ( Hgrid, grid_inp, grid_out, weight ) + + select case (option) + ! velocity grid to temperature grid + case (1) + call vel_to_tmp ( data_inp, data_out, mask=mask_inp ) + case (2) + call tmp_to_vel ( data_inp, data_out, mask=mask_inp ) + case (3) + call vflx_to_uflx ( data_inp, data_out, mask=mask_inp ) + case (4) + call uflx_to_vflx ( data_inp, data_out, mask=mask_inp ) + case (5) + if (present(mask_inp)) call mask_warning + call tmp_to_uflx ( data_inp, data_out ) + case (6) + if (present(mask_inp)) call mask_warning + call tmp_to_vflx ( data_inp, data_out ) + end select + + nullify (weights) + +end subroutine change_grid_3d + +!############################################################################## +! Routine to interpolate two fields (on the same grid) at a time + +subroutine change_grid_2flds_3d ( Hgrid, grid_inp, grid_out, data_inp1, data_inp2, & + data_out1, data_out2, weight, mask_inp ) + +! Arguments +! Hgrid = horizontal grid constants +! grid_inp = grid identifier for the input grids +! grid_out = grid identifier for the output grids +! data_inp1 = input data for field 1 +! data_inp2 = input data for field 2 +! data_out1 = output data for field 1 +! data_out2 = output data for field 2 +! Optional +! weight = integer flag that type of interpolation +! weight=AREA for area weighting (the default) or +! weight=EQUAL for simple 4-pt (or 2pt) averaging +! mask_inp = grid box mask (typically for step-coordinate model) + +type(horiz_grid_type), intent(in) :: Hgrid +integer, intent(in) :: grid_inp, grid_out +real, intent(in) :: data_inp1(Hgrid%ilb:,Hgrid%jlb:,:), & + data_inp2(Hgrid%ilb:,Hgrid%jlb:,:) +real, intent(out) :: data_out1(Hgrid%ilb:,Hgrid%jlb:,:), & + data_out2(Hgrid%ilb:,Hgrid%jlb:,:) +integer, intent(in), optional :: weight +real, intent(in), optional :: mask_inp(Hgrid%ilb:,Hgrid%jlb:,:) + + call set_options ( Hgrid, grid_inp, grid_out, weight ) + + select case (option) + ! velocity grid to temperature grid + case (1) + call vel_to_tmp ( data_inp1, data_out1, data_inp2, data_out2, mask=mask_inp ) + case (2) + call tmp_to_vel ( data_inp1, data_out1, data_inp2, data_out2, mask=mask_inp ) + case (3) + call vflx_to_uflx ( data_inp1, data_out1, data_inp2, data_out2, mask=mask_inp ) + case (4) + call uflx_to_vflx ( data_inp1, data_out1, data_inp2, data_out2, mask=mask_inp ) + case (5) + if (present(mask_inp)) call mask_warning + call tmp_to_uflx ( data_inp1, data_out1, data_inp2, data_out2 ) + case (6) + if (present(mask_inp)) call mask_warning + call tmp_to_vflx ( data_inp1, data_out1, data_inp2, data_out2 ) + end select + + nullify (weights) + +end subroutine change_grid_2flds_3d + +!############################################################################## +! ############## private grid-to-grid interpolation interfaces ############## +!############################################################################## + +subroutine vel_to_tmp ( idat1, odat1, idat2, odat2, mask ) +real, intent(in) :: idat1(ilb:,jlb:,:) +real, intent(out) :: odat1(ilb:,jlb:,:) +real, intent(in), optional :: idat2(ilb:,jlb:,:) +real, intent(out), optional :: odat2(ilb:,jlb:,:) +real, intent(in), optional :: mask (ilb:,jlb:,:) + +integer :: i, j, k +real, dimension(ilb:iub) :: savg1, navg1, savg2, navg2, smask, nmask + +!-------------------------------------------------------------------- +! velocity grid to temperature grid +! south and west boundaries not computed +!---------------------------------------- + + do k = 1, size(idat1,3) + + ! compute x-average along southernmost row before starting j-loop + do i = ilb+1, iub + savg1(i) = idat1(i-1,jlb,k)+idat1(i,jlb,k) + enddo + if (present(idat2)) then + do i = ilb+1, iub + savg2(i) = idat2(i-1,jlb,k)+idat2(i,jlb,k) + enddo + endif + if (present(mask)) then + do i = ilb+1, iub + smask(i) = (mask(i-1,jlb,k)+mask(i,jlb,k))*0.25 + enddo + endif + + ! loop over latitudes + do j = jlb+1, jub + + ! compute x-average for north boxes in 4pt average + do i = ilb+1, iub + navg1(i) = idat1(i-1,j,k)+idat1(i,j,k) + enddo + if (present(idat2)) then + do i = ilb+1, iub + navg2(i) = idat2(i-1,j,k)+idat2(i,j,k) + enddo + endif + if (present(mask)) then + do i = ilb+1, iub + nmask(i) = (mask(i-1,j,k)+mask(i,j,k))*0.25 + enddo + endif + + ! compute 4pt average - then update south average with north average + do i = ilb+1, iub + odat1(i,j,k) = savg1(i) * weights(j,SOUTH) + & + navg1(i) * weights(j,NORTH) + savg1(i) = navg1(i) + enddo + if (present(idat2)) then + do i = ilb+1, iub + odat2(i,j,k) = savg2(i) * weights(j,SOUTH) + & + navg2(i) * weights(j,NORTH) + savg2(i) = navg2(i) + enddo + endif + ! apply weighting for masked grid boxes + if (present(mask)) then + do i = ilb+1, iub + if (smask(i)+nmask(i) > 0.) then + odat1(i,j,k) = odat1(i,j,k)/(smask(i)+nmask(i)) + if (present(idat2)) odat2(i,j,k) = odat2(i,j,k)/(smask(i)+nmask(i)) + else + odat1(i,j,k) = 0. + if (present(idat2)) odat2(i,j,k) = 0. + endif + smask(i) = nmask(i) + enddo + endif + + enddo ! end j-loop + enddo ! end k-loop + + ! bogus data at non-computed grid boxes + odat1(:,jlb,:) = 1.e20 + odat1(ilb,:,:) = 1.e20 + if (present(odat2)) then + odat2(:,jlb,:) = 1.e20 + odat2(ilb,:,:) = 1.e20 + endif + +end subroutine vel_to_tmp + +!############################################################################## + +subroutine tmp_to_vel ( idat1, odat1, idat2, odat2, mask ) +real, intent(in) :: idat1(ilb:,jlb:,:) +real, intent(out) :: odat1(ilb:,jlb:,:) +real, intent(in), optional :: idat2(ilb:,jlb:,:) +real, intent(out), optional :: odat2(ilb:,jlb:,:) +real, intent(in), optional :: mask (ilb:,jlb:,:) + +integer :: i, j, k +real, dimension(ilb:iub) :: savg1, navg1, savg2, navg2, smask, nmask + +!-------------------------------------------------------------------- +! temperature grid to velocity grid +! north and east boundaries not computed + + do k = 1, size(idat1,3) + + ! compute x-average along southernmost row before starting j-loop + do i = ilb, iub-1 + savg1(i) = idat1(i,jlb,k)+idat1(i+1,jlb,k) + enddo + if (present(idat2)) then + do i = ilb, iub-1 + savg2(i) = idat2(i,jlb,k)+idat2(i+1,jlb,k) + enddo + endif + if (present(mask)) then + do i = ilb, iub-1 + smask(i) = (mask(i,jlb,k)+mask(i+1,jlb,k))*0.25 + enddo + endif + + ! loop over latitudes + do j = jlb, jub-1 + + ! compute x-average for north boxes in 4pt average + do i = ilb, iub-1 + navg1(i) = idat1(i,j+1,k)+idat1(i+1,j+1,k) + enddo + if (present(idat2)) then + do i = ilb, iub-1 + navg2(i) = idat2(i,j+1,k)+idat2(i+1,j+1,k) + enddo + endif + if (present(mask)) then + do i = ilb, iub-1 + nmask(i) = (mask(i,j+1,k)+mask(i+1,j+1,k))*0.25 + enddo + endif + + ! compute 4pt average - then update south average with north average + do i = ilb, iub-1 + odat1(i,j,k) = savg1(i) * weights(j,SOUTH) + & + navg1(i) * weights(j,NORTH) + savg1(i) = navg1(i) + enddo + if (present(idat2)) then + do i = ilb, iub-1 + odat2(i,j,k) = savg2(i) * weights(j,SOUTH) + & + navg2(i) * weights(j,NORTH) + savg2(i) = navg2(i) + enddo + endif + ! apply weighting for masked grid boxes + if (present(mask)) then + do i = ilb, iub-1 + if (smask(i)+nmask(i) > 0.) then + odat1(i,j,k) = odat1(i,j,k)/(smask(i)+nmask(i)) + if (present(idat2)) odat2(i,j,k) = odat2(i,j,k)/(smask(i)+nmask(i)) + else + odat1(i,j,k) = 0. + if (present(idat2)) odat2(i,j,k) = 0. + endif + smask(i) = nmask(i) + enddo + endif + + enddo ! end j-loop + enddo ! end k-loop + + ! bogus data at non-computed grid boxes + odat1(:,jub,:) = 1.e20 + odat1(iub,:,:) = 1.e20 + if (present(odat2)) then + odat2(:,jub,:) = 1.e20 + odat2(iub,:,:) = 1.e20 + endif + +end subroutine tmp_to_vel + +!############################################################################## + +subroutine vflx_to_uflx ( idat1, odat1, idat2, odat2, mask ) +real, intent(in) :: idat1(ilb:,jlb:,:) +real, intent(out) :: odat1(ilb:,jlb:,:) +real, intent(in), optional :: idat2(ilb:,jlb:,:) +real, intent(out), optional :: odat2(ilb:,jlb:,:) +real, intent(in), optional :: mask (ilb:,jlb:,:) + +integer :: i, j, k +real, dimension(ilb:iub) :: savg1, navg1, savg2, navg2, smask, nmask + +!-------------------------------------------------------------------- +! velocity grid to temperature grid +! south and east boundaries not computed +!---------------------------------------- + + do k = 1, size(idat1,3) + + ! compute x-average along southernmost row before starting j-loop + do i = ilb, iub-1 + savg1(i) = idat1(i,jlb,k)+idat1(i+1,jlb,k) + enddo + if (present(idat2)) then + do i = ilb, iub-1 + savg2(i) = idat2(i,jlb,k)+idat2(i+1,jlb,k) + enddo + endif + if (present(mask)) then + do i = ilb, iub-1 + smask(i) = (mask(i,jlb,k)+mask(i+1,jlb,k))*0.25 + enddo + endif + + ! loop over latitudes + do j = jlb+1, jub + + ! compute x-average for north boxes in 4pt average + do i = ilb, iub-1 + navg1(i) = idat1(i,j,k)+idat1(i+1,j,k) + enddo + if (present(idat2)) then + do i = ilb, iub-1 + navg2(i) = idat2(i,j,k)+idat2(i+1,j,k) + enddo + endif + if (present(mask)) then + do i = ilb, iub-1 + nmask(i) = (mask(i,j,k)+mask(i+1,j,k))*0.25 + enddo + endif + + ! compute 4pt average - then update south average with north average + do i = ilb, iub-1 + odat1(i,j,k) = savg1(i) * weights(j,SOUTH) + & + navg1(i) * weights(j,NORTH) + savg1(i) = navg1(i) + enddo + if (present(idat2)) then + do i = ilb, iub-1 + odat2(i,j,k) = savg2(i) * weights(j,SOUTH) + & + navg2(i) * weights(j,NORTH) + savg2(i) = navg2(i) + enddo + endif + ! apply weighting for masked grid boxes + if (present(mask)) then + do i = ilb, iub-1 + if (smask(i)+nmask(i) > 0.) then + odat1(i,j,k) = odat1(i,j,k)/(smask(i)+nmask(i)) + if (present(idat2)) odat2(i,j,k) = odat2(i,j,k)/(smask(i)+nmask(i)) + else + odat1(i,j,k) = 0. + if (present(idat2)) odat2(i,j,k) = 0. + endif + smask(i) = nmask(i) + enddo + endif + + enddo ! end j-loop + enddo ! end k-loop + + ! bogus data at non-computed grid boxes + odat1(:,jlb,:) = 1.e20 + odat1(iub,:,:) = 1.e20 + if (present(odat2)) then + odat2(:,jlb,:) = 1.e20 + odat2(iub,:,:) = 1.e20 + endif + +end subroutine vflx_to_uflx + +!############################################################################## + +subroutine uflx_to_vflx ( idat1, odat1, idat2, odat2, mask ) +real, intent(in) :: idat1(ilb:,jlb:,:) +real, intent(out) :: odat1(ilb:,jlb:,:) +real, intent(in), optional :: idat2(ilb:,jlb:,:) +real, intent(out), optional :: odat2(ilb:,jlb:,:) +real, intent(in), optional :: mask (ilb:,jlb:,:) + +integer :: i, j, k +real, dimension(ilb:iub) :: savg1, navg1, savg2, navg2, smask, nmask + +!-------------------------------------------------------------------- +! uflx points to vflx points +! north and west boundaries are not computed + + do k = 1, size(idat1,3) + + ! compute x-average along southernmost row before starting j-loop + do i = ilb+1, iub + savg1(i) = idat1(i-1,jlb,k)+idat1(i,jlb,k) + enddo + if (present(idat2)) then + do i = ilb+1, iub + savg2(i) = idat2(i-1,jlb,k)+idat2(i,jlb,k) + enddo + endif + if (present(mask)) then + do i = ilb+1, iub + smask(i) = (mask(i-1,jlb,k)+mask(i,jlb,k))*0.25 + enddo + endif + + ! loop over latitudes + do j = jlb, jub-1 + + ! compute x-average for north boxes in 4pt average + do i = ilb+1, iub + navg1(i) = idat1(i-1,j+1,k)+idat1(i,j+1,k) + enddo + if (present(idat2)) then + do i = ilb+1, iub + navg2(i) = idat2(i-1,j+1,k)+idat2(i,j+1,k) + enddo + endif + if (present(mask)) then + do i = ilb+1, iub + nmask(i) = (mask(i-1,j+1,k)+mask(i,j+1,k))*0.25 + enddo + endif + + ! compute 4pt average - then update south average with north average + do i = ilb+1, iub + odat1(i,j,k) = savg1(i) * weights(j,SOUTH) + & + navg1(i) * weights(j,NORTH) + savg1(i) = navg1(i) + enddo + if (present(idat2)) then + do i = ilb+1, iub + odat2(i,j,k) = savg2(i) * weights(j,SOUTH) + & + navg2(i) * weights(j,NORTH) + savg2(i) = navg2(i) + enddo + endif + ! apply weighting for masked grid boxes + if (present(mask)) then + do i = ilb+1, iub + if (smask(i)+nmask(i) > 0.) then + odat1(i,j,k) = odat1(i,j,k)/(smask(i)+nmask(i)) + if (present(idat2)) odat2(i,j,k) = odat2(i,j,k)/(smask(i)+nmask(i)) + else + odat1(i,j,k) = 0. + if (present(idat2)) odat2(i,j,k) = 0. + endif + smask(i) = nmask(i) + enddo + endif + + enddo ! end j-loop + enddo ! end k-loop + + ! bogus data at non-computed grid boxes + odat1(:,jub,:) = 1.e20 + odat1(ilb,:,:) = 1.e20 + if (present(odat2)) then + odat2(:,jub,:) = 1.e20 + odat2(ilb,:,:) = 1.e20 + endif + +end subroutine uflx_to_vflx + +!############################################################################## + +subroutine tmp_to_uflx ( idat1, odat1, idat2, odat2 ) +real, intent(in) :: idat1(ilb:,jlb:,:) +real, intent(out) :: odat1(ilb:,jlb:,:) +real, intent(in), optional :: idat2(ilb:,jlb:,:) +real, intent(out), optional :: odat2(ilb:,jlb:,:) + +integer :: i, j, k +real, dimension(ilb:iub) :: avg1, avg2 + +!-------------------------------------------------------------------- +! temperature points to uflx points +! east boundary not computed + + do k = 1, size(odat1,3) + do j = jlb, jub + + do i = ilb, iub-1 + avg1(i) = (idat1(i,j,k)+idat1(i+1,j,k))*0.5 + enddo + do i = ilb, iub-1 + odat1(i,j,k) = avg1(i) + enddo + if (present(idat2)) then + do i = ilb, iub-1 + avg2(i) = (idat2(i,j,k)+idat2(i+1,j,k))*0.5 + enddo + do i = ilb, iub-1 + odat2(i,j,k) = avg2(i) + enddo + endif + + enddo ! end j-loop + enddo ! end k-loop + + ! bogus data at non-computed grid boxes + odat1(iub,:,:) = 1.e20 + if (present(odat2)) odat2(iub,:,:) = 1.e20 + +end subroutine tmp_to_uflx + +!############################################################################## + +subroutine tmp_to_vflx ( idat1, odat1, idat2, odat2 ) +real, intent(in) :: idat1(ilb:,jlb:,:) +real, intent(out) :: odat1(ilb:,jlb:,:) +real, intent(in), optional :: idat2(ilb:,jlb:,:) +real, intent(out), optional :: odat2(ilb:,jlb:,:) + +integer :: i, j, k +real, dimension(jlb:jub) :: avg1, avg2 + +!-------------------------------------------------------------------- +! temperature points to vflx points +! north boundary not computed + + do k = 1, size(idat1,3) + do i = ilb, iub + + do j = jlb, jub-1 + avg1(j) = (idat1(i,j ,k)*weights(j,SOUTH) + & + idat1(i,j+1,k)*weights(j,NORTH))*2.0 + enddo + do j = jlb, jub-1 + odat1(i,j,k) = avg1(j) + enddo + if (present(idat2)) then + do j = jlb, jub-1 + avg2(j) = (idat2(i,j ,k)*weights(j,SOUTH) + & + idat2(i,j+1,k)*weights(j,NORTH))*2.0 + enddo + do j = jlb, jub-1 + odat2(i,j,k) = avg2(j) + enddo + endif + + enddo ! end i-loop + enddo ! end k-loop + + ! bogus data at non-computed grid boxes + odat1(:,jub,:) = 1.e20 + if (present(odat2)) odat1(:,jub,:) = 1.e20 + +end subroutine tmp_to_vflx + +!############################################################################## + +subroutine set_options ( Hgrid, grid_inp, grid_out, weight ) +type(horiz_grid_type), intent(in) :: Hgrid +integer, intent(in) :: grid_inp, grid_out +integer, intent(in), optional :: weight +logical :: use_area_weight + + option = 0 +! valid 4pt interpolations + if ( grid_inp == WIND_GRID .and. grid_out == TEMP_GRID ) option = 1 + if ( grid_inp == TEMP_GRID .and. grid_out == WIND_GRID ) option = 2 + if ( grid_inp == VFLX_GRID .and. grid_out == UFLX_GRID ) option = 3 + if ( grid_inp == UFLX_GRID .and. grid_out == VFLX_GRID ) option = 4 +! valid 2pt interpolations + if ( grid_inp == TEMP_GRID .and. grid_out == UFLX_GRID ) option = 5 + if ( grid_inp == TEMP_GRID .and. grid_out == VFLX_GRID ) option = 6 +! error condition (no need to check later) + if (option == 0) & + call error_mesg ('change_grid', 'invalid grid change specified', FATAL) + +! weighting flag (area or equal weighting of grid boxes) + use_area_weight = .true. + if (present(weight)) then + if (weight == AREA) then + use_area_weight = .true. + else if (weight == EQUAL) then + use_area_weight = .false. + else + call error_mesg ('change_grid', 'invalid value of area_weight', FATAL) + endif + endif + +! assign pointer for weighting +! will nullify after averaging + if (use_area_weight) then + if (option == 1 .or. option == 3) weights => Hgrid%Interp%tmpwts + if (option == 2 .or. option == 4) weights => Hgrid%Interp%velwts + if (option == 5) weights => Hgrid%Interp%nowts + if (option == 6) weights => Hgrid%Interp%velwts + else + weights => Hgrid%Interp%nowts + endif + +! horizontal array limits + ilb = Hgrid%ilb; iub = Hgrid%iub + jlb = Hgrid%jlb; jub = Hgrid%jub + +end subroutine set_options + +!############################################################################## +! prints warning message that mask was not used + +subroutine mask_warning + if (mpp_pe() == mpp_root_pe()) & + call error_mesg ('bgrid_change_grid', 'optional mask argument & + ¬ used for this type of grid interpolation', WARNING) +end subroutine mask_warning + +!############################################################################## +! overloaded interfaces +!---------------------------------------------------- + +subroutine change_grid_2d ( Hgrid, grid_inp, grid_out, data_inp, data_out, weight ) +type(horiz_grid_type), intent(in) :: Hgrid +integer, intent(in) :: grid_inp, grid_out +real, intent(in) :: data_inp(Hgrid%ilb:,Hgrid%jlb:) +real, intent(out) :: data_out(Hgrid%ilb:,Hgrid%jlb:) +integer, intent(in), optional :: weight +real :: idat3(size(data_inp,1),size(data_inp,2),1) +real :: odat3(size(data_out,1),size(data_out,2),1) + + idat3(:,:,1) = data_inp + call change_grid_3d ( Hgrid, grid_inp, grid_out, idat3, odat3, weight ) + data_out = odat3(:,:,1) + +end subroutine change_grid_2d + +!---------------------------------------------------- + +subroutine change_grid_2flds_2d ( Hgrid, grid_inp, grid_out, data_inp1, data_inp2, & + data_out1, data_out2, weight ) +type(horiz_grid_type), intent(in) :: Hgrid +integer, intent(in) :: grid_inp, grid_out +real, intent(in) :: data_inp1(Hgrid%ilb:,Hgrid%jlb:), & + data_inp2(Hgrid%ilb:,Hgrid%jlb:) +real, intent(out) :: data_out1(Hgrid%ilb:,Hgrid%jlb:), & + data_out2(Hgrid%ilb:,Hgrid%jlb:) +integer, intent(in), optional :: weight +real :: idat1_3d(size(data_inp1,1),size(data_inp1,2),1) +real :: idat2_3d(size(data_inp2,1),size(data_inp2,2),1) +real :: odat1_3d(size(data_out1,1),size(data_out1,2),1) +real :: odat2_3d(size(data_out2,1),size(data_out2,2),1) + + idat1_3d(:,:,1) = data_inp1 + idat2_3d(:,:,1) = data_inp2 + call change_grid_2flds_3d ( Hgrid, grid_inp, grid_out, idat1_3d, idat2_3d, & + odat1_3d, odat2_3d, weight ) + data_out1 = odat1_3d(:,:,1) + data_out2 = odat2_3d(:,:,1) + +end subroutine change_grid_2flds_2d + +!############################################################################## + +end module bgrid_change_grid_mod + diff --git a/MOM_code/src/atmos_bgrid/tools/bgrid_cold_start.F90 b/MOM_code/src/atmos_bgrid/tools/bgrid_cold_start.F90 new file mode 100644 index 0000000..b874287 --- /dev/null +++ b/MOM_code/src/atmos_bgrid/tools/bgrid_cold_start.F90 @@ -0,0 +1,272 @@ + +module bgrid_cold_start_mod + +use mpp_mod, only: input_nml_file +use bgrid_horiz_mod, only: horiz_grid_type, get_horiz_grid_bound, TGRID +use bgrid_halo_mod, only: update_halo, TEMP +use gaussian_topog_mod, only: gaussian_topog_init +use fms_mod, only: file_exist, open_namelist_file, open_restart_file, & + open_ieee32_file, check_nml_error, close_file, & + mpp_pe, mpp_root_pe, set_domain, read_data, & + stdlog, error_mesg, FATAL, write_version_number, & + field_size, uppercase +use constants_mod, only: GRAV, RDGAS + +implicit none +private + +public cold_start_resol, cold_start + +!----------------------------------------------------------------------- +!----- namelist ------ +! +! nlon = number of grid points along the longitude axis (1st dimension) +! nlat = number of grid points along the latitude axis (2nd dimension) +! nlev = number of vertical levels (equally spaced in sigma) +! pref = initial surface pressure in pascals +! tref = initial temperature in deg kelvin +! equal_vert_spacing = specifies whether equal vertical spacing in sigma +! should be used (TRUE) or unequal spacing using +! the Smagorinski formula (FALSE). +! topog_option = how to compute topography +! possible values are: FLAT, FILE, GAUSS +! topog_file = name of topography restart file in topog_option=FILE +! +! NOTE: nlon and nlat are for the global compute grid +! + +integer :: nlon = 0 +integer :: nlat = 0 +integer :: nlev = 0 + real :: pref = 1000.e2 + real :: tref = 255. +logical :: equal_vert_spacing = .true. +character(len=8) :: topog_option = 'FLAT' +character(len=128) :: topog_file = ' ' + +namelist /bgrid_cold_start_nml/ nlon, nlat, nlev, pref, tref, & + equal_vert_spacing, topog_option, & + topog_file + +!----------------------------------------------------------------------- + +character(len=128) :: version = '$Id: bgrid_cold_start.F90,v 19.0 2012/01/06 19:54:36 fms Exp $' +character(len=128) :: tag = '$Name: tikal $' + +!----------------------------------------------------------------------- + +contains + +!####################################################################### + +subroutine cold_start_resol ( nx, ny, nz ) + + integer, intent(out) :: nx, ny, nz + + integer :: unit, ierr, io, logunit + +!-------------- read namelist -------------- + + if ( file_exist('input.nml')) then +#ifdef INTERNAL_FILE_NML +read (input_nml_file, nml=bgrid_cold_start_nml, iostat=io) +ierr = check_nml_error(io,'bgrid_cold_start_nml') +#else + unit = open_namelist_file ( ) + ierr=1; do while (ierr /= 0) + read (unit, nml=bgrid_cold_start_nml, iostat=io, end=10) + ierr = check_nml_error(io,'bgrid_cold_start_nml') + enddo + 10 call close_file (unit) +#endif + endif + +!-------- write version and namelist to log file -------- + + call write_version_number (version,tag) + logunit = stdlog() + if (mpp_pe() == mpp_root_pe()) write (logunit, nml=bgrid_cold_start_nml) + +!------- must specify a resolution ----- + + if (nlon == 0 .or. nlat == 0 .or. nlev == 0) & + call error_mesg ('bgrid_cold_start_mod', 'resolution not specified', FATAL) + +!------- otherwise, return resolution to calling program ------ + + nx = nlon + ny = nlat + nz = nlev + +end subroutine cold_start_resol + +!####################################################################### + +subroutine cold_start ( Hgrid, eta, peta, fis, res, ps, pssl, u, v, t ) + + type(horiz_grid_type), intent(inout) :: Hgrid + real, intent(out), dimension(:) :: eta, peta + real, intent(out), dimension(Hgrid%ilb:,Hgrid%jlb:) :: fis, res, & + ps, pssl + real, intent(out), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: u, v, t + !real, intent(out), dimension(Hgrid%ilb:,Hgrid%jlb:,:,:) :: r + integer :: m + real :: rt + +! very simple initial condition +! ----------------------------- +! uniform pressure (adjusted for topog) +! isothermal +! no wind + + +!--- no hybrid option --- + peta = 0.0 + + eta = compute_sigma (size(eta(:))-1) + + call compute_topog (Hgrid, fis, res) + + rt = RDGAS * tref + + ps = pref*exp(-fis/rt) + pssl = ps ! no eta option + u = 0.0 + v = 0.0 + t = tref + +end subroutine cold_start + +!####################################################################### + + subroutine compute_topog (Hgrid, fis, res) + + type(horiz_grid_type), intent(inout) :: Hgrid + real, intent(out), dimension(Hgrid%ilb:,Hgrid%jlb:) :: fis, res + + integer :: unit, ires, jres, siz(4), nc + logical :: eof_found +!----------------------------------------------------------------------- + +!--------------------------------------------- +! OPTION 1: No mountains, flat topography +!--------------------------------------------- + if ( trim(uppercase(topog_option)) == 'FLAT' ) then + fis = 0. + res = 1. + +!--------------------------------------------- +! OPTION 2: gaussian-shaped mountains +!--------------------------------------------- + else if ( trim(uppercase(topog_option(1:5))) == 'GAUSS' ) then + + call gaussian_topog_init ( Hgrid%Tmp%alm(:,Hgrid%Tmp%js), & + Hgrid%Tmp%aph(Hgrid%Tmp%is,:), & + fis(:,:) ) + fis = fis * GRAV ! convert topog from meters to geop ht + where (fis(:,:) < 0.0) fis(:,:) = 0.0 ! only in case of roundoff error + res = 1. + +!--------------------------------------------- +! OPTION 3: read topography from restart file +!--------------------------------------------- + else if ( trim(uppercase(topog_option)) == 'FILE' ) then + + if ( file_exist(trim(topog_file)) ) then + ! netcdf or native? + nc = len_trim(topog_file) + !------------------------------------------ + ! read topography from netcdf restart file + + if (topog_file(nc-2:nc) == '.nc') then + + ! read fis + call field_size (topog_file(1:nc), 'fis', siz ) + if ( siz(1) /= Hgrid%nlon .or. siz(2) /= Hgrid%nlat ) & + call error_mesg ('bgrid_cold_start_mod', 'incorrect resolution & + &or no fis field in netcdf topography file', FATAL) + call read_data (topog_file(1:nc), 'fis', fis, Hgrid%Tmp%Domain) + ! read res (if it exists) + call field_size (topog_file(1:nc), 'res', siz ) + if ( siz(1) == Hgrid%nlon .and. siz(2) == Hgrid%nlat ) then + call read_data (topog_file(1:nc), 'res', res, Hgrid%Tmp%Domain) + else + res = 1. + endif + !------------------------------------------ + ! read topography from native restart file + + else + + unit = open_restart_file (topog_file(1:nc), action='read') + read (unit) ires,jres + if ( ires /= Hgrid%nlon .or. jres /= Hgrid%nlat ) & + call error_mesg ('bgrid_cold_start_mod', & + 'incorrect resolution in native topography file', FATAL) + call set_domain (Hgrid%Tmp%Domain) + call read_data (unit, fis) ! read topog + call read_data (unit, res, end=eof_found) ! read res (if it exists) + if (eof_found) res = 1. + call close_file (unit) + + endif + + else + ! restart file does not exist + call error_mesg ('bgrid_cold_start', & + 'restart file for topography does not exist', FATAL) + endif + +!--------------------------------------------- +! OPTION 4: error condition +!--------------------------------------------- + else + call error_mesg ('bgrid_cold_start', & + 'invalid value for topog_option', FATAL) + endif + +! halos + call update_halo ( Hgrid, TEMP, fis ) + call update_halo ( Hgrid, TEMP, res ) + +!----------------------------------------------------------------------- + + end subroutine compute_topog + +!####################################################################### + + function compute_sigma (nlev) result (eta) + + integer, intent(in) :: nlev + real, dimension(nlev+1) :: eta + real :: dz, qk + integer :: k + + eta(1) = 0.0 + eta(nlev+1) = 1.0 + + if ( equal_vert_spacing ) then + + ! levels with equal sigma spacing + dz = 1./nlev + do k = 2, nlev + eta(k) = eta(k-1) + dz + enddo + + else + + ! space levels according to Smagorinski (1965, MWR, pp.727-768) + ! sigma spacing smaller at the top and bottom of model + do k = 1, nlev-1 + qk = real(2*k)/real(2*nlev) + eta(k+1) = qk*qk*(3.-2.*qk) + enddo + + endif + + end function compute_sigma + +!####################################################################### + +end module bgrid_cold_start_mod + diff --git a/MOM_code/src/atmos_bgrid/tools/bgrid_diagnostics.F90 b/MOM_code/src/atmos_bgrid/tools/bgrid_diagnostics.F90 new file mode 100644 index 0000000..04c6de6 --- /dev/null +++ b/MOM_code/src/atmos_bgrid/tools/bgrid_diagnostics.F90 @@ -0,0 +1,833 @@ + +module bgrid_diagnostics_mod + +!----------------------------------------------------------------------- + +use bgrid_horiz_mod, only: horiz_grid_type +use bgrid_vert_mod, only: vert_grid_type, compute_pres_full, & + compute_pres_half, compute_pres_depth +use bgrid_masks_mod, only: grid_mask_type +use bgrid_prog_var_mod, only: prog_var_type +use bgrid_change_grid_mod, only: change_grid, TEMP_GRID, WIND_GRID + +use diag_manager_mod, only: diag_axis_init, register_diag_field, & + register_static_field, send_data +use time_manager_mod, only: time_type + +use fms_mod, only: file_exist, open_namelist_file, & + error_mesg, NOTE, check_nml_error, & + mpp_pe, mpp_root_pe, stdlog, & + close_file, write_version_number +use constants_mod, only: GRAV, KAPPA, RDGAS +use field_manager_mod, only: MODEL_ATMOS +use tracer_manager_mod, only: get_tracer_names, get_number_tracers + + + +implicit none +private + +public :: bgrid_diagnostics_init, & + bgrid_diagnostics, & + bgrid_diagnostics_tend + +!----------------------------------------------------------------------- +!------------------------- axis names ---------------------------------- + +character(len=8) :: axiset = 'dynamics' +character(len=8) :: mod_name = 'dynamics' + +!----------------------------------------------------------------------- + + integer, parameter :: MXTR = 10 + real, parameter :: GINV = 1./GRAV + +!----------------------------------------------------------------------- +! axis and field identifiers for the diag manager + +integer :: id_hlonb, id_hlon , id_hlatb, id_hlat , & + id_vlonb, id_vlon , id_vlatb, id_vlat , & + id_phalf, id_pfull, id_hlat_wgt, id_vlat_wgt + +integer :: id_bk , id_pk , id_zsurf, id_res , id_wspd, & + id_ps , id_ucomp, id_vcomp, id_temp , id_pres_full, & + id_omega, id_div , id_vor , id_pgfx , id_pgfy, & + id_udt , id_vdt , id_tdt , id_pres_half, & + id_alm , id_aph , id_theta, id_mfew, id_mfns, id_slp +integer, allocatable :: id_tracer(:), id_tracer_tend(:) + +integer :: id_ucomp_sq, id_vcomp_sq, id_temp_sq, id_omega_sq, & + id_ucomp_vcomp, id_omega_temp + +!----------------------------------------------------------------------- +! need to save surface geopotential height argument to initialization call +! the surface height will be needed for computing sea level pressure +real, pointer, dimension(:,:) :: zsurfg +!----------------------------------------------------------------------- + + character(len=128) :: version = '$Id: bgrid_diagnostics.F90,v 19.0 2012/01/06 19:54:38 fms Exp $' + character(len=128) :: tag = '$Name: tikal $' + +!----------------------------------------------------------------------- + +contains + +!####################################################################### + +subroutine bgrid_diagnostics_init ( Time, Hgrid, Vgrid, Var, & + fis, res, & + mass_axes, vel_axes ) + +!----------------------------------------------------------------------- +! setup/write netcdf metadata and static fields +!----------------------------------------------------------------------- +! Time = current/initial time +! Hgrid = horizontal grid constants +! Vgrid = vertical grid constants +! fis = geopotential height of the surface +! res = reciprocal of eta at the surface +! mass_axes = axis identifiers for the temperature (mass) grid +! vel_axes = axis identifiers for the velocity grid +! NOTE: The axes identifiers are for the lon, lat, pfull, and +! phalf axes, respectively. They are returned by the diag_manager. +!----------------------------------------------------------------------- + + type(time_type), intent(in) :: Time + type(horiz_grid_type), intent(in) :: Hgrid + type (vert_grid_type), intent(in) :: Vgrid + type (prog_var_type), intent(in) :: Var + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:), target :: fis, res + integer, dimension(4), intent(out) :: mass_axes, vel_axes + +!----------------------------------------------------------------------- + real, dimension(Hgrid%Tmp%isg:Hgrid%Tmp%ieg+1) :: hlonb + real, dimension(Hgrid%Vel%isg:Hgrid%Vel%ieg+1) :: vlonb + real, dimension(Hgrid%Tmp%jsg:Hgrid%Tmp%jeg+1) :: hlatb + real, dimension(Hgrid%Vel%jsg:Hgrid%Vel%jeg+1) :: vlatb + + real, dimension(Hgrid%Tmp%isg:Hgrid%Tmp%ieg) :: hlon + real, dimension(Hgrid%Vel%isg:Hgrid%Vel%ieg) :: vlon + real, dimension(Hgrid%Tmp%jsg:Hgrid%Tmp%jeg) :: hlat + real, dimension(Hgrid%Vel%jsg:Hgrid%Vel%jeg) :: vlat + + real, dimension(Hgrid%Tmp%js:Hgrid%Tmp%je) :: hlat_wgt + real, dimension(Hgrid%Vel%js:Hgrid%Vel%je) :: vlat_wgt + + real, dimension(1,1) :: psurf + real, dimension(1,1,Vgrid%nlev) :: pfull + real, dimension(1,1,Vgrid%nlev+1) :: phalf + + + real :: vrange(2), trange(2), prange(2) + real :: rad2deg + integer :: i, j, n, unit, io, ierr, ntprog + integer :: isg, ieg, hsg, heg, vsg, veg + integer :: is, ie, hs, he, vs, ve + integer :: uflx_axes(4), vflx_axes(4) + integer :: logunit + logical :: used + character(len=128) :: tname + character(len=256) :: longname, units + +!--------------------------- set up axes ------------------------------- + + ! compute grid indices + is = Hgrid % Tmp % is; ie = Hgrid % Tmp % ie + hs = Hgrid % Tmp % js; he = Hgrid % Tmp % je + vs = Hgrid % Vel % js; ve = Hgrid % Vel % je + + ! global grid indices + isg = Hgrid % Tmp % isg; ieg = Hgrid % Tmp % ieg + hsg = Hgrid % Tmp % jsg; heg = Hgrid % Tmp % jeg + vsg = Hgrid % Vel % jsg; veg = Hgrid % Vel % jeg + + ! grid box boundaries in degrees + rad2deg = 90./acos(0.0) + hlonb(isg:ieg+1) = Hgrid % Tmp % blong(isg:ieg+1) * rad2deg + hlatb(hsg:heg+1) = Hgrid % Tmp % blatg(hsg:heg+1) * rad2deg + vlonb(isg:ieg+1) = Hgrid % Vel % blong(isg:ieg+1) * rad2deg + vlatb(vsg:veg+1) = Hgrid % Vel % blatg(vsg:veg+1) * rad2deg + + logunit = stdlog() + ! grid box centers in degrees + do i = isg, ieg + hlon(i) = 0.5*(hlonb(i)+hlonb(i+1)) + vlon(i) = 0.5*(vlonb(i)+vlonb(i+1)) + enddo + + do j = hsg, heg + hlat(j) = 0.5*(hlatb(j)+hlatb(j+1)) + enddo + + do j = vsg, veg + vlat(j) = 0.5*(vlatb(j)+vlatb(j+1)) + enddo + + ! compute a reference profile of pressure based on psurf = 1000 hPa + psurf = reshape ( (/ 100000. /), (/ 1, 1 /) ) + call compute_pres_full (Vgrid, psurf, pfull) + call compute_pres_half (Vgrid, psurf, phalf) + ! in units of hPa + pfull = pfull*0.01 + phalf = phalf*0.01 + + +!----- initialize mass axes ------ + + id_hlonb = diag_axis_init ( 'lonb', hlonb, 'degrees_E', 'x', & + 'longitude edges', set_name='atmos', & + Domain2=Hgrid%Tmp%Domain_nohalo ) + + id_hlon = diag_axis_init ( 'lon', hlon, 'degrees_E', 'x', & + 'longitude', set_name='atmos', & + edges=id_hlonb, & + Domain2=Hgrid%Tmp%Domain_nohalo ) + + id_hlatb = diag_axis_init ( 'latb', hlatb, 'degrees_N', 'y', & + 'latitude edges', set_name='atmos', & + Domain2=Hgrid%Tmp%Domain_nohalo ) + + id_hlat = diag_axis_init ( 'lat', hlat, 'degrees_N', 'y', & + 'latitude', set_name='atmos', & + edges=id_hlatb, & + Domain2=Hgrid%Tmp%Domain_nohalo ) + +!----- initialize velocity axes ------ + + id_vlonb = diag_axis_init ( 'vlonb', vlonb, 'degrees_E', 'x', & + 'longitude edges', set_name='atmos', & + Domain2=Hgrid%Vel%Domain_nohalo ) + + id_vlon = diag_axis_init ( 'vlon', vlon, 'degrees_E', 'x', & + 'longitude', set_name='atmos', & + edges=id_vlonb, & + Domain2=Hgrid%Vel%Domain_nohalo ) + + id_vlatb = diag_axis_init ( 'vlatb', vlatb, 'degrees_N', 'y', & + 'latitude edges', set_name='atmos', & + Domain2=Hgrid%Vel%Domain_nohalo ) + + id_vlat = diag_axis_init ( 'vlat', vlat, 'degrees_N', 'y', & + 'latitude', set_name='atmos', & + edges=id_vlatb, & + Domain2=Hgrid%Vel%Domain_nohalo ) + +!----- initialize vertical axes ----- + + id_phalf = diag_axis_init ( 'phalf', phalf(1,1,:), 'hPa', 'z', & + 'approx half pressure level', & + direction=-1, set_name='atmos' ) + + id_pfull = diag_axis_init ( 'pfull', pfull(1,1,:), 'hPa', 'z', & + 'approx full pressure level', & + direction=-1, edges=id_phalf, & + set_name='atmos' ) + +!----------------------------------------------------------------------- +!-------- initialize and output variables with no time axis ------------ + + mass_axes = (/ id_hlon, id_hlat, id_pfull, id_phalf /) + vel_axes = (/ id_vlon, id_vlat, id_pfull, id_phalf /) + uflx_axes = (/ id_vlon, id_hlat, id_pfull, id_phalf /) + vflx_axes = (/ id_hlon, id_vlat, id_pfull, id_phalf /) + + ! valid range for some fields + vrange = (/ -400., +400. /) ! momentum + trange = (/ 100., 400. /) ! temperature + prange = (/ -1., 107500. /) ! pressure + +!----------------------------------------------------------------------- +!---- register static fields ------- + + id_bk = register_static_field ( mod_name, 'bk', (/id_phalf/), & + 'vertical coordinate sigma value', 'none' ) + + id_pk = register_static_field ( mod_name, 'pk', (/id_phalf/), & + 'vertical coordinate reference pressure value (ak*pref)', 'pascals' ) + + id_zsurf = register_static_field ( mod_name, 'zsurf', mass_axes(1:2),& + 'surface height', 'm' ) + + id_res = register_static_field ( mod_name, 'res', mass_axes(1:2), & + 'reciprocal of sigma/eta at the surface', 'none' ) + + id_alm = register_static_field ( mod_name, 'alm', mass_axes(1:2), & + 'actual longitudes for temperature grid', 'degrees_E' ) + + id_aph = register_static_field ( mod_name, 'aph', mass_axes(1:2), & + 'actual latitudes for temperature grid', 'degrees_N' ) + +! these changes cannot be implemented until changes to diag_manager +! initialize fields useful for computing offline global averages +! +! id_hlat_wgt = register_static_field ( mod_name, 'lat_wgt', & +! (/id_hlat/), 'latitude weight for mass grid', 'none' ) +! +! id_vlat_wgt = register_static_field ( mod_name, 'vlat_wgt', & +! (/id_vlat/), 'latitude weight for momentum grid', 'none' ) + + if ( id_bk > 0 ) & + used = send_data ( id_bk, Vgrid%eta, Time ) + + if ( id_pk > 0 ) & + used = send_data ( id_pk, Vgrid%peta, Time ) + + if ( id_zsurf > 0 ) & + used = send_data ( id_zsurf, fis(is:ie,hs:he)*GINV, Time ) + + if ( id_res > 0 ) & + used = send_data ( id_res, res(is:ie,hs:he), Time ) + + if ( id_alm > 0 ) & + used = send_data ( id_alm, Hgrid%Tmp%alm(is:ie,hs:he)*rad2deg, Time ) + + if ( id_aph > 0 ) & + used = send_data ( id_aph, Hgrid%Tmp%aph(is:ie,hs:he)*rad2deg, Time ) + +! if ( id_hlat_wgt > 0 ) then +! hlat_wgt = sin(Hgrid%Tmp%blatg(hs+1:he+1))-sin(Hgrid%Tmp%blatg(hs:he)) +! used = send_data ( id_hlat_wgt, hlat_wgt, Time ) +! endif +! +! if ( id_vlat_wgt > 0 ) then +! vlat_wgt = sin(Hgrid%Vel%blatg(vs+1:ve+1))-sin(Hgrid%Vel%blatg(vs:ve)) +! used = send_data ( id_vlat_wgt, vlat_wgt, Time ) +! endif + +!---- register non-static fields ------- + + id_ps = register_diag_field ( mod_name, 'ps', mass_axes(1:2), & + Time, 'surface pressure', 'pascals' ) + + id_slp = register_diag_field ( mod_name, 'slp', mass_axes(1:2), & + Time, 'sea level pressure', 'pascals' ) + + id_ucomp = register_diag_field ( mod_name, 'ucomp', vel_axes(1:3), & + Time, 'zonal wind component', 'm/sec', & + missing_value=vrange(1), range=vrange ) + + id_vcomp = register_diag_field ( mod_name, 'vcomp', vel_axes(1:3), & + Time, 'meridional wind component', 'm/sec', & + missing_value=vrange(1), range=vrange ) + + id_temp = register_diag_field ( mod_name, 'temp', mass_axes(1:3), & + Time, 'temperature', 'deg_k', & + missing_value=trange(1), range=trange ) + + id_pres_full = register_diag_field ( mod_name, 'pres_full', mass_axes(1:3), & + Time, 'pressure at full model levels', 'pascals', & + missing_value=prange(1), range=prange ) + + ! pressure at half levels + id_pres_half = register_diag_field ( mod_name, 'pres_half', & + (/ id_hlon, id_hlat, id_phalf /), Time, & + 'pressure at half model levels', 'pascals', & + missing_value=prange(1), range=prange ) + + id_omega = register_diag_field ( mod_name, 'omega', mass_axes(1:3),& + Time, 'omega vertical velocity', & + 'pascals/sec', & + missing_value=-999. ) + + id_theta = register_diag_field ( mod_name, 'theta', mass_axes(1:3), & + Time, 'potential temperature', 'deg_k', & + missing_value=-999. ) + + id_mfew = register_diag_field ( mod_name, 'mfew', uflx_axes(1:3), & + Time, 'Zonal mass flux', 'Pa-m2/s', & + missing_value=-1.e30 ) + + id_mfns = register_diag_field ( mod_name, 'mfns', vflx_axes(1:3), & + Time, 'Meridional mass flux', 'Pa-m2/s', & + missing_value=-1.e30 ) + + ! write version (to log file) + call write_version_number (version,tag) + + ! register diagnostics for all tracers + allocate (id_tracer(Var%ntrace)) + if (mpp_pe() == mpp_root_pe()) write(logunit,100) trim(mod_name) + do n = 1, Var%ntrace + call get_tracer_names ( MODEL_ATMOS, n, tname, longname, units ) + if (mpp_pe() == mpp_root_pe()) write(logunit,110) trim(tname),trim(longname),trim(units) + id_tracer(n) = register_diag_field ( mod_name, trim(tname), & + mass_axes(1:3), Time, trim(longname), & + trim(units), missing_value=-999. ) + enddo +100 format ('Diagnostics for the following tracer fields are available for module name = ',a) +110 format (3x,a,' (',a,'; ',a,')') + +!-------- register second-moment quantities ------- +! (for now we are only saving fields on the same grids) + + id_ucomp_sq = register_diag_field ( mod_name, 'ucomp_sq', vel_axes(1:3), & + Time, 'zonal wind component squared', 'm2/s2', & + missing_value=-1., range=(/0.,vrange(2)**2/) ) + + id_vcomp_sq = register_diag_field ( mod_name, 'vcomp_sq', vel_axes(1:3), & + Time, 'meridional wind component squared', 'm2/s2', & + missing_value=-1., range=(/0.,vrange(2)**2/) ) + + id_temp_sq = register_diag_field ( mod_name, 'temp_sq', mass_axes(1:3), & + Time, 'temperature squared', 'deg_K**2', & + missing_value=-1., range=(/0.,trange(2)**2/) ) + + id_omega_sq = register_diag_field ( mod_name, 'omega_sq', mass_axes(1:3),& + Time, 'omega vertical velocity squared', & + 'Pa**2/s**2', missing_value=-999. ) + + id_ucomp_vcomp = register_diag_field ( mod_name, 'ucomp_vcomp', vel_axes(1:3),& + Time, 'zonal times meridional wind components', 'm2/s2', & + missing_value=-1. ) + + id_omega_temp = register_diag_field ( mod_name, 'omega_temp', mass_axes(1:3),& + Time, 'omega vertical velocity time temperature',& + 'Pascals*deg_K/sec', missing_value=-999. ) + +!-------- wind speed, divergence, vorticity ---------------------------- + + id_wspd = register_diag_field ( mod_name, 'wspd', vel_axes(1:3), & + Time, 'wind speed', 'm/s', missing_value=-999.,& + range=(/0.,vrange(2)/) ) + + id_div = register_diag_field ( mod_name, 'div', mass_axes(1:3), & + Time, 'divergence', '1/s', missing_value=-999. ) + + id_vor = register_diag_field ( mod_name, 'vor', mass_axes(1:3), & + Time, 'relative vorticity', '1/s', missing_value=-999. ) + +!--------- pressure gradient components (NOT USED) --------------------- + +! id_pgfx = register_diag_field ( mod_name, 'pgfx', vel_axes(1:3), & +! Time, 'zonal pressure gradient force', & +! 'm/s2', missing_value=-999. ) + +! id_pgfy = register_diag_field ( mod_name, 'pgfy', vel_axes(1:3), & +! Time, 'meridional pressure gradient force', & +! 'm/s2', missing_value=-999. ) + +!----------------------------------------------------------------------- +! -------- tendencies --------- + + id_udt = register_diag_field ( mod_name, 'udt_dyn', vel_axes(1:3), & + Time, 'zonal wind tendency for dynamics', & + 'm/s2', missing_value=-999. ) + + id_vdt = register_diag_field ( mod_name, 'vdt_dyn', vel_axes(1:3), & + Time, 'meridional wind tendency for dynamics', & + 'm/s2', missing_value=-999. ) + + id_tdt = register_diag_field ( mod_name, 'tdt_dyn', mass_axes(1:3), & + Time, 'temperature tendency for dynamics', & + 'deg_k/sec', missing_value=-999. ) + + ! tendencies for prognostic tracers only + call get_number_tracers ( MODEL_ATMOS, num_prog=ntprog ) + allocate (id_tracer_tend(ntprog)) + do n = 1, ntprog + call get_tracer_names ( MODEL_ATMOS, n, tname, longname, units ) + tname = trim(tname) //'_dt_dyn' + longname = trim(longname)//' tendency for dynamics' + units = trim(units) //'/s' + if (units == 'none') units = '1/sec' + if (mpp_pe() == mpp_root_pe()) write(logunit,110) trim(tname),trim(longname),trim(units) + id_tracer_tend(n) = register_diag_field ( mod_name, trim(tname), & + mass_axes(1:3), Time, trim(longname), & + trim(units), missing_value=-999. ) + enddo + + ! save surface geopotential height for computing sea level pressure + zsurfg => fis + +!----------------------------------------------------------------------- + + end subroutine bgrid_diagnostics_init + +!####################################################################### + + subroutine bgrid_diagnostics ( Hgrid, Vgrid, Var, Masks, Time, & + omega, div, mfew, mfns ) + +!----------------------------------------------------------------------- +! write netcdf fields +!----------------------------------------------------------------------- +! Hgrid = horizontal grid constants +! Vgrid = vertical grid constants +! Var = prognostic variables at diagnostics Time +! Masks = grid box masks for step-mountain topography +! Time = diagnostics time +! omega = omega (vertical velocity) diagnostic +!----------------------------------------------------------------------- +type(horiz_grid_type), intent(in) :: Hgrid +type (vert_grid_type), intent(in) :: Vgrid +type (prog_var_type), intent(in) :: Var +type(grid_mask_type), intent(in) :: Masks +type(time_type), intent(in) :: Time + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: & + omega, div, mfew, mfns + +! real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:), optional ::& +! div, pgfx, pgfy + + real, dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub) :: slp + real, dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub, & + Vgrid%nlev) :: wspd, vor, dp, udp, vdp + real, dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub, & + Vgrid%nlev+1) :: ph +logical, dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub, & + Vgrid%nlev+1) :: lmask +!----------------------------------------------------------------------- + integer :: is, ie, hs, he, vs, ve, n, j, k + logical :: used +!----------------------------------------------------------------------- + + is = Hgrid % Tmp % is; ie = Hgrid % Tmp % ie + hs = Hgrid % Tmp % js; he = Hgrid % Tmp % je + vs = Hgrid % Vel % js; ve = Hgrid % Vel % je + +!----------------------------------------------------------------------- +!---------------- surface fields --------------------------------------- + + if ( id_ps > 0 ) & + used = send_data ( id_ps , Var%ps(is:ie,hs:he), Time ) + +!---------------- 3d momentum fields (u & v) --------------------------- + + if ( id_ucomp > 0 ) & + used = send_data ( id_ucomp, Var%u(is:ie,vs:ve,:), Time, & + mask=Masks%Vel%mask(is:ie,vs:ve,:) > 0.5 ) + + if ( id_vcomp > 0 ) & + used = send_data ( id_vcomp, Var%v(is:ie,vs:ve,:), Time, & + mask=Masks%Vel%mask(is:ie,vs:ve,:) > 0.5 ) + + if ( id_temp > 0 ) & + used = send_data ( id_temp, Var%t(is:ie,hs:he,:), Time, & + mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 ) + + do n = 1, Var%ntrace + if ( id_tracer(n) > 0 ) & + used = send_data ( id_tracer(n), Var%r(is:ie,hs:he,:,n), Time, & + mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 ) + enddo + + if ( id_omega > 0 ) & + used = send_data ( id_omega, omega(is:ie,hs:he,:), Time, & + mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 ) + + ! pressure at full levels + ! Note: not computational efficient to recompute pfull + if ( id_pres_full > 0 ) then + call compute_pres_full (Vgrid, Var%pssl, dp) + used = send_data ( id_pres_full, dp(is:ie,hs:he,:), Time, & + mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 ) + endif + + ! pressure at half (interface) levels + ! Note: not computational efficient to recompute phalf + if ( id_pres_half > 0 ) then + call compute_pres_half (Vgrid, Var%pssl, ph) + lmask(is:ie,hs:he,1) = .true. + lmask(is:ie,hs:he,2:Vgrid%nlev+1) = Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 + used = send_data ( id_pres_half, ph(is:ie,hs:he,:), Time, & + mask=lmask(is:ie,hs:he,:) ) + endif + + !--- sea level pressure --- + if ( id_slp > 0 ) then + if ( id_pres_full <= 0 ) call compute_pres_full (Vgrid, Var%pssl, dp) + call sea_level_pressure ( Var%ps, zsurfg, dp, Var%t, slp ) + used = send_data ( id_slp, slp(is:ie,hs:he), Time ) + endif + + ! potential temperature (compute pfull if necessary) + if ( id_theta > 0 ) then + if ( id_pres_full <= 0 .and. id_slp <= 0 ) call compute_pres_full (Vgrid, Var%pssl, dp) + dp = Var%t * (1000.e2/dp)**KAPPA + used = send_data ( id_theta, dp(is:ie,hs:he,:), Time, & + mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 ) + endif + +!--------- second moment quantities ---------- + + if ( id_ucomp_sq > 0 ) & + used = send_data ( id_ucomp_sq, Var%u(is:ie,vs:ve,:)**2, Time, & + mask=Masks%Vel%mask(is:ie,vs:ve,:) > 0.5 ) + + if ( id_vcomp_sq > 0 ) & + used = send_data ( id_vcomp_sq, Var%v(is:ie,vs:ve,:)**2, Time, & + mask=Masks%Vel%mask(is:ie,vs:ve,:) > 0.5 ) + + if ( id_temp_sq > 0 ) & + used = send_data ( id_temp_sq, Var%t(is:ie,hs:he,:)**2, Time, & + mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 ) + + if ( id_omega_sq > 0 ) & + used = send_data ( id_omega_sq, omega(is:ie,hs:he,:)**2, Time, & + mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 ) + + if ( id_ucomp_vcomp > 0 ) used = send_data ( id_ucomp_vcomp, & + Var%u(is:ie,vs:ve,:)*Var%v(is:ie,vs:ve,:), Time, & + mask=Masks%Vel%mask(is:ie,vs:ve,:) > 0.5 ) + + if ( id_omega_temp > 0 ) used = send_data ( id_omega_temp, & + omega(is:ie,hs:he,:)*Var%t(is:ie,hs:he,:), Time, & + mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 ) + +!------------ wind speed, divergence, vorticity ------------------------ + + if ( id_wspd > 0 ) then + wspd(is:ie,vs:ve,:) = sqrt & + ( Var%u(is:ie,vs:ve,:)*Var%u(is:ie,vs:ve,:) + & + Var%v(is:ie,vs:ve,:)*Var%v(is:ie,vs:ve,:) ) + used = send_data ( id_wspd, wspd(is:ie,vs:ve,:), Time, & + mask=Masks%Vel%mask(is:ie,vs:ve,:) > 0.5 ) + endif + + if ( id_div > 0 ) then + used = send_data ( id_div, div(is:ie,hs:he,:), Time, & + mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 ) + endif + + if ( id_vor > 0 ) then + !if ( id_vor > 0 .or. id_div > 0 ) then + !--- precompute quantities common to both vor and div --- + call compute_pres_depth (Vgrid, Var%pssl, dp) + call change_grid (Hgrid, TEMP_GRID, WIND_GRID, dp, udp) + vdp = Var%v * udp ! note: using udp to store dp at vel pts + udp = Var%u * udp + !if ( id_vor > 0 ) then + call compute_vorticity (Hgrid, dp, udp, vdp, vor ) + used = send_data ( id_vor, vor(is:ie,hs:he,:), Time, & + mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 ) + !endif + !if ( id_div > 0 ) then + ! call compute_divergence (Hgrid, dp, udp, vdp, div ) + ! used = send_data ( id_div, div(is:ie,hs:he,:), Time, & + ! mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 ) + !endif + endif + +!------- mass fluxes (without topography masks) ----------- + if ( id_mfew > 0 ) then + used = send_data ( id_mfew, mfew(is:ie,hs:he,:), Time ) + endif + if ( id_mfns > 0 ) then + used = send_data ( id_mfns, mfns(is:ie,vs:ve,:), Time ) + endif + +!--------------- pressure gradient components -------------------------- +!------------------------ NOT USED ------------------------------------- + +! if ( id_pgfx > 0 .and. present(pgfx) ) & +! used = send_data ( id_pgfx, pgfx(is:ie,vs:ve,:), Time, & +! mask=Masks%Vel%mask(is:ie,vs:ve,:) > 0.5 ) + +! if ( id_pgfy > 0 .and. present(pgfy) ) & +! used = send_data ( id_pgfy, pgfy(is:ie,vs:ve,:), Time, & +! mask=Masks%Vel%mask(is:ie,vs:ve,:) > 0.5 ) + +!----------------------------------------------------------------------- + + end subroutine bgrid_diagnostics + +!####################################################################### + + subroutine bgrid_diagnostics_tend ( Hgrid, Var_dt, Masks, Time ) + +!----------------------------------------------------------------------- +! Hgrid = horizontal grid constants +! Var_dt = prognostic variables tendencies FROM ONLY THE DYNAMICS +! Masks = grid box masks for step-mountain topography +! Time = diagnostics time +!----------------------------------------------------------------------- +type(horiz_grid_type), intent(in) :: Hgrid +type (prog_var_type), intent(in) :: Var_dt +type(grid_mask_type), intent(in) :: Masks +type(time_type), intent(in) :: Time +!----------------------------------------------------------------------- + integer :: is, ie, hs, he, vs, ve, n + logical :: used +!----------------------------------------------------------------------- + + ! compute domain indices + is = Hgrid % Tmp % is; ie = Hgrid % Tmp % ie + hs = Hgrid % Tmp % js; he = Hgrid % Tmp % je + vs = Hgrid % Vel % js; ve = Hgrid % Vel % je + +!----------------------------------------------------------------------- +!---------------- 3d prognostic fields --------------------------- + + if ( id_udt > 0 ) & + used = send_data ( id_udt, Var_dt%u(is:ie,vs:ve,:), Time, & + mask=Masks%Vel%mask(is:ie,vs:ve,:) > 0.5 ) + + if ( id_vdt > 0 ) & + used = send_data ( id_vdt, Var_dt%v(is:ie,vs:ve,:), Time, & + mask=Masks%Vel%mask(is:ie,vs:ve,:) > 0.5 ) + + if ( id_tdt > 0 ) & + used = send_data ( id_tdt, Var_dt%t(is:ie,hs:he,:), Time, & + mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 ) + + do n = 1, Var_dt%ntrace + if ( id_tracer_tend(n) > 0 ) & + used = send_data ( id_tracer_tend(n), Var_dt%r(is:ie,hs:he,:,n), & + Time, mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 ) + enddo + +!----------------------------------------------------------------------- + + end subroutine bgrid_diagnostics_tend + +!####################################################################### + + subroutine compute_vorticity ( Hgrid, dp, udp, vdp, vor ) + +!----------------------------------------------------------------------- +! Computes relative vorticity on B-grid +! Hgrid = horizontal grid constants +! dp = pressure thickness of model layers at temperature points +! udp = zonal wind, u * dp, at velocity points +! vdp = meridional wind, v * dp, at velocity points +! vor = relative vorticity (1/s) at temperature points +!----------------------------------------------------------------------- +type(horiz_grid_type), intent(in) :: Hgrid +real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: dp, udp, vdp +real, intent(out), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: vor + +real,dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub) :: & + vdy, udx, few, fns +integer :: i, j, k, is, ie, js, je + + is = Hgrid % Tmp % is; ie = Hgrid % Tmp % ie + js = Hgrid % Tmp % js; je = Hgrid % Tmp % je + + do k = 1, size(dp,3) + do j = js-1, je + vdy(:,j) = vdp(:,j,k)*Hgrid%Vel%dy + udx(:,j) = udp(:,j,k)*Hgrid%Vel%dx(j) + enddo + + do j = js, je + do i = is-1, ie + fns(i,j) = (vdy(i,j-1)+vdy(i,j))*0.5 + enddo + enddo + do j = js-1, je + do i = is, ie + few(i,j) = (udx(i-1,j)+udx(i,j))*0.5 + enddo + enddo + +! ------ vorticity ------ + do j = js, je + do i = is, ie + vor(i,j,k)=((fns(i,j)-fns(i-1,j))-(few(i,j)-few(i,j-1))) & + /(dp(i,j,k)*Hgrid%Tmp%area(j)) + enddo + enddo + enddo + + end subroutine compute_vorticity + +!####################################################################### + + subroutine compute_divergence ( Hgrid, dp, udp, vdp, div ) + +!----------------------------------------------------------------------- +! Computes divergence on B-grid +! Hgrid = horizontal grid constants +! dp = pressure thickness of model layers at temperature points +! udp = zonal wind, u * dp, at velocity points +! vdp = meridional wind, v * dp, at velocity points +! div = divergence (1/s) at temperature points +!----------------------------------------------------------------------- +type(horiz_grid_type), intent(in) :: Hgrid +real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: dp, udp, vdp +real, intent(out), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: div + +real,dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub) :: & + udy, vdx, few, fns +integer :: i, j, k, is, ie, js, je + + is = Hgrid % Tmp % is; ie = Hgrid % Tmp % ie + js = Hgrid % Tmp % js; je = Hgrid % Tmp % je + + do k = 1, size(dp,3) + do j = js-1, je + udy(:,j) = udp(:,j,k)*Hgrid%Vel%dy + vdx(:,j) = vdp(:,j,k)*Hgrid%Vel%dx(j) + enddo + + do j = js, je + do i = is-1, ie + few(i,j) = (udy(i,j-1)+udy(i,j))*0.5 + enddo + enddo + do j = js-1, je + do i = is, ie + fns(i,j) = (vdx(i-1,j)+vdx(i,j))*0.5 + enddo + enddo + +! ------ divergence ------ + do j = js, je + do i = is, ie + div(i,j,k)=((few(i,j)+fns(i,j))-(few(i-1,j)+fns(i,j-1))) & + /(dp(i,j,k)*Hgrid%Tmp%area(j)) + enddo + enddo + enddo + + end subroutine compute_divergence + +!####################################################################### + + subroutine sea_level_pressure ( psurf, zsurf, pfull, tfull, slp ) + + real, intent(in), dimension(:,:) :: psurf, zsurf + real, intent(in), dimension(:,:,:) :: pfull, tfull + real, intent(out), dimension(:,:) :: slp + +! psurf = surface pressure +! zsurf = surface geopotential height in meters^2/sec^2 +! pfull = pressure at full model levels +! tfull = temperature at full model levels +! slp = sea level pressure in pascals + + integer :: i, j, k, kr + real :: sig, tbot + + real, parameter :: TLAPSE = 6.5e-3 + real, parameter :: GORG = GRAV/(RDGAS*TLAPSE) + real, parameter :: MRGOG = -1./GORG + + do j = 1, size(psurf,2) + do i = 1, size(psurf,1) + + if ( abs(zsurf(i,j)) > 0.0001 ) then + + !---- get ref level for temp ---- + do k = 1, size(tfull,3) + sig = pfull(i,j,k)/psurf(i,j) + if ( sig > 0.8 ) then + kr = k + exit + endif + enddo + + tbot = tfull(i,j,kr) * sig ** MRGOG + slp(i,j) = psurf(i,j) * ( 1.0 + TLAPSE * zsurf(i,j) / (tbot*GRAV) ) ** GORG + else + slp(i,j) = psurf(i,j) + endif + enddo + enddo + + end subroutine sea_level_pressure + +!####################################################################### + +end module bgrid_diagnostics_mod + diff --git a/MOM_code/src/atmos_bgrid/tools/bgrid_halo.F90 b/MOM_code/src/atmos_bgrid/tools/bgrid_halo.F90 new file mode 100644 index 0000000..49b2cdd --- /dev/null +++ b/MOM_code/src/atmos_bgrid/tools/bgrid_halo.F90 @@ -0,0 +1,450 @@ + +module bgrid_halo_mod + +use bgrid_horiz_mod, only: horiz_grid_type, update_np, update_sp, & + TGRID, VGRID +use fms_mod, only: error_mesg, FATAL, mpp_clock_id, & + mpp_clock_begin, mpp_clock_end, & + MPP_CLOCK_SYNC, CLOCK_ROUTINE +use mpp_domains_mod, only: mpp_update_domains, SUPDATE, NUPDATE, & + WUPDATE, EUPDATE + +implicit none +private + + +!------------ public interfaces ------------ + +public :: update_halo, vel_flux_boundary + +interface update_halo + module procedure update_halo_2d, update_halo_3d, update_halo_4d +end interface + +interface vel_flux_boundary + module procedure vel_flux_boundary_2d, vel_flux_boundary_3d +end interface + +!-------- public parameters ---------- + +! possible values for field argument +integer, parameter, public :: TEMP = 21, UWND = 22, VWND = 23, WIND = 24 + +! possible values for optional halo argument +integer, parameter, public :: SOUTH = 1, NORTH = 2 +integer, parameter, public :: WEST = 4, EAST = 8 +integer, parameter, private :: ALL = SOUTH+NORTH+WEST+EAST ! default + +! possible values for optional flags argument +integer, parameter, public :: NOPOLE = 1 +integer, parameter, public :: POLEONLY = 2 + +!--------------------------------------------------------------- +! private timing variables + + integer :: id_update3 + logical :: do_clock_init = .true. + +! private module variables (used across module subroutines) + + integer :: domain_flags + logical :: update_sbnd, update_nbnd, update_wbnd, update_ebnd, & + no_pole_vel, do_pole_only + logical :: do_channel + +contains + +!####################################################################### + + subroutine update_halo_3d (Hgrid, field, data, halos, flags) + +!---------------------------------------------------------- +! Halo update for 3-dimensional fields +!---------------------------------------------------------- +! Hgrid = horizontal grid constants +! field = integer identifier for field +! possible values: TEMP, UWND, VWND +! data = 3-D data +! halos = identifies which halos should be updated (optional) +! possible values: NORTH, EAST, WEST, SOUTH +! default(all): NORTH+EAST+WEST+SOUTH +! flags = options for handling the pole +! possible values: NOPOLE, POLEONLY +!---------------------------------------------------------- + + type(horiz_grid_type), intent(inout) :: Hgrid + integer, intent(in) :: field + real, intent(inout) :: data(Hgrid%ilb:,Hgrid%jlb:,:) + integer, optional, intent(in) :: halos, flags + + integer :: is, ie, iflags, halosize, xygrid + + if (do_clock_init) call clock_init + call mpp_clock_begin (id_update3) + +! ----- check dimensions ------ + + if (size(data,2) /= Hgrid % jsize) call error_mesg & + ('update_halo in bgrid_halo_mod', & + 'j dimension has wrong size', FATAL) + + if (size(data,1) /= Hgrid % isize) call error_mesg & + ('update_halo in bgrid_halo_mod', & + 'i dimension has wrong size', FATAL) + +! ----- check/set optional flag arguments ---- + + call set_domain_flags ( Hgrid, halos, flags ) + +! ------ need to determine and check grid ------- + + select case (field) + case (TEMP) + is = Hgrid % Tmp % is; ie = Hgrid % Tmp % ie; xygrid = TGRID + ! update non-polar boundaries + if (.not.do_pole_only) call mpp_update_domains (data, Hgrid%Tmp%Domain, domain_flags) + case (UWND:VWND) + is = Hgrid % Vel % is; ie = Hgrid % Vel % ie; xygrid = VGRID + ! update non-polar boundaries + if (.not.do_pole_only) call mpp_update_domains (data, Hgrid%Tmp%Domain, domain_flags) + case default + call error_mesg ('update_halo in bgrid_halo_mod', & + 'invalid field', FATAL) + end select + +! ----- update east-west cyclic boundaries (for 1-d decomp only) ---- + + halosize = 1 + if (update_wbnd) data(is-halosize:is-1,:,:) = data(ie-halosize+1:ie,:,:) + if (update_ebnd) data(ie+1:ie+halosize,:,:) = data(is:is+halosize-1,:,:) + +! ------ update south pole ------ + + if ( (update_sbnd.or.do_pole_only) .and. update_sp (Hgrid,xygrid) ) then + call south_boundary_3d (Hgrid, field, data(:,:,:), no_pole_vel) + endif + +! ------ update north pole ------ + + if ( (update_nbnd.or.do_pole_only) .and. update_np (Hgrid,xygrid) ) then + call north_boundary_3d (Hgrid, field, data(:,:,:), no_pole_vel) + endif + + call mpp_clock_end (id_update3) + + end subroutine update_halo_3d + +!####################################################################### + + subroutine update_halo_4d (Hgrid, field, data, halos, flags) + +!---------------------------------------------------------- +! Halo update for 4-dimensional fields +!---------------------------------------------------------- +! Hgrid = horizontal grid constants +! field = integer identifier for field +! possible values: TEMP, UWND, VWND, WIND +! note: if field=WIND, then 4th dim of data must be 2 +! data = 4-D data +! halos = identifies which halos should be updated (optional) +! possible values: NORTH, EAST, WEST, SOUTH +! default(all): NORTH+EAST+WEST+SOUTH +! flags = options for handling the pole +! possible values: NOPOLE, POLEONLY +!---------------------------------------------------------- + + type(horiz_grid_type), intent(inout) :: Hgrid + integer, intent(in) :: field + real, intent(inout) :: data(Hgrid%ilb:,Hgrid%jlb:,:,:) + integer, optional, intent(in) :: halos, flags + + integer :: is, ie, iflags, n, halosize, xygrid + + if (do_clock_init) call clock_init + call mpp_clock_begin (id_update3) + +! ----- check dimensions ------ + + if (size(data,2) /= Hgrid % jsize) call error_mesg & + ('update_halo in bgrid_halo_mod', & + 'j dimension has wrong size', FATAL) + + if (size(data,1) /= Hgrid % isize) call error_mesg & + ('update_halo in bgrid_halo_mod', & + 'i dimension has wrong size', FATAL) + + if (field == WIND .and. size(data,4) /= 2) call error_mesg & + ('update_halo in bgrid_halo_mod', & + '4th dimension must have size 2 for wind components', FATAL) + +! ----- check/set optional flag arguments ---- + + call set_domain_flags ( Hgrid, halos, flags ) + +! ------ need to determine and check grid ------- + + select case (field) + case (TEMP) + is = Hgrid % Tmp % is; ie = Hgrid % Tmp % ie; xygrid = TGRID + ! update non-polar boundaries + if (.not.do_pole_only) call mpp_update_domains (data, Hgrid%Tmp%Domain, domain_flags) + case (UWND:WIND) + is = Hgrid % Vel % is; ie = Hgrid % Vel % ie; xygrid = VGRID + ! update non-polar boundaries + if (.not.do_pole_only) call mpp_update_domains (data, Hgrid%Tmp%Domain, domain_flags) + case default + call error_mesg ('update_halo in bgrid_halo_mod', & + 'invalid field', FATAL) + end select + +! ----- update east-west cyclic boundaries (for 1-d decomp only) ---- + + halosize = 1 + if (update_wbnd) data(is-halosize:is-1,:,:,:) = data(ie-halosize+1:ie,:,:,:) + if (update_ebnd) data(ie+1:ie+halosize,:,:,:) = data(is:is+halosize-1,:,:,:) + +! ------ update south pole ------ + + do_channel = Hgrid%channel + + if ( (update_sbnd.or.do_pole_only) .and. update_sp (Hgrid,xygrid) ) then + if (field == WIND) then + call south_boundary_3d (Hgrid, UWND, data(:,:,:,1), no_pole_vel) + call south_boundary_3d (Hgrid, VWND, data(:,:,:,2), no_pole_vel) + else + do n = 1, size(data,4) + call south_boundary_3d (Hgrid, field, data(:,:,:,n), no_pole_vel) + enddo + endif + endif + +! ------ update north pole ------ + + if ( (update_nbnd.or.do_pole_only) .and. update_np (Hgrid,xygrid) ) then + if (field == WIND) then + call north_boundary_3d (Hgrid, UWND, data(:,:,:,1), no_pole_vel) + call north_boundary_3d (Hgrid, VWND, data(:,:,:,2), no_pole_vel) + else + do n = 1, size(data,4) + call north_boundary_3d (Hgrid, field, data(:,:,:,n), no_pole_vel) + enddo + endif + endif + + call mpp_clock_end (id_update3) + + end subroutine update_halo_4d + +!####################################################################### +! updates halos at (and beyond) the north pole + + subroutine north_boundary_3d (Hgrid, field, data, nopole) + + type(horiz_grid_type), intent(in) :: Hgrid + integer, intent(in) :: field + real, intent(inout) :: data(:,Hgrid%jlb:,:) + logical, intent(in) :: nopole + + integer :: js, je, jeg, halo + + halo = 1 ! assumed halo size = 1 + +! --- update north pole boundary --- + + select case (field) + case (TEMP) +! ---- mass ---- + js = Hgrid % Tmp % js; je = Hgrid % Tmp % je + data (:, je+1:je+halo, :) = data (:, je:je-halo+1:-1, :) + case (UWND) +! ---- u comp ---- + js = Hgrid % Vel % js; je = Hgrid % Vel % je; jeg = Hgrid % Vel % jeg + if (.not. nopole) then + if (.not.do_channel) then + if ( jeg+1 <= je+halo ) data (:, jeg+1,:) = 0.0 + else + if ( jeg+1 <= je+halo ) data (:, jeg+1,:) = data (:, jeg,:) + endif + endif + if ( jeg+2 <= je+halo ) & + data (:, jeg+2:jeg+halo, :) = data (:, je:je-halo+2:-1, :) + case (VWND) +! ---- v comp ---- + js = Hgrid % Vel % js; je = Hgrid % Vel % je; jeg = Hgrid % Vel % jeg + if (.not. nopole) then + if ( jeg+1 <= je+halo ) data (:, jeg+1, :) = 0.0 + endif + if ( jeg+2 <= je+halo ) & + data (:, jeg+2:jeg+halo, :) = - data (:, je:je-halo+2:-1, :) + end select + + end subroutine north_boundary_3d + +!####################################################################### +! updates halos at (and beyond) the south pole + + subroutine south_boundary_3d (Hgrid, field, data, nopole) + + type(horiz_grid_type), intent(in) :: Hgrid + integer, intent(in) :: field + real, intent(inout) :: data(:,Hgrid%jlb:,:) + logical, intent(in) :: nopole + + + integer :: js, je, halo + + halo = 1 ! assumed halo size = 1 + +! --- update south pole boundary --- + + select case (field) + case (TEMP) +! ---- mass ---- + js = Hgrid % Tmp % js; je = Hgrid % Tmp % je + data (:, js-1:js-halo:-1, :) = data (:, js:js+halo-1, :) + case (UWND) +! ---- u comp ---- + js = Hgrid % Vel % js; je = Hgrid % Vel % je + if (.not. nopole) then + if (.not.do_channel) then + data (:, js-1, :) = 0.0 + else + data (:, js-1, :) = data (:, js, :) + endif + endif + data (:, js-2:js-halo:-1, :) = data (:, js:js+halo-2, :) + case (VWND) +! ---- v comp ---- + js = Hgrid % Vel % js; je = Hgrid % Vel % je + if (.not. nopole) data (:, js-1, :) = 0.0 + data (:, js-2:js-halo:-1, :) = - data (:, js:js+halo-2, :) + end select + + end subroutine south_boundary_3d + +!####################################################################### + + subroutine vel_flux_boundary_3d (Hgrid, data) + +! zero-out the flux between pole and first velocity row +! do this on both sides of the ppole +! meridional indexing coincides with mass grid +! assumed halo size is one + +! Hgrid = horizontal grid constants +! data = 3-D data + + type(horiz_grid_type), intent(in) :: Hgrid + real, intent(inout) :: data(:,Hgrid%jlb:,:) + + if ( update_sp (Hgrid,TGRID) ) then + data (:, Hgrid%Tmp%js-1, :) = 0.0 + data (:, Hgrid%Tmp%js , :) = 0.0 + endif + + if ( update_np (Hgrid,TGRID) ) then + data (:, Hgrid%Tmp%je , :) = 0.0 + data (:, Hgrid%Tmp%je+1, :) = 0.0 + endif + + end subroutine vel_flux_boundary_3d + +!####################################################################### +! overload interfaces +!####################################################################### + + subroutine update_halo_2d (Hgrid, field, data, halos, flags) + + type(horiz_grid_type), intent(inout) :: Hgrid + integer, intent(in) :: field + real, intent(inout) :: data(:,:) + integer, optional, intent(in) :: halos, flags + + real, dimension(size(data,1),size(data,2),1) :: data3 + + data3(:,:,1) = data + call update_halo_3d (Hgrid, field, data3, halos, flags) + data = data3(:,:,1) + + end subroutine update_halo_2d + +!####################################################################### + + subroutine vel_flux_boundary_2d (Hgrid, data) + + type(horiz_grid_type), intent(in) :: Hgrid + real, intent(inout) :: data(:,Hgrid%jlb:) + + real, dimension(size(data,1),size(data,2),1) :: data3 + + data3(:,:,1) = data + call vel_flux_boundary_3d (Hgrid, data3) + data = data3(:,:,1) + + end subroutine vel_flux_boundary_2d + +!####################################################################### +! private interfaces +!####################################################################### + + subroutine set_domain_flags ( Hgrid, halos, flags ) + type(horiz_grid_type), intent(in) :: Hgrid + integer, optional, intent(in) :: halos, flags + integer :: ihalos, iflags + +! sets module variables -- domain_flags, +! update_sbnd, update_nbnd, +! update_wbnd, update_ebnd, +! no_pole_vel, do_pole_only + + ihalos = ALL; if (present(halos)) ihalos = halos + iflags = 0; if (present(flags)) iflags = flags + + domain_flags = 0 + + ! south and north boundary + update_sbnd = btest(ihalos,0) + update_nbnd = btest(ihalos,1) + if ( update_sbnd ) domain_flags = domain_flags + SUPDATE + if ( update_nbnd ) domain_flags = domain_flags + NUPDATE + ! turn off polar update if domain is periodic in y + !if (Hgrid%Vel%jeg == Hgrid%Tmp%jeg) then + if (Hgrid%double_periodic) then + update_sbnd = .false. + update_nbnd = .false. + endif + ! west and east boundary + update_wbnd = btest(ihalos,2) + update_ebnd = btest(ihalos,3) + if (Hgrid%decompx) then + if ( update_wbnd ) domain_flags = domain_flags + WUPDATE + if ( update_ebnd ) domain_flags = domain_flags + EUPDATE + update_wbnd = .false. ! turn off ? + update_ebnd = .false. + endif + + ! set additional flags related to polar boundary + no_pole_vel = btest(iflags,0) !4) + do_pole_only = btest(iflags,1) !5) + + ! might update south or north poles ? + ! if (do_pole_only) then + ! update_sbnd = .true. + ! update_nbnd = .true. + ! endif + + end subroutine set_domain_flags + +!####################################################################### +! initializes mpp performance clock for bgrid halo updates + + subroutine clock_init + id_update3 = mpp_clock_id ('BGRID: update_halo', & + flags=MPP_CLOCK_SYNC, grain=CLOCK_ROUTINE) + do_clock_init = .false. + end subroutine clock_init + +!####################################################################### + +end module bgrid_halo_mod + diff --git a/MOM_code/src/atmos_bgrid/tools/bgrid_horiz.F90 b/MOM_code/src/atmos_bgrid/tools/bgrid_horiz.F90 new file mode 100644 index 0000000..4d158bf --- /dev/null +++ b/MOM_code/src/atmos_bgrid/tools/bgrid_horiz.F90 @@ -0,0 +1,956 @@ + +module bgrid_horiz_mod + +!----------------------------------------------------------------------- +! +! allocates memory and initializes grid constants +! for the FMS B-grid dynamical core +! +!----------------------------------------------------------------------- + +use mpp_domains_mod, only: mpp_domains_init, & + mpp_define_domains, & + domain1D, domain2D, & + mpp_get_global_domain, & + mpp_get_data_domain, & + mpp_get_compute_domain, & + mpp_get_compute_domains, & + mpp_get_domain_components, & + mpp_get_pelist, & + mpp_define_layout, & + mpp_get_layout, & + CYCLIC_GLOBAL_DOMAIN, & + mpp_global_sum, & + BITWISE_EXACT_SUM + +use constants_mod, only: RADIUS +use fms_mod, only: error_mesg, FATAL, NOTE, & + mpp_pe, mpp_root_pe, mpp_npes, & + write_version_number, stdlog + +implicit none +private + +!----------------------------------------------------------------------- +!------- public interfaces ------- + +public horiz_grid_init, & + get_horiz_grid_bound, & + get_horiz_grid_size, & + update_np, update_sp, & + TGRID, VGRID + +!----------------------------------------------------------------------- +! public derived data types +!----------------------------------------------------------------------- + +public bgrid_type +public bgrid_interp_type +public horiz_grid_type + +!----------------------------------------------------------------------- +! +! NOTE: all horizontal indexing references global indices +! ( 1:nlon, 1:nlat ) + +type bgrid_type + integer :: is, ie, js, je ! compute domain indices + integer :: isd, ied, jsd, jed ! data domain indices + integer :: isg, ieg, jsg, jeg ! global domain indices + real, pointer, dimension(:) :: blong=>NULL(), blatg=>NULL() ! global grid edges + real, pointer, dimension(:) :: dx=>NULL(), rdx=>NULL(), & + area=>NULL(), rarea=>NULL(), & + tph=>NULL(), tlm=>NULL() + real, pointer, dimension(:,:) :: aph=>NULL(), alm=>NULL() + real :: dy, rdy + real :: areasum + type(domain2D) :: Domain, Domain_nohalo +end type + +! is = starting x-axis index for the compute domain +! ie = ending x-axis index for the compute domain +! js = starting y-axis index for the compute domain +! je = ending y-axis index for the compute domain +! isd = starting x-axis index for the data domain +! ied = ending x-axis index for the data domain +! jsd = starting y-axis index for the data domain +! jed = ending y-axis index for the data domain +! isg = starting x-axis index for the global domain +! ieg = ending x-axis index for the global domain +! jsg = starting y-axis index for the global domain +! jeg = ending y-axis index for the global domain +! +! dx = grid spacing for x-axis (in meters) +! rdx = reciprocal of dx (1/m) +! dy = grid spacing for y-axis (in meters) +! rdy = reciprocal of dy (1/m) +! area = area of a grid box (in m2) +! rarea = reciprocal of area (1/m2) +! areasum = bit-reproducible global sum of area +! +! tph = latitude at the center of grid box (in radians) +! tlm = longitude at the center of grid box (in radians) +! aph = actual latitude at the center of grid box (in radians) +! alm = actual longitude at the center of grid box (in radians) +! +! blong = longitude grid box boundaries along the global x/longitude axis (in radians) +! blatg = latitude grid box boundaries along the global y/latitude axis (in radians) +! +! Domain = domain2D variable with halo size = 1 +! Domain_nohalo = domain2D variable with halo size = 0 +! used for outputing diagnostic fields +! +!----------------------------------------------------------------------- +! interpolation weights: used to move data between model grids + +type bgrid_interp_type + real, pointer, dimension(:,:) :: tmpwts=>NULL(), velwts=>NULL(), nowts=>NULL() +end type bgrid_interp_type + +! tmpwts, velwts = interpolation weights for area-weighted 4-point averages +! nowts = interpolation weights for simple 4-point averages + +!----------------------------------------------------------------------- + +type horiz_grid_type + type(bgrid_type) :: Tmp, Vel + type(bgrid_interp_type) :: Interp + integer :: nlon, nlat, isize, jsize + integer :: ilb, iub, jlb, jub + logical :: channel, double_periodic, decompx, decompy + real :: dlmd, dphd, dlm, dph + real :: sb, nb, wb, eb + real, pointer, dimension(:,:) :: sinphv=>NULL(), tanphv=>NULL() +end type horiz_grid_type + +! Tmp = constants for the temperature/tracer/mass grid +! Vel = constants for the u/v wind component grid +! +! sinphv = sine of Vel%aph +! tanphv = tangent of Vel%aph +! +! nlon = number of grid points along the global x-axis (no halo points) +! nlat = number of grid points along the global y-axis (no halo points) +! +! isize = number of grid points along the x-axis for the current processor +! (includes halo points) +! jsize = number of grid points along the y-axis for the current processor +! (includes halo points) +! +! ilb = lower bound x-axis +! iub = upper bound x-axis +! jlb = lower bound y-axis +! jub = upper bound y-axis +! +! dlm = grid spacing for x-axis (in radians) +! dph = grid spacing for y-axis (in radians) +! dlmd = grid spacing for x-axis (in degrees of longitude) +! dphd = grid spacing for y-axis (in degrees of latitude) +! +! sb = southern boundary of temperature grid (in radians) +! nb = northern boundary of temperature grid (in radians) +! wb = western boundary of temperature grid (in radians) +! eb = eastern boundary of temperature grid (in radians) +! +! channel = channel model, uses grid boundaries: ed,wb,sb,nb. +! also boundary condition at N/S walls is modified +! may select f-plane option or double periodic options +! double_periodic = f-plane channel with periodic boundaries in x and y. +! +! decompx = x-axis is decomposed across more than one processor +! decompy = y-axis is decomposed across more than one processor +!----------------------------------------------------------------------- +!-------- public parameters ------------- + + integer, parameter :: TGRID = 51, VGRID = 52 + +!----------------------------------------------------------------------- +!-------- private data ------------ + + real, parameter :: eps=0.0001 + +!-------- internal parameters -------- + +!----- untested/unsupported options ----- +! use at you own risk + + real :: wbd = 0.0 ! western edge in degrees of the first + ! longitude (i=1) of temperature grid boxes + + real :: ebd = 360.0 ! eastern edge in degrees of the last + ! longitude (i=nlon) of temperature grid boxes + + real :: sbd = -90.0 ! southern edge in degrees of the first + ! latitude row (j=1) of temperature grid boxes + + real :: nbd = 90.0 ! northern edge in degrees of the last latitude + ! row (j=nlat) of temperature grid boxes + + logical :: do_channel = .false. ! if TRUE, then use sbd,nbd as southern and northern + ! boundaries of a channel. + + logical :: do_fplane_approx = .false. ! f-plane channel without spherical geometry + ! used in conjunction with do_channel option + real :: fphd = 45. ! coriolis latitude used for f-plane channel + + logical :: do_double_periodic = .false. ! domain is cyclic in X and Y + ! this option must be used with do_fplane_approx = true + ! Tmp and Vel grids will have the same size global compute domain +!----------------------------------------------------------------------- + + real :: tph0d = 0. ! grid/globe transformation (unsupported) + real :: tlm0d = 0. ! (set tph0d=tlm0d=0 for no transformation) + +!----------------------------------------------------------------------- + character(len=128) :: version = '$Id: bgrid_horiz.F90,v 19.0 2012/01/06 19:55:11 fms Exp $' + character(len=128) :: tagname = '$Name: tikal $' + logical :: do_vers = .true. +!----------------------------------------------------------------------- + +contains + +!####################################################################### + +subroutine horiz_grid_init ( Hgrid, nlon, nlat, layout ) + +!----------------------------------------------------------------------- +! Hgrid = horizontal grid constants +! nlon,nlat = the global horizontal grid resolution +! number of longitude and latitude grid boxes, respectively +! layout = domain decomposition (num X pes by num Y pes), +! default decomposition along y-axis then x-axis +!----------------------------------------------------------------------- + + type(horiz_grid_type), intent(inout) :: Hgrid + integer, intent(in) :: nlon, nlat + integer, optional, intent(in) :: layout(2) + +!----------------------------------------------------------------------- +!------------------- local/private declarations ------------------------ + +real, allocatable :: tlmi(:), tphj(:), slat(:), dxj(:), wt(:,:) +integer, allocatable :: xrows(:), yrows(:) + +real :: hpi, dtr +integer :: i, j, ilb, iub, jlb, jub, npes, pe, yflags, nlatv +integer :: is, ie, hs, he, vs, ve +integer :: isd, ied, hsd, hed, vsd, ved +integer :: isg, ieg, hsg, heg, vsg, veg +integer :: domain_layout(2) +integer :: logunit +logical :: global_x, global_y +type(domain1D) :: Domx, Domy + +!------------- parallel interface -------------------------------------- +! ---- domain decomposition ----- + + call mpp_domains_init + + npes = mpp_npes() + logunit = stdlog() + +! write version info to logfile + if (do_vers) then + call write_version_number (version, tagname) + do_vers = .false. + endif + +! error checks and messages + + Hgrid % channel = do_channel + Hgrid % double_periodic = do_double_periodic + + if (Hgrid%channel) then + write (logunit,'(a)') 'Channel model option has been selected.' + endif + + if (do_fplane_approx) then + if (.not.Hgrid%channel) call error_mesg ('horiz_grid_init', & + 'f-plane approximation cannot be used without do_channel=TRUE', FATAL) + write (logunit,'(a)') '... the f-plane approximation will be used' + endif + + if (do_double_periodic) then + ! error check + if (.not.do_fplane_approx) call error_mesg ('horiz_grid_init', & + 'double periodic option cannot be used without do_fplane_approx=TRUE', FATAL) + yflags = CYCLIC_GLOBAL_DOMAIN + nlatv = nlat + write (logunit,'(a)') '... and double periodic boundary conditions will be used' + else + yflags = 0 + nlatv = nlat-1 + endif + +! print channel options used + if (Hgrid%channel) then + write (logunit,'(4x,a4,f10.3,4x,a4,f10.3)') 'WBD=',wbd,'EBD=',ebd + write (logunit,'(4x,a4,f10.3,4x,a4,f10.3)') 'SBD=',sbd,'NBD=',nbd + if (do_fplane_approx) then + write (logunit,'(4x,a4,f10.3)') 'FPHD=',fphd + endif + endif + +!---- set-up x- & y-axis decomposition ----- + + domain_layout = (/ 0, 0 /) + if (present(layout)) domain_layout = layout + if (domain_layout(1)+domain_layout(2) == 0) then + call mpp_define_layout ( (/1,nlon,1,nlat/), npes, domain_layout ) + else + if (domain_layout(1) == 0) domain_layout(1) = npes/domain_layout(2) + if (domain_layout(2) == 0) domain_layout(2) = npes/domain_layout(1) + endif + + if ( domain_layout(1)*domain_layout(2) /= npes ) call error_mesg & + ('horiz_grid_init', 'number of processors requested not & + &compatible with grid', FATAL ) + +! flag to indicate axis decomposition + Hgrid % decompx = domain_layout(1) .gt. 1 + Hgrid % decompy = domain_layout(2) .gt. 1 + + +! ---- mass/temperature grid domain with halo = 0,1 ---- + + call mpp_define_domains ( (/1,nlon,1,nlat/), domain_layout, & + Hgrid % Tmp % Domain, & + xflags = CYCLIC_GLOBAL_DOMAIN, & + yflags = yflags, & + xhalo = 1, yhalo = 1, & + name = 'ATMOSPHERIC (B-GRID) MODEL, temperature grid, halo=1,') + call mpp_define_domains ( (/1,nlon,1,nlat/), domain_layout, & + Hgrid % Tmp % Domain_nohalo, & + xflags = CYCLIC_GLOBAL_DOMAIN, & + yflags = yflags, & + xhalo = 0, yhalo = 0 ) + +! ---- compute exact decomposition ---- +! ---- compute 2d layout of PEs ---- + + allocate ( xrows(domain_layout(1)), yrows(domain_layout(2)) ) + call mpp_get_domain_components ( Hgrid%Tmp%Domain, Domx, Domy ) + call mpp_get_compute_domains ( Domx, size=xrows ) + call mpp_get_compute_domains ( Domy, size=yrows ) + +! ---- velocity grid may have one less latitude row ---- + + if (nlatv == nlat-1) then + yrows(domain_layout(2)) = yrows(domain_layout(2)) - 1 + endif + +! ---- velocity grid domain with halo = 0,1 ---- + + call mpp_define_domains ( (/1,nlon,1,nlatv/), domain_layout, & + Hgrid % Vel % Domain, & + xflags = CYCLIC_GLOBAL_DOMAIN, & + yflags = yflags, & + xhalo = 1, yhalo = 1, & + xextent = xrows, yextent = yrows ) + call mpp_define_domains ( (/1,nlon,1,nlatv/), domain_layout, & + Hgrid % Vel % Domain_nohalo, & + xflags = CYCLIC_GLOBAL_DOMAIN, & + yflags = yflags, & + xhalo = 0, yhalo = 0, & + xextent = xrows, yextent = yrows ) + + deallocate ( xrows, yrows ) + + +!------------- indices for global compute domain ----------------------- + + call mpp_get_global_domain ( Hgrid%Tmp%Domain, isg, ieg, hsg, heg ) + call mpp_get_global_domain ( Hgrid%Vel%Domain, isg, ieg, vsg, veg ) + + Hgrid % Tmp % isg = isg; Hgrid % Tmp % ieg = ieg + Hgrid % Tmp % jsg = hsg; Hgrid % Tmp % jeg = heg + Hgrid % Vel % isg = isg; Hgrid % Vel % ieg = ieg + Hgrid % Vel % jsg = vsg; Hgrid % Vel % jeg = veg + +!------------- indices for data domain ----------------------- + + call mpp_get_data_domain ( Hgrid%Tmp%Domain, isd, ied, hsd, hed ) + call mpp_get_data_domain ( Hgrid%Vel%Domain, isd, ied, vsd, ved ) + + Hgrid % Tmp % isd = isd; Hgrid % Tmp % ied = ied + Hgrid % Tmp % jsd = hsd; Hgrid % Tmp % jed = hed + Hgrid % Vel % isd = isd; Hgrid % Vel % ied = ied + Hgrid % Vel % jsd = vsd; Hgrid % Vel % jed = ved + +!------------- indices for computational domain ------------------------ + + call mpp_get_compute_domain ( Hgrid%Tmp%Domain, is, ie, hs, he ) + call mpp_get_compute_domain ( Hgrid%Vel%Domain, is, ie, vs, ve ) + + Hgrid % Tmp % is = is; Hgrid % Tmp % ie = ie + Hgrid % Tmp % js = hs; Hgrid % Tmp % je = he + Hgrid % Vel % is = is; Hgrid % Vel % ie = ie + Hgrid % Vel % js = vs; Hgrid % Vel % je = ve + +!------------- indices including halo regions -------------------------- + + call mpp_get_data_domain ( Hgrid%Tmp%Domain, ilb, iub, jlb, jub ) + + Hgrid % ilb = ilb; Hgrid % iub = iub + Hgrid % jlb = jlb; Hgrid % jub = jub + +!------------ other values --------------------------------------------- + + Hgrid % nlon = nlon ! global resolution + Hgrid % nlat = nlat + + Hgrid % isize = Hgrid % iub - Hgrid % ilb + 1 ! array size for current PE + Hgrid % jsize = Hgrid % jub - Hgrid % jlb + 1 + +!----------------------------------------------------------------------- +! -------- allocate space for arrays --------- + + call alloc_array_space ( ilb, iub, jlb, jub, Hgrid%Tmp ) + call alloc_array_space ( ilb, iub, jlb, jub, Hgrid%Vel ) + + allocate ( Hgrid % sinphv(ilb:iub,jlb:jub), & + Hgrid % tanphv(ilb:iub,jlb:jub) ) + + allocate ( slat (hs-1:he+2), wt (ilb:iub,jlb:jub) ) + +!----------------------------------------------------------------------- +!--------------derived geometrical constants---------------------------- + + hpi = acos(0.0) + dtr = hpi/90. + + if (Hgrid%channel) then + Hgrid % dphd = (nbd-sbd)/real(nlat) + Hgrid % dlmd = (ebd-wbd)/real(nlon) + Hgrid % sb = sbd*dtr + Hgrid % nb = nbd*dtr + Hgrid % wb = wbd*dtr + Hgrid % eb = ebd*dtr + global_x = abs(ebd-wbd-360.).lt.eps + global_y = abs(nbd-sbd-180.).lt.eps + else + ! global code used for bit-reprocibility + Hgrid % dphd = 180./real(nlat) + Hgrid % dlmd = 360./real(nlon) + Hgrid % sb = -hpi + Hgrid % nb = +hpi + Hgrid % wb = 0.0 + Hgrid % eb = 360.0*dtr + global_x = .true. + global_y = .true. + endif + + Hgrid % dlm = Hgrid % dlmd*dtr + Hgrid % dph = Hgrid % dphd*dtr + +! --- dy is the same on both grids --- + + Hgrid % Tmp % dy = RADIUS * Hgrid % dph + Hgrid % Vel % dy = RADIUS * Hgrid % dph + Hgrid % Tmp % rdy = 1.0 / Hgrid % Tmp % dy + Hgrid % Vel % rdy = 1.0 / Hgrid % Vel % dy + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!---- get grid box boundaries for computational global domain ---- + + Hgrid % Tmp % blong(isg-1:ieg+2) = get_grid (nlon+3, Hgrid%wb-Hgrid%dlm, & + Hgrid%dlm ) + ! global cyclic continuity (may not be necessary) + if (global_x) then + Hgrid % Tmp % blong(isg-1) = Hgrid % Tmp % blong(ieg)-4.*hpi + Hgrid % Tmp % blong(ieg+1) = Hgrid % Tmp % blong(isg)+4.*hpi + Hgrid % Tmp % blong(ieg+2) = Hgrid % Tmp % blong(isg+1)+4.*hpi + endif + + Hgrid % Tmp % blatg(hsg+1:heg) = get_grid (nlat-1, Hgrid%sb+Hgrid%dph, & + Hgrid%dph ) + ! polar halos + Hgrid % Tmp % blatg(heg+2) = Hgrid % Tmp % blatg(heg) + Hgrid % Tmp % blatg(heg+1) = Hgrid % nb + Hgrid % Tmp % blatg(hsg) = Hgrid % sb + Hgrid % Tmp % blatg(hsg-1) = Hgrid % Tmp % blatg(hsg+1) + + do i = is-1, ie+1 + Hgrid % Tmp % tlm(i) = 0.5*(Hgrid%Tmp%blong(i)+Hgrid%Tmp%blong(i+1)) + enddo + + do j = hs-1, he+1 + Hgrid % Tmp % tph(j) = 0.5*(Hgrid%Tmp%blatg(j)+Hgrid%Tmp%blatg(j+1)) + enddo + + if (do_fplane_approx) then +! --- no spherical geometry --- + Hgrid % Tmp % dx(hs-1:he+1) = RADIUS * Hgrid % dlm + else +! --- sphere --- + slat(hs-1:he+2) = sin(Hgrid%Tmp%blatg(hs-1:he+2)) + Hgrid % Tmp % dx (hs-1:he+1) = RADIUS * Hgrid % dlm / Hgrid % dph * & + abs(slat(hs:he+2)-slat(hs-1:he+1)) + endif + +!-------------initialize lat/lon at velocity points--------------------- + + Hgrid % Vel % blong(isg-1:ieg+2) = get_grid (nlon+3, Hgrid%wb-0.5*Hgrid%dlm, & + Hgrid%dlm ) + ! global cyclic continuity + if (global_x) then + Hgrid % Vel % blong(isg-1) = Hgrid % Vel % blong(ieg)-4.*hpi + Hgrid % Vel % blong(ieg+1) = Hgrid % Vel % blong(isg)+4.*hpi + Hgrid % Vel % blong(ieg+2) = Hgrid % Vel % blong(isg+1)+4.*hpi + endif + + Hgrid % Vel % blatg(vsg:veg+1) = get_grid (nlat, Hgrid%sb+0.5*Hgrid%dph, & + Hgrid%dph ) + ! polar halos + Hgrid % Vel % blatg(vsg-1) = Hgrid % sb + Hgrid % Vel % blatg(veg+2) = Hgrid % nb + + do i = is-1, ie+1 + Hgrid % Vel % tlm(i) = 0.5*(Hgrid%Vel%blong(i)+Hgrid%Vel%blong(i+1)) + enddo + do j = vs-1, ve+1 + Hgrid % Vel % tph(j) = 0.5*(Hgrid%Vel%blatg(j)+Hgrid%Vel%blatg(j+1)) + enddo + + if (do_fplane_approx) then +! --- no spherical geometry --- + Hgrid % Vel % dx = RADIUS * Hgrid % dlm + else +! --- sphere --- + slat(vs-1:ve+2) = sin(Hgrid%Vel%blatg(vs-1:ve+2)) + Hgrid % Vel % dx (vs-1:ve+1) = RADIUS * Hgrid % dlm / Hgrid % dph * & + (slat(vs:ve+2)-slat(vs-1:ve+1)) + endif + Hgrid % Vel % rdx(vs-1:ve+1) = 1.0 / Hgrid % Vel % dx(vs-1:ve+1) + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!------------- grid box areas ------------------------------------------ + + Hgrid % Tmp % area = Hgrid % Tmp % dx * Hgrid % Tmp % dy + Hgrid % Vel % area = Hgrid % Vel % dx * Hgrid % Vel % dy + +! Note: area of the pole on velocity grid is not important because: +! 1) pole is not in compute domain +! 2) current polar boundary condition is u=v=0 +! 3) fluxes between pole and sub-pole row are set to zero + +!--- reciprocal of area ---- + + do j = jlb, jub + if (Hgrid % Tmp % area(j) > 0.0) Hgrid % Tmp % rarea(j) = 1.0 / Hgrid % Tmp % area(j) + if (Hgrid % Vel % area(j) > 0.0) Hgrid % Vel % rarea(j) = 1.0 / Hgrid % Vel % area(j) + enddo + +!--- compute bit-reproducible global sum of area --- + + do j = hsd, hed + wt(:,j) = Hgrid%Tmp%area(j) + enddo + Hgrid % Tmp % areasum = mpp_global_sum (Hgrid%Tmp%Domain, wt, flags=BITWISE_EXACT_SUM) + + do j = vsd, ved ! may not be full array extent + wt(:,j) = Hgrid%Vel%area(j) + enddo + Hgrid % Vel % areasum = mpp_global_sum (Hgrid%Vel%Domain, wt(:,vsd:ved), flags=BITWISE_EXACT_SUM) + + deallocate ( slat, wt ) + + +!--- initialization of weights for grid interpolation --- + + call bgrid_interp_init ( Hgrid ) + +!----------------------------------------------------------------------- +! unsupported option for transforming the position of poles +! tph0d,tlm0d are the lat,lon position in the transformed grid +! of the point [lat=0,lon=0] ..... I think ???? + + if (tph0d > eps .or. tlm0d > eps) then + ! compute "actual" lat/lon ( aph, aph ) + ! actual lat/lon would be used for the coriolis, radiation, and ... + ! at temperature points + call trans_latlon (tph0d, tlm0d, & + Hgrid % Tmp % tlm, Hgrid % Tmp % tph, & + Hgrid % Tmp % alm, Hgrid % Tmp % aph) + ! at velocity points + call trans_latlon (tph0d, tlm0d, & + Hgrid % Vel % tlm, Hgrid % Vel % tph, & + Hgrid % Vel % alm, Hgrid % Vel % aph) + else + ! no transformation + do j = jlb, jub + do i = ilb, iub + Hgrid % Tmp % aph(i,j) = Hgrid % Tmp % tph(j) + Hgrid % Vel % aph(i,j) = Hgrid % Vel % tph(j) + Hgrid % Tmp % alm(i,j) = Hgrid % Tmp % tlm(i) + Hgrid % Vel % alm(i,j) = Hgrid % Vel % tlm(i) + enddo + enddo + endif + +!------------- trigometric constants ----------------------------------- + + if (do_fplane_approx) then +! --- channel model --- + Hgrid % sinphv = sin(fphd*dtr) + Hgrid % tanphv = tan(fphd*dtr) + else +! --- sphere --- + Hgrid % sinphv = sin(Hgrid % Vel % aph) + Hgrid % tanphv = tan(Hgrid % Vel % aph) + endif + +!----------------------------------------------------------------------- + +end subroutine horiz_grid_init + +!############################################################################## +! initializes weights for interpolation between model grids + +subroutine bgrid_interp_init ( Hgrid ) +type(horiz_grid_type), intent(inout) :: Hgrid + +real :: hpi +real :: sph (1:2*Hgrid%nlat+1), area(-1:2*Hgrid%nlat+2) +real :: areah(Hgrid%Tmp%jsd:Hgrid%Tmp%jed), areav(Hgrid%Vel%jsd:Hgrid%Vel%jed) +integer :: i, j, k +! indexing for interpolation weights array + integer, parameter :: SOUTH = 1, NORTH = 2 + +! allocate memory + allocate ( Hgrid%Interp%tmpwts(Hgrid%jlb:Hgrid%jub,2), & + Hgrid%Interp%velwts(Hgrid%jlb:Hgrid%jub,2), & + Hgrid%Interp%nowts (Hgrid%jlb:Hgrid%jub,2) ) + +! weights for simple 4-pt averages with equal weighting + Hgrid%Interp%nowts = 0.25 + +! equal weighting for non-spherical grid + if (do_fplane_approx) then + Hgrid%Interp%tmpwts = 0.25 + Hgrid%Interp%velwts = 0.25 + return + endif + +! create weights that will conserve the quantity being interpolated + +! create areas for grid boxes and interpolation +! need sin(lat) every 1/2 delta-lat + hpi = acos(0.0) + if (.not.Hgrid%channel) then + ! original global code (used for bit-reproducibility) + sph(1) = -1.; sph(2*Hgrid%nlat+1) = 1. + do j = 2, 2*Hgrid%nlat + sph(j) = sin(-hpi+real(j-1)*Hgrid%dph*0.5) + enddo + else + sph(1) = sin(Hgrid%sb); sph(2*Hgrid%nlat+1) = sin(Hgrid%nb) + do j = 2, 2*Hgrid%nlat + sph(j) = sin(Hgrid%sb+real(j-1)*Hgrid%dph*0.5) + enddo + endif +! 1/4 area/radius^2 of grid boxes + area(1:2*Hgrid%nlat) = 0.5*Hgrid%dlm*(sph(2:2*Hgrid%nlat+1)-sph(1:2*Hgrid%nlat)) +! assume halo size of one (fill two 1/2 size grid boxes) + area(-1:0) = area(2:1:-1) + area(2*Hgrid%nlat+1:2*Hgrid%nlat+2) = area(2*Hgrid%nlat:2*Hgrid%nlat-1:-1) + +! area of temperature grid boxes + do j = Hgrid%Tmp%jsd, Hgrid%Tmp%jed + Hgrid%Interp%tmpwts(j,SOUTH) = area(2*j-1) + Hgrid%Interp%tmpwts(j,NORTH) = area(2*j) + areah(j) = (Hgrid%Interp%tmpwts(j,SOUTH)+Hgrid%Interp%tmpwts(j,NORTH))*2.0 + ! compute final weights for 4-pt averages + Hgrid%Interp%tmpwts(j,SOUTH) = Hgrid%Interp%tmpwts(j,SOUTH) / areah(j) + Hgrid%Interp%tmpwts(j,NORTH) = Hgrid%Interp%tmpwts(j,NORTH) / areah(j) + enddo + +! area of velocity grid boxes + do j = Hgrid%Vel%jsd, Hgrid%Vel%jed + Hgrid%Interp%velwts(j,SOUTH) = area(2*j) + Hgrid%Interp%velwts(j,NORTH) = area(2*j+1) + areav(j) = (Hgrid%Interp%velwts(j,SOUTH)+Hgrid%Interp%velwts(j,NORTH))*2.0 + ! compute final weights for 4-pt averages + Hgrid%Interp%velwts(j,SOUTH) = Hgrid%Interp%velwts(j,SOUTH) / areav(j) + Hgrid%Interp%velwts(j,NORTH) = Hgrid%Interp%velwts(j,NORTH) / areav(j) + enddo + +end subroutine bgrid_interp_init + +!####################################################################### + +function get_grid (npts, start, space) result (grid) + +integer, intent(in) :: npts +real, intent(in) :: start, space +real :: grid(npts) +integer :: j + +!---- compute equally spaced grid ---- + + do j = 1, npts + grid(j) = start + real(j-1)*space + enddo + +end function get_grid + +!####################################################################### + + subroutine trans_latlon (tph0d, tlm0d, tlm, tph, alm, aph) + + real, intent(in) :: tph0d, tlm0d, tlm(:), tph(:) + real, intent(out) :: alm(:,:), aph(:,:) + + real :: dtr, pi, tph0, tlm0, stph0, ctph0, ttph0, cc, ee + real, dimension(size(tph)) :: stph, ctph + integer :: i, j + +!----------------------------------------------------------------------- + + ! scalars + pi = 2.*acos(0.0) + dtr = pi/180. + tph0 = tph0d*dtr; tlm0 = tlm0d*dtr + stph0 = sin(tph0); ctph0 = cos(tph0) + ttph0 = stph0/ctph0 + +! ------- compute actual lat and lon ------- + stph = sin(tph) + ctph = cos(tph) + do j = 1, size(aph,2) + do i = 1, size(aph,1) + cc = ctph(j)*cos(tlm(i)) + aph(i,j) = asin(ctph0*stph(j)+stph0*cc) + ee = cc/(ctph0*cos(aph(i,j))) - tan(aph(i,j))*ttph0 + ee = min(ee,1.) + if (tlm(i) > pi) then + alm(i,j) = tlm0-acos(ee) + else + alm(i,j) = tlm0+acos(ee) + endif + enddo + enddo + +!----------------------------------------------------------------------- + +end subroutine trans_latlon + +!####################################################################### + +subroutine get_horiz_grid_bound ( Hgrid, grid, blon, blat, global ) + +! returns the grid box boundaries for either +! the compute or global grid +! +! Hgrid = horizontal grid constants +! grid = grid identifier, possible values: TGRID, VGRID +! blon = longitude edges in radians +! blat = latitude edges in radians +! global = values for compute(F) or global(T) grid? + + type (horiz_grid_type), intent(in) :: Hgrid + integer, intent(in) :: grid + real, intent(out) :: blon(:), blat(:) + logical, optional, intent(in) :: global + + select case (grid) + case (TGRID) + call horiz_grid_bound ( Hgrid%Tmp, blon, blat, global ) + case (VGRID) + call horiz_grid_bound ( Hgrid%Vel, blon, blat, global ) + case default + call error_mesg ('get_horiz_grid_bound', 'invalid grid', FATAL) + end select + +!----------------------------------------------------------------------- + +end subroutine get_horiz_grid_bound + +!####################################################################### + +subroutine get_horiz_grid_size ( Hgrid, grid, nlon, nlat, global ) + +! returns the number of longitude and latitude grid boxes +! for either the compute or global grid +! +! Hgrid = horizontal grid constants +! grid = grid identifier, possible values: TGRID, VGRID +! nlon = number longitude grid boxes +! nlat = number latitude grid boxes +! global = values for compute(F) or global(T) grid? + + type (horiz_grid_type), intent(in) :: Hgrid + integer, intent(in) :: grid + integer, intent(out) :: nlon, nlat + logical, optional, intent(in) :: global + + select case (grid) + case (TGRID) + call horiz_grid_size ( Hgrid%Tmp, nlon, nlat, global ) + case (VGRID) + call horiz_grid_size ( Hgrid%Vel, nlon, nlat, global ) + case default + call error_mesg ('get_horiz_grid_size', 'invalid grid', FATAL) + end select + +end subroutine get_horiz_grid_size + +!####################################################################### + +subroutine horiz_grid_bound ( Grid, blon, blat, global ) + + type (bgrid_type), intent(in) :: Grid + real, intent(out) :: blon(:), blat(:) + logical, optional, intent(in) :: global + +! private routine that returns the grid box boundaries +! for either the compute or global grid + + integer :: is, ie, js, je + logical :: lglobal + + lglobal = .false.; if (present(global)) lglobal = global + + + if (lglobal) then + is = Grid % isg; ie = Grid % ieg ! global grid + js = Grid % jsg; je = Grid % jeg + else + is = Grid % is ; ie = Grid % ie ! compute grid + js = Grid % js ; je = Grid % je + endif + + !----- define longitudinal grid box edges ----- + + if (size(blon) /= ie-is+2) call error_mesg & + ('get_horiz_grid_bound', & + 'invalid argument dimension for blon', FATAL) + + blon = Grid % blong (is:ie+1) + + !----- define latitudinal grid box edges ----- + + if (size(blat) /= je-js+2) call error_mesg & + ('get_horiz_grid_bound', & + 'invalid argument dimension for blat', FATAL) + + blat = Grid % blatg (js:je+1) + +!----------------------------------------------------------------------- + +end subroutine horiz_grid_bound + +!####################################################################### + +subroutine horiz_grid_size ( Grid, nlon, nlat, global ) + + type (bgrid_type), intent(in) :: Grid + integer, intent(out) :: nlon, nlat + logical, optional, intent(in) :: global + + logical :: lglobal + + lglobal = .false.; if (present(global)) lglobal = global + + !---- return the size of the requested grid ---- + + if (lglobal) then + nlon = Grid % ieg - Grid % isg + 1 ! global grid + nlat = Grid % jeg - Grid % jsg + 1 + else + nlon = Grid % ie - Grid % is + 1 ! compute grid + nlat = Grid % je - Grid % js + 1 + endif + +end subroutine horiz_grid_size + +!####################################################################### + +function update_np (Hgrid, grid) result (answer) + +! Hgrid = horizontal grid constants +! grid = grid identifier, possible values: TGRID, VGRID +! +! Returns TRUE if the northernmost latitude row +! is adjacent to the north pole. + + type (horiz_grid_type), intent(in) :: Hgrid + integer, intent(in) :: grid + logical :: answer + integer :: je, jeg + + answer = .false. + !if (Hgrid%Tmp%jeg == Hgrid%Vel%jeg) return ! periodic in y + if (Hgrid%double_periodic) return ! periodic in y + + select case (grid) + case (TGRID) + if ( Hgrid%Tmp%je == Hgrid%Tmp%jeg ) answer = .true. + case(VGRID) + if ( Hgrid%Vel%je == Hgrid%Vel%jeg ) answer = .true. + case default + call error_mesg ('update_np', 'invalid grid', FATAL) + end select + +end function update_np + +!####################################################################### + +function update_sp (Hgrid, grid) result (answer) + +! Hgrid = horizontal grid constants +! grid = grid identifier, possible values: TGRID, VGRID +! +! Returns TRUE if the southernmost latitude row +! is adjacent to the south pole. + + type (horiz_grid_type), intent(in) :: Hgrid + integer, intent(in) :: grid + logical :: answer + integer :: js, jsg + + answer = .false. + !if (Hgrid%Tmp%jeg == Hgrid%Vel%jeg) return ! periodic in y + if (Hgrid%double_periodic) return ! periodic in y + + select case (grid) + case (TGRID) + if ( Hgrid%Tmp%js == Hgrid%Tmp%jsg ) answer = .true. + case(VGRID) + if ( Hgrid%Vel%js == Hgrid%Vel%jsg ) answer = .true. + case default + call error_mesg ('update_sp', 'invalid grid', FATAL) + end select + +end function update_sp + +!####################################################################### + + subroutine alloc_array_space ( ilb, iub, jlb, jub, Grid ) + integer, intent(in) :: ilb, iub, jlb, jub + type(bgrid_type), intent(inout) :: Grid + + allocate ( Grid % dx (jlb:jub), & + Grid % rdx (jlb:jub), & + Grid % tph (jlb:jub), & + Grid % tlm (ilb:iub), & + Grid % area (jlb:jub), & + Grid % rarea(jlb:jub), & + Grid % aph (ilb:iub,jlb:jub), & + Grid % alm (ilb:iub,jlb:jub) ) + + allocate ( Grid % blong (Grid%isg-1:Grid%ieg+2), & + Grid % blatg (Grid%jsg-1:Grid%jeg+2) ) + + Grid % dx = 0.; Grid % rdx = 0. + Grid % tph = 0.; Grid % tlm = 0. + Grid % area = 0.; Grid % rarea = 0. + + end subroutine alloc_array_space + +!####################################################################### + +end module bgrid_horiz_mod + diff --git a/MOM_code/src/atmos_bgrid/tools/bgrid_integrals.F90 b/MOM_code/src/atmos_bgrid/tools/bgrid_integrals.F90 new file mode 100644 index 0000000..493164c --- /dev/null +++ b/MOM_code/src/atmos_bgrid/tools/bgrid_integrals.F90 @@ -0,0 +1,920 @@ + +module bgrid_integrals_mod + +!----------------------------------------------------------------------- +! +! computes diagnostic integrals for the bgrid dynamical core +! +!----------------------------------------------------------------------- + +use mpp_mod, only: input_nml_file +use bgrid_change_grid_mod, only: change_grid, TEMP_GRID, WIND_GRID +use bgrid_horiz_mod, only: horiz_grid_type +use bgrid_vert_mod, only: vert_grid_type, compute_pres_depth +use bgrid_masks_mod, only: grid_mask_type +use bgrid_prog_var_mod, only: prog_var_type +use time_manager_mod, only: time_type, get_time, set_time, & + operator(+), operator(-), & + operator(==), operator(>=), & + operator(/=), operator(/), & + operator(*) + +use fms_mod, only: file_exist, open_namelist_file, & + check_nml_error, write_version_number, & + stdout, error_mesg, FATAL, NOTE +use constants_mod, only: CP_AIR + +use mpp_mod, only: mpp_pe, mpp_root_pe, mpp_max, mpp_min, & + mpp_sum, stdlog +use mpp_io_mod, only: mpp_open, mpp_close, MPP_ASCII, & + MPP_OVERWR, MPP_SEQUENTIAL, MPP_SINGLE +use mpp_domains_mod, only: mpp_global_sum, BITWISE_EXACT_SUM + +use field_manager_mod, only: MODEL_ATMOS +use tracer_manager_mod, only: get_tracer_names, get_number_tracers, & + get_tracer_index + +implicit none +private + +!----------------------------------------------------------------------- +!------ interfaces ------ + +public :: bgrid_integrals, bgrid_integrals_init, bgrid_integrals_end, global_integral + +!----------------------------------------------------------------------- +!--------------------- namelist ---------------------------------------- + + integer, parameter :: MXCH = 64 ! maximum length of file names + +! file_name = optional file name for output (max length of 64 chars); +! if no name is specified (the default) then +! standard output will be used +! [character, default: filename = ' '] + + character(len=MXCH) :: file_name = ' ' + +! time_units = specifies the time units used for time, +! the following values are valid strings +! time_units = 'seconds' +! = 'minutes' +! = 'hours' (default) +! = 'days' + + character(len=8) :: time_units = 'hours' + +! output_interval = time interval in units of "time_units" for +! global b-grid integral diagnostics; +! * if an interval of zero is specified then no +! diagnostics will be generated +! [real, default: output_interval = 0.0] + + real :: output_interval = 0.0 + +! chksum_file_name = Optional file name for global integral output in +! hexadecimal format. If this file name is set, then +! both the hexadecimal output and standard integral +! output will be computed using bit-reproducible summations. + + character(len=MXCH) :: chksum_file_name = ' ' + +! tracer_file_name = Optional file name for global integrals of all tracers. +! Up to 99 tracer integrals can be output in this file. + + character(len=MXCH) :: tracer_file_name = ' ' + +! trsout = Tracer names to be output in the standard integral file. +! Only up to 4 names can be specified. For more tracer integrals +! use the "tracer_file_name" option above. +! A default has been set for the standard atmospheric model runs. + + integer, parameter :: MXTRS = 4 + character(len=MXCH) :: trsout(MXTRS) = & + (/'sphum ','liq_wat','ice_wat','cld_amt'/) + + + namelist /bgrid_integrals_nml/ output_interval, time_units, & + file_name, chksum_file_name, & + trsout, tracer_file_name + +!----------------------------------------------------------------------- +! private interface + +interface global_integral + module procedure global_integral_2d, global_integral_3d +end interface + +!----------------------------------------------------------------------- + + type (time_type) :: Next_diag_time, Output_diag_interval, & + Base_time, Zero_time + + integer :: diag_unit = 0 + integer :: chksum_unit = 0 + integer :: tracer_unit = 0 + logical :: alarm_set = .false. + logical :: do_init = .true. + logical :: do_header = .true. + logical :: do_chksum = .false. + logical :: do_decomp_check = .true. + + character(len=128) :: version = '$Id: bgrid_integrals.F90,v 19.0 2012/01/06 19:55:13 fms Exp $' + character(len=128) :: tag = '$Name: tikal $' + + character(len=256) :: frmat ! format used for standard intergals + +! output for tracers + integer :: ntrout=-1, indout(MXTRS) + +! output options + integer, parameter :: STANDARD=11 ! new format: min temp and TE + integer, parameter :: TRACER1 =12 ! detailed tracer 1 (for conservation checks) + integer, parameter :: KENERGY =13 ! old format: zonal mean and eddy KE + integer :: output_option = STANDARD + +! quantities accumulated over the output period + real :: windspeed_max + real :: temperature_min + integer :: num_in_avg ! not actually used +!----------------------------------------------------------------------- + +contains + +!####################################################################### + + subroutine bgrid_integrals (Time, Hgrid, Vgrid, Var, Masks) + +!----------------------------------------------------------------------- +! Time = current/diagnostics time +! Hgrid = horizontal grid constants +! Vgrid = vertical grid constants +! Var = prognostic variables +! Masks = grid box masking constants (for eta coordinate) +!----------------------------------------------------------------------- + + type (time_type), intent(in) :: Time + type(horiz_grid_type), intent(in) :: Hgrid + type (vert_grid_type), intent(in) :: Vgrid + type (prog_var_type), intent(in) :: Var + type (grid_mask_type), intent(in) :: Masks + +!----------------------------------------------------------------------- + + real, dimension (Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub, Var%nlev) :: dpde, dpde_xy, avg + real, dimension (Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub) :: pssl_xy, ps_xy + + real :: avgps, avgke, avgzke, avgeke, avgens, avgtemp, avgpsv, avgte + real :: xtime, vmax, tmin + integer :: i, j, k, n, ntmax, nout, ind + + real, dimension(Var%ntrace) :: avgtrace + real, dimension(MXTRS) :: avgtrout + character(len=21) :: fmt + +!----------------------------------------------------------------------- + + if (do_init) call error_mesg ('bgrid_integrals_mod', & + 'must call bgrid_integrals_init', FATAL) + +! no diagnostics + if (Output_diag_interval == Zero_time) return +!----------------------------------------------------------------------- +! the following quantities represent averages over the output period: +! windspeed_max, temperature_min +!----------------------------------------------------------------------- +! maximum wind speed (use dpde_xy as temp storage) +! get local maximum on current PE then across PEs + + dpde_xy(:,:,:) = sqrt(Var%u(:,:,:)*Var%u(:,:,:)+ & + Var%v(:,:,:)*Var%v(:,:,:)) + + vmax = maxval (dpde_xy(Hgrid%Vel%is:Hgrid%Vel%ie, Hgrid%Vel%js:Hgrid%Vel%je, :)) + call mpp_max (vmax) + windspeed_max = max(windspeed_max,vmax) + +! minimum temperature + + if (Masks%sigma) then + tmin = minval (Var%t(Hgrid%Tmp%is:Hgrid%Tmp%ie, Hgrid%Tmp%js:Hgrid%Tmp%je, :)) + else + tmin = minval (Var%t(Hgrid%Tmp%is:Hgrid%Tmp%ie, Hgrid%Tmp%js:Hgrid%Tmp%je, :), & + mask=Masks%Tmp%mask(Hgrid%Tmp%is:Hgrid%Tmp%ie, Hgrid%Tmp%js:Hgrid%Tmp%je, :) > .1 ) + endif + call mpp_min (tmin) + temperature_min = min(temperature_min,tmin) + +! increment counter (not actually used for computing averages) + + num_in_avg = num_in_avg + 1 + +!----------------------------------------------------------------------- +! check output alarm + + if ( .not. bgrid_integrals_alarm(Time) ) return + +!----------------------------------------------------------------------- +! if there is decomposition along x-axis you will not get the +! correct integrals for zonal mean and eddy kinetic energy + + if (do_decomp_check) then + if (mpp_pe() == mpp_root_pe()) then + if ( Hgrid%decompx .and. output_option == KENERGY ) then + call error_mesg ('bgrid_integrals', & + 'checksum integrals of zonal and eddy KE will not be & + &exact with x-axis decomposition', NOTE ) + endif + endif + do_decomp_check = .false. + endif + +!----------------------------------------------------------------------- +! the following quantities represent instantaneous values at the +! end of the output period: global-average pressure, temperature, +! kinetic energy, total energy, enstrophy, and tracers. +!----------------------------------------------------------------------- +! compute pressure weights on mass grid and velocity grid + + call compute_pres_depth (Vgrid, Var%pssl, dpde) + call change_grid (Hgrid, TEMP_GRID, WIND_GRID, dpde, dpde_xy) + +! global average of surface pressure on mass and velocity grid + + avgps = global_integral (Hgrid, 1, Var%ps, do_exact=do_chksum) + avgpsv = global_integral (Hgrid, 2, dpde_xy, do_exact=do_chksum) + +! global average of various kinetic energy terms +! normalize with mean global mass + + if (output_option == KENERGY) then + call kinetic_energy (Hgrid, Masks, dpde_xy, Var%u, Var%v, avgke, avgzke, avgeke ) + avgke = avgke /avgpsv ! total ke + avgzke = avgzke/avgpsv ! zonal mean ke + avgeke = avgeke/avgpsv ! eddy ke + else + call kinetic_energy (Hgrid, Masks, dpde_xy, Var%u, Var%v, avgke ) + avgke = avgke /avgpsv ! total ke + endif + +! global average of enstrophy on mass grid +! scale result + + call enstrophy (Hgrid, Masks, dpde, dpde_xy, Var%u, Var%v, avgens) + avgens = 1.e10*avgens/avgps + +! global average of temperature + + avg = Var%t * dpde + avgtemp = global_integral(Hgrid, 1, avg, Masks, do_chksum) / avgps + +! total energy (cp*T+KE) + + avgte = CP_AIR * avgtemp + avgke + +! global average of tracer fields + + ! compute integrals for all tracers? + if (tracer_file_name(1:1) .ne. ' ') then + do n = 1, Var%ntrace + avg = Var%r(:,:,:,n) * dpde + avgtrace(n) = global_integral(Hgrid, 1, avg, Masks, do_chksum) / avgps + enddo + endif + + ! determine indices for output tracers (first time only) + if (ntrout < 0) then + ntmax = min(MXTRS,Var%ntrace) + if (output_option == TRACER1) ntmax = 1 + ntrout = 0 + ! first output namelist tracers + do n = 1, ntmax + ind = get_tracer_index ( MODEL_ATMOS, trim(trsout(n)) ) + if (ind <= 0) cycle + ntrout = ntrout+1 + indout(ntrout) = ind + enddo + ! then add additional output tracers (if possible) + if (ntrout < ntmax .and. ntrout < Var%ntrace) then + do ind = 1, Var%ntrace + ! checking current list + do n = 1, ntrout + if (ind == indout(n)) go to 10 + enddo + ! adding new tracer index + ntrout = ntrout + 1 + indout(ntrout) = ind + if (ntrout == ntmax) exit + 10 continue + enddo + endif + endif + + ! compute integrals for output tracers in B-grid integral file + do n = 1, ntrout + if (tracer_file_name(1:1) .ne. ' ') then + avgtrout(n) = avgtrace(indout(n)) + else + avg = Var%r(:,:,:,indout(n)) * dpde + avgtrout(n) = global_integral(Hgrid, 1, avg, Masks, do_chksum) / avgps + endif + enddo + +! tracer conservation debugging option + nout = ntrout + if (output_option == TRACER1 .and. nout == 1) then + if (indout(1) > 0) then + avgtrout(2) = minval(Var%r(:,:,:,indout(1))) + avgtrout(3) = maxval(Var%r(:,:,:,indout(1))) + call mpp_min (avgtrout(2)) + call mpp_max (avgtrout(3)) + nout = 3 + endif + endif + +!----------------------------------------------------------------------- +! increment diagnostics alarm + + Next_diag_time = Next_diag_time + Output_diag_interval + +!----------------------------------------------------------------------- +! output on root PE only + + if ( mpp_pe() == mpp_root_pe() ) then + + xtime = get_axis_time (Time, time_units) + + if (do_header) call diag_header + + select case (output_option) + case (STANDARD) + write (diag_unit,trim(frmat)) xtime, avgps, avgtemp, temperature_min, & + windspeed_max, avgke, avgte, avgens, & + (avgtrout(n),n=1,nout) + case (TRACER1) + write (diag_unit,trim(frmat)) xtime, avgps, avgtemp, temperature_min, & + windspeed_max, avgke, avgte, avgens, & + (avgtrout(n),n=1,nout) + case (KENERGY) + write (diag_unit,trim(frmat)) xtime, avgps, avgtemp, windspeed_max, & + avgke, avgzke, avgeke, avgens, & + (avgtrout(n),n=1,nout) + end select + + if (do_chksum) then + write (chksum_unit,8200) xtime, avgps, avgtemp, windspeed_max, avgens, & + avgke, (avgtrout(n),n=1,min(nout,1)) + 8200 format (1x,f10.2,2x,6z18) + endif + + +!---- output additional tracers ---- + + if (tracer_file_name(1:1) .ne. ' ') then +! ---- open file, write header ---- + if (tracer_unit == 0) then + call mpp_open (tracer_unit, trim(tracer_file_name), & + form=MPP_ASCII, action=MPP_OVERWR, & + access=MPP_SEQUENTIAL, threading=MPP_SINGLE, & + nohdrs=.true.) + write (tracer_unit,8300) + endif + ! output up to 99 tracers + write (fmt,8310) min(Var%ntrace,99) + write (tracer_unit,fmt) xtime, (avgtrace(n),n=1,min(Var%ntrace,99)) + endif + + 8300 format ('#',6x,'n', 8x, 'tracers --->') + 8310 format ('(1x,f10.2,2x,',i2.2,'e13.6)') + + endif + +! reset + windspeed_max = 0. + temperature_min = 500. + num_in_avg = 0 +!----------------------------------------------------------------------- + + end subroutine bgrid_integrals + +!####################################################################### + + subroutine bgrid_integrals_init (Time_init, Time) + +!---------------------------------------------------- +! Time_init = base time for experiment +! the base time will be subtracted from all +! specified times before that time is output/written. +! Time = current time +!---------------------------------------------------- + + type (time_type), intent(in) :: Time_init, Time + + integer :: unit, io, ierr, seconds, nc, logunit + type (time_type) :: Time_dif, Last_diag + +!----------------------------------------------------------------------- +! ----- read namelist ----- +! ----- write namelist (to standard output) ----- + + if ( file_exist('input.nml')) then +#ifdef INTERNAL_FILE_NML + read (input_nml_file, nml=bgrid_integrals_nml, iostat=io) + ierr = check_nml_error(io,'bgrid_integrals_nml') +#else + unit = open_namelist_file ( ) + ierr=1; do while (ierr /= 0) + read (unit, nml=bgrid_integrals_nml, iostat=io, end=10) + ierr = check_nml_error (io, 'bgrid_integrals_nml') + enddo + 10 call mpp_close (unit) +#endif + endif + + call write_version_number (version,tag) + logunit = stdlog() + if (mpp_pe() == mpp_root_pe()) write (logunit, nml=bgrid_integrals_nml) + do_init = .false. + +!----- initialize alarm if not already done ----- + + Zero_time = set_time (0,0) + Base_time = Time_init + + ! set output interval + if ( output_interval > 0.0 ) then + Output_diag_interval = set_axis_time (output_interval, time_units) + else + ! no diagnostics + Output_diag_interval = Zero_time + endif + if ( Output_diag_interval == Zero_time ) return + + ! current diag time (base time subtracted off) + Time_dif = Time - Base_time + ! last time of diagnostics + Last_diag = (Time_dif/Output_diag_interval)*Output_diag_interval + if ( Last_diag == Time_dif ) then + Next_diag_time = Last_diag ! repeat diag at start of run + else + Next_diag_time = Last_diag + Output_diag_interval + endif + +!--- initialize diagnostics output unit/file ? ---- + + if ( file_name(1:1) /= ' ' ) then + call mpp_open (diag_unit, trim(file_name), form=MPP_ASCII, & + action=MPP_OVERWR, access=MPP_SEQUENTIAL, & + threading=MPP_SINGLE, nohdrs=.true.) + else + diag_unit = stdout() + endif + + if ( chksum_file_name(1:1) /= ' ' ) then + call mpp_open (chksum_unit, trim(chksum_file_name), & + form=MPP_ASCII, action=MPP_OVERWR, & + access=MPP_SEQUENTIAL, threading=MPP_SINGLE, & + nohdrs=.true.) + do_chksum = .true. + endif + + +! reset quantities accumulated over the output period +! NOTE: will need a restart file if the end of the output period +! does not coincide with the end of the model run. + + windspeed_max = 0. + temperature_min = 500. + num_in_avg = 0 + +!----------------------------------------------------------------------- + + end subroutine bgrid_integrals_init + +!####################################################################### + + subroutine bgrid_integrals_end + +! close all open units + if ( diag_unit > 0 .and. diag_unit /= stdout()) & + call mpp_close (diag_unit) + if (chksum_unit > 0) call mpp_close (chksum_unit) + if (tracer_unit > 0) call mpp_close (tracer_unit) + +! need to write a restart file if the end of the output period +! does not coincide with the end of the model run + + if (num_in_avg > 0 .and. mpp_pe() == mpp_root_pe()) then + ! print a note for now + call error_mesg ('bgrid_integrals_mod', & + 'end of the output period did not coincide & + &with the end of the model run', NOTE) + endif + + end subroutine bgrid_integrals_end + +!####################################################################### + + function bgrid_integrals_alarm (Time) result (answer) + + type (time_type), intent(in) :: Time + logical :: answer + +!----------------------------------------------------------------------- +!----- check the diagnostics alarm ----- + + answer = .false. + +!----- sound the diagnostics alarm ----- + + if (Time - Base_time >= Next_diag_time) answer = .true. + + end function bgrid_integrals_alarm + +!####################################################################### + + subroutine diag_header + + character(len=24) :: lab_time, lab_ps, lab_tavg, lab_tmin, lab_vmax, & + lab_ke, lab_zke, lab_eke, lab_te, lab_ens, & + lab_trs, lab_tr1 + character(len=24) :: fmt_time, fmt_ps, fmt_tavg, fmt_tmin, fmt_vmax, & + fmt_ke, fmt_zke, fmt_eke, fmt_te, fmt_ens, & + fmt_trs, fmt_tr1 + character(len=256) :: title + character(len=64) :: lab_tr, trname + integer :: n + + + lab_time = '''#'',5x,''n'',3x,' ; fmt_time = 'f10.2' + lab_ps = '5x,''ps'',4x,' ; fmt_ps = ',1x,f10.3' + lab_tavg = '3x,''tavg'',1x,' ; fmt_tavg = ',1x,f7.3' + lab_tmin = '3x,''tmin'',1x,' ; fmt_tmin = ',1x,f7.3' + lab_vmax = '3x,''vmax'',2x,' ; fmt_vmax = ',1x,f8.4' + lab_ke = '4x,''ke'',2x,' ; fmt_ke = ',1x,f7.2' + lab_zke = '4x,''zke'',1x,' ; fmt_zke = ',1x,f7.2' + lab_eke = '4x,''eke'',1x,' ; fmt_eke = ',1x,f7.2' + lab_te = '5x,''te'',4x,' ; fmt_te = ',1x,f10.3' + lab_ens = '6x,''ens'',5x,' ; fmt_ens = ',1x,e13.6' + lab_trs = '3x' ; fmt_trs = ',2x,4e13.6' +!lab_trs = '7x,''trs --->''' ; fmt_trs = ',2x,4e13.6' + lab_tr1 = '7x,''tr1 --->''' ; fmt_tr1 = ',1x,3e22.14' + + select case (output_option) + + case (STANDARD) + title = '('//trim(lab_time)//trim(lab_ps)//trim(lab_tavg) & + //trim(lab_tmin)//trim(lab_vmax)//trim(lab_ke) & + //trim(lab_te)//trim(lab_ens)//trim(lab_trs) + frmat = '('//trim(fmt_time)//trim(fmt_ps)//trim(fmt_tavg) & + //trim(fmt_tmin)//trim(fmt_vmax)//trim(fmt_ke) & + //trim(fmt_te)//trim(fmt_ens)//trim(fmt_trs)//')' + + case (KENERGY) + title = '('//trim(lab_time)//trim(lab_ps)//trim(lab_tavg) & + //trim(lab_vmax)//trim(lab_ke)//trim(lab_zke) & + //trim(lab_eke)//trim(lab_ens)//trim(lab_trs) + frmat = '('//trim(fmt_time)//trim(fmt_ps)//trim(fmt_tavg) & + //trim(fmt_vmax)//trim(fmt_ke)//trim(fmt_zke) & + //trim(fmt_eke)//trim(fmt_ens)//trim(fmt_trs)//')' + + case (TRACER1) + title = '('//trim(lab_time)//trim(lab_ps)//trim(lab_tavg) & + //trim(lab_tmin)//trim(lab_vmax)//trim(lab_ke) & + //trim(lab_te)//trim(lab_ens)//trim(lab_trs) + frmat = '('//trim(fmt_time)//trim(fmt_ps)//trim(fmt_tavg) & + //trim(fmt_tmin)//trim(fmt_vmax)//trim(fmt_ke) & + //trim(fmt_te)//trim(fmt_ens)//trim(fmt_tr1)//')' + + end select + + ! labels for tracers + do n = 1, ntrout + call get_tracer_names (MODEL_ATMOS,indout(n),trname) + lab_tr = '4x,'//trim(trname)//'' + write (lab_tr,10) trim(trname) + 10 format (',2x,''',a9,''',2x') + title = trim(title)//trim(lab_tr) + enddo + if (output_option == TRACER1) title = trim(title)//',''(avg,min,max)''' + title = trim(title)//')' + !if (mpp_pe() == mpp_root_pe()) print *, 'title=',trim(title) + + + ! write the header/labels + write (diag_unit,trim(title)) + + + ! for the exact integral file + if (do_chksum) then + write (chksum_unit,8002) + endif +8002 format ('#',6x,'n', 14x, 'ps', 15x, 'temp', 13x, 'max vel', & + 12x, 'ens', 16x, 'ke', 13x, 'tracer 1') + + do_header = .false. + + + end subroutine diag_header + +!####################################################################### + + subroutine kinetic_energy (Hgrid, Masks, dpde, u, v, & + gke, gmke, geke ) + + type(horiz_grid_type), intent(in) :: Hgrid + type (grid_mask_type), intent(in) :: Masks + real, intent(in) , dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: dpde, u, v + real, intent(out) :: gke + real, intent(out), optional :: gmke, geke +!----------------------------------------------------------------------- + + real, dimension (Hgrid%ilb:Hgrid%iub, Hgrid%jlb:Hgrid%jub, & + size(u,3)) :: ke, mke, eke + real, dimension (Hgrid%ilb:Hgrid%iub) :: ustar, vstar + real :: usum, vsum, wsum, uavg, vavg + integer :: i, j, k, is, ie + +!----------------------------------------------------------------------- +!---- zero out quantities ---- + + mke = 0.; eke = 0. + +!---- total kinetic energy (2x) ---- + + ke(:,:,:) = dpde(:,:,:)*(u(:,:,:)**2+v(:,:,:)**2) + gke = global_integral (Hgrid, 2, ke, Masks, do_chksum) * 0.50 + +!---- compute mean zonal and eddy kinetic energy ----- + + if (.not.present(gmke) .and. .not.present(geke)) return + + is=Hgrid%Vel%is + ie=Hgrid%Vel%ie + + do k = 1, size(u,3) + do j = Hgrid%Vel%js, Hgrid%Vel%je + + wsum = sum(Masks%Vel%mask(is:ie,j,k)) + + if (wsum > 0.50) then + ! zonal mean + usum = sum(Masks%Vel%mask(is:ie,j,k)*u(is:ie,j,k)) + vsum = sum(Masks%Vel%mask(is:ie,j,k)*v(is:ie,j,k)) + uavg = usum/wsum + vavg = vsum/wsum + + ! zonal eddy components + ustar(:) = u(:,j,k)-uavg + vstar(:) = v(:,j,k)-vavg + + ! zonal mean ke (2x) + mke(:,j,k) = dpde(:,j,k)*(uavg**2+vavg**2) + ! eddy ke (2x) + eke(:,j,k) = dpde(:,j,k)*(ustar(:)**2+vstar(:)**2) + else + mke(:,j,k) = 0.0 + eke(:,j,k) = 0.0 + endif + + enddo + enddo + + ! 3-dim global integrals + if (present(gmke)) & + gmke = global_integral (Hgrid, 2, mke, Masks, do_chksum) * 0.50 + if (present(geke)) & + geke = global_integral (Hgrid, 2, eke, Masks, do_chksum) * 0.50 + +!----------------------------------------------------------------------- + + end subroutine kinetic_energy + +!####################################################################### + + subroutine enstrophy (Hgrid, Masks, dpde, dpde_xy, u, v, avgens) + +!----------------------------------------------------------------------- + type(horiz_grid_type), intent(in) :: Hgrid + type (grid_mask_type), intent(in) :: Masks + real, intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: dpde, & + dpde_xy, u, v + real, intent(out) :: avgens +!----------------------------------------------------------------------- + + real, dimension (Hgrid%ilb:Hgrid%iub, Hgrid%jlb:Hgrid%jub, size(u,3)) :: ens + + real, dimension (Hgrid%ilb:Hgrid%iub, Hgrid%jlb:Hgrid%jub) :: & + vdy, udx, avdy, audx, vort + real, dimension (Hgrid%jlb:Hgrid%jub) :: fens + + integer :: i, j, k, is, ie, js, je + real :: dysq + +!----------------------------------------------------------------------- + + is = Hgrid%Tmp%is; ie = Hgrid%Tmp%ie + js = Hgrid%Tmp%js; je = Hgrid%Tmp%je + +!----------------------------------------------------------------------- + + ens = 0.0; vort = 0.0 + fens = 0.25*Hgrid%Tmp%rarea*Hgrid%Tmp%rarea + + do k = 1, size(u,3) + + do j = js-1, je + vdy(:,j) = v(:,j,k)*dpde_xy(:,j,k)*Hgrid%Vel%dy + udx(:,j) = u(:,j,k)*dpde_xy(:,j,k)*Hgrid%Vel%dx(j) + enddo + + do j = js, je + do i = is-1, ie + avdy(i,j) = vdy(i,j-1)+vdy(i,j) + enddo + enddo + do j = js-1, je + do i = is, ie + audx(i,j) = udx(i-1,j)+udx(i,j) + enddo + enddo + +! ------ vorticity * dpde_xy * area ------ + do j = js, je + do i = is, ie + vort(i,j)=((avdy(i,j)-avdy(i-1,j))-(audx(i,j)-audx(i,j-1))) + enddo + enddo + +! ------ enstrophy ------ + do j = js, je + ens(:,j,k) = vort(:,j)*vort(:,j)*fens(j)/dpde(:,j,k) + enddo + + enddo + +!----------------------------------------------------------------------- + + avgens = global_integral (Hgrid, 1, ens, Masks, do_chksum) + +!----------------------------------------------------------------------- + + end subroutine enstrophy + +!####################################################################### +!####################################################################### + +function get_axis_time (Time, units) result (atime) + + type(time_type), intent(in) :: Time + character(len=*), intent(in) :: units + real :: atime + integer :: sec, day + +!---- returns real time in the time axis units ---- +!---- convert time type to appropriate real units ---- + + call get_time (Time-Base_time, sec, day) + + if (units(1:3) == 'sec') then + atime = float(sec) + 86400.*float(day) + else if (units(1:3) == 'min') then + atime = float(sec)/60. + 1440.*float(day) + else if (units(1:3) == 'hou') then + atime = float(sec)/3600. + 24.*float(day) + else if (units(1:3) == 'day') then + atime = float(sec)/86400. + float(day) + endif + +end function get_axis_time + +!####################################################################### + +function set_axis_time (atime, units) result (Time) + + real, intent(in) :: atime + character(len=*), intent(in) :: units + type(time_type) :: Time + integer :: sec, day = 0 + +!---- returns time type given real time in axis units ---- +!---- convert real time units to time type ---- + + if (units(1:3) == 'sec') then + sec = int(atime + 0.5) + else if (units(1:3) == 'min') then + sec = int(atime*60. + 0.5) + else if (units(1:3) == 'hou') then + sec = int(atime*3600. + 0.5) + else if (units(1:3) == 'day') then + sec = int(atime*86400. + 0.5) + endif + +! --- do not add in base time --- + + Time = set_time (sec, day) + +end function set_axis_time + +!####################################################################### +!####### global averaging routines for the bgrid model ################# +!####################################################################### + +function global_integral_2d (Hgrid, grid, data, do_exact) & + result (avg) + + type(horiz_grid_type), intent(in) :: Hgrid +integer, intent(in) :: grid + real, intent(in) :: data(Hgrid%ilb:,Hgrid%jlb:) +logical, intent(in), optional :: do_exact + real :: avg + + real, dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub) :: aa + real :: asum, wsum +integer :: i, j, isd, ied, vsd, ved +logical :: bitwise_exact + +!----------------------------------------------------------------------- + + bitwise_exact = .false. + if (present(do_exact)) bitwise_exact = do_exact + +! average on mass grid + select case (grid) + case(1) + do j = Hgrid%Tmp%jsd, Hgrid%Tmp%jed + do i = Hgrid%Tmp%isd, Hgrid%Tmp%ied + aa(i,j)= data(i,j) * Hgrid%Tmp%area(j) + enddo + enddo + if ( bitwise_exact ) then + asum = mpp_global_sum ( Hgrid%Tmp%Domain, aa, flags=BITWISE_EXACT_SUM ) + else + asum = mpp_global_sum ( Hgrid%Tmp%Domain, aa ) + endif + wsum = Hgrid%Tmp%areasum + +! average on velocity grid + case(2:3) + ! must pass data domain to mpp_global_sum + isd = Hgrid%Vel%isd; ied = Hgrid%Vel%ied + vsd = Hgrid%Vel%jsd; ved = Hgrid%Vel%jed + do j = vsd, ved + do i = isd, ied + aa(i,j)= data(i,j) * Hgrid%Vel%area(j) + enddo + enddo + if ( bitwise_exact ) then + asum = mpp_global_sum ( Hgrid%Vel%Domain, aa(isd:ied,vsd:ved), & + flags=BITWISE_EXACT_SUM ) + else + asum = mpp_global_sum ( Hgrid%Vel%Domain, aa(isd:ied,vsd:ved) ) + endif + wsum = Hgrid%Vel%areasum + + end select + + if (wsum <= 0.0) call error_mesg ('global_integral_2d in bgrid_integrals_mod', & + 'wsum=0', FATAL) + + avg = asum/wsum + +end function global_integral_2d + +!####################################################################### + +function global_integral_3d (Hgrid, grid, data, Masks, do_exact) & + result (avg) + +type(horiz_grid_type), intent(in) :: Hgrid +integer, intent(in) :: grid +real, intent(in) :: data(Hgrid%ilb:,Hgrid%jlb:,:) +type (grid_mask_type), intent(in), optional :: Masks +logical, intent(in), optional :: do_exact +real :: avg +real, dimension(size(data,1),size(data,2)) :: aa + +!----------------------------------------------------------------------- + + if (present(Masks)) then + select case (grid) + case(1) + aa = sum( data*Masks%Tmp%mask, dim=3 ) + case(2:3) + aa = sum( data*Masks%Vel%mask, dim=3 ) + end select + else + aa = sum( data, dim=3 ) + endif + + avg = global_integral_2d (Hgrid, grid, aa, do_exact) + +!----------------------------------------------------------------------- + +end function global_integral_3d + +!####################################################################### +!####################################################################### + +end module bgrid_integrals_mod + diff --git a/MOM_code/src/atmos_bgrid/tools/bgrid_masks.F90 b/MOM_code/src/atmos_bgrid/tools/bgrid_masks.F90 new file mode 100644 index 0000000..df10688 --- /dev/null +++ b/MOM_code/src/atmos_bgrid/tools/bgrid_masks.F90 @@ -0,0 +1,258 @@ + +module bgrid_masks_mod + +!----------------------------------------------------------------------- +! +! allocates memory and initializes masks and vertical indexing +! associated with the step mountain vertical coordinate. +! +!----------------------------------------------------------------------- + +use bgrid_horiz_mod, only: horiz_grid_type +use bgrid_halo_mod, only: update_halo, NOPOLE, UWND +use bgrid_vert_mod, only: vert_grid_type +use fms_mod, only: write_version_number, stdlog, stdout +use mpp_mod, only: mpp_pe, mpp_root_pe, mpp_max + +implicit none +private + +!----------------------------------------------------------------------- +! ---- public interfaces ---- + + public :: grid_masks_init, grid_masks_end + +!----------------------------------------------------------------------- +! ---- public data types ---- + + public :: mask_type + public :: grid_mask_type + + type mask_type + real, pointer, dimension(:,:,:) :: mask =>NULL() + integer, pointer, dimension(:,:) :: kbot =>NULL() + integer :: kbotmin + end type mask_type + +! mask = step-mountain topography mask (0. or 1.) +! mask = 0. for grid boxes that form the step-mountain +! mask = 1. for grid boxes above ground +! kbot = lowest model level above ground +! kbotmin = smallest value of kbot across all processors +! +! NOTE: For the sigma coordinate, mask = 1.0 everywhere, and +! kbot = number of vertical model levels + + type grid_mask_type + type(mask_type) :: Tmp, Vel + logical :: sigma + end type grid_mask_type + +! Tmp = grid masking values for the temperature/mass grid +! Vel = grid masking values for the velocity grid +! sigma = logical flag that specifies whether the vertical coordinate +! is the eta/step-mountain coordinate or sigma coordinate +! +!----------------------------------------------------------------------- +! private interfaces and data + + private :: compute_mass_mask, compute_vel_mask, compute_lowest_level + + logical :: sigma ! local variable + +! version number info + + character(len=128) :: version='$Id: bgrid_masks.F90,v 19.0 2012/01/06 19:55:15 fms Exp $' + character(len=128) :: tagname='$Name: tikal $' + logical :: do_log = .true. + +!----------------------------------------------------------------------- + +contains + +!####################################################################### + + subroutine grid_masks_init (Hgrid, Vgrid, res, Masks) + +!----------------------------------------------------------------------- +! input arguments +! Hgrid = horizontal grid constants +! Vgrid = vertical grid constants +! res = 1/eta(surface); i.e., reciprical of eta at the surface +! output +! Masks = grid box masks for the eta coordinate +!----------------------------------------------------------------------- + + type (horiz_grid_type), intent(inout) :: Hgrid + type (vert_grid_type), intent(in) :: Vgrid + real, intent(in) :: res(Hgrid%ilb:,Hgrid%jlb:) + type (grid_mask_type), intent(inout) :: Masks + +!----------------------------------------------------------------------- + + logical :: sigma ! flag for sigma(T) or eta(F) + integer :: k, outunit, logunit + real :: maxres + real :: aeta(Vgrid%nlev) + + if (do_log) then + call write_version_number (version,tagname) + do_log = .false. + endif + logunit = stdlog() + outunit = stdout() + + ! allocate global storage + + allocate ( Masks%Tmp%mask (Hgrid%ilb:Hgrid%iub, Hgrid%jlb:Hgrid%jub, Vgrid%nlev), & + Masks%Vel%mask (Hgrid%ilb:Hgrid%iub, Hgrid%jlb:Hgrid%jub, Vgrid%nlev), & + Masks%Tmp%kbot (Hgrid%ilb:Hgrid%iub, Hgrid%jlb:Hgrid%jub), & + Masks%Vel%kbot (Hgrid%ilb:Hgrid%iub, Hgrid%jlb:Hgrid%jub) ) + + ! determine if this is a sigma or eta + ! vertical coordinate from the value of res + + maxres = maxval(res) + call mpp_max (maxres) + + if (maxres > 1.0001) then + Masks % sigma=.false. + sigma=.false. + if (mpp_pe() == mpp_root_pe()) then + if (Vgrid%hybrid) then + write (logunit,100) 'eta/hybrid' + else + write (logunit,100) 'eta' + endif + ! print gaudy banner to standard output for untested eta option + write (outunit,'(4(a/))') & + '*******************************************************', & + 'WARNING: The eta coordinate option has not been tested.', & + ' Proceed with caution.', & + '*******************************************************' + endif + else + Masks % sigma=.true. + sigma=.true. + if (mpp_pe() == mpp_root_pe()) then + if (Vgrid%hybrid) then + write (logunit,100) 'sigma/hybrid' + else + write (logunit,100) 'sigma' + endif + endif + endif + + 100 format (/,'B-grid dynamical core has been initialized with the ',a,' vertical coordinate.') + +!--------------topography masks ---------------------------------------- + + ! average eta at model levels + do k = 1, Vgrid%nlev + aeta(k) = (Vgrid%eta(k)+Vgrid%eta(k+1))*0.5 + enddo + + Masks % Tmp % mask = compute_mass_mask (res, aeta) + Masks % Vel % mask = compute_vel_mask (res, aeta) + call update_halo (Hgrid, UWND, Masks%Vel%mask, flags=NOPOLE) +!!!!! call update_halo (Hgrid, UWND, Masks%Vel%mask) ! sets mask=0 at poles + +!------------- compute the lowest model level -------------------------- + + Masks % Tmp % kbot = compute_lowest_level (Masks % Tmp % mask) + Masks % Vel % kbot = compute_lowest_level (Masks % Vel % mask) + +! ----- global values ----- + + Masks % Tmp % kbotmin = minval(Masks % Tmp % kbot) + Masks % Vel % kbotmin = minval(Masks % Vel % kbot) + +!----------------------------------------------------------------------- + +end subroutine grid_masks_init + +!####################################################################### + +subroutine grid_masks_end ( Masks ) + +type (grid_mask_type), intent(inout) :: Masks + +! release memory + deallocate ( Masks%Tmp%mask, Masks%Vel%mask, & + Masks%Tmp%kbot, Masks%Vel%kbot ) + Masks%Tmp%kbotmin = 0 ! set unrealistic value + Masks%Vel%kbotmin = 0 + +end subroutine grid_masks_end + +!####################################################################### + + function compute_mass_mask (res, aeta) result (mask) + + real, intent(in) :: res(:,:), aeta(:) + real, dimension(size(res,1),size(res,2),size(aeta,1)) :: mask + integer i, j, k + + mask = 1.0 + + if (.not.sigma) then + do j=1,size(res,2); do i=1,size(res,1) + do k=1,size(aeta(:)) + if (aeta(k) > (1.0/res(i,j))) mask(i,j,k) = 0.0 + enddo; enddo; enddo + endif + + end function compute_mass_mask + +!####################################################################### + + function compute_vel_mask (res, aeta) result (mask) + + real, intent(in) :: res(:,:), aeta(:) + real, dimension(size(res,1),size(res,2),size(aeta,1)) :: mask + integer i, j, k + + mask = 1.0 + + if (.not.sigma) then + do j=2,size(res,2); do i=2,size(res,1) + do k=1,size(aeta(:)) + if (aeta(k) > (1.0/res(i,j))) then + mask(i-1,j-1,k) = 0.0 + mask(i ,j-1,k) = 0.0 + mask(i-1,j ,k) = 0.0 + mask(i ,j ,k) = 0.0 + endif + enddo; enddo; enddo + endif + + end function compute_vel_mask + +!####################################################################### + + function compute_lowest_level (mask) result (kbot) + + real, intent(in) :: mask(:,:,:) + integer, dimension(size(mask,1),size(mask,2)) :: kbot + integer i, j, k, kdim + + kdim = size(mask,3) + kbot = kdim + + if (.not.sigma) then + do j=1,size(mask,2); do i=1,size(mask,1) + do k=1,kdim + if (mask(i,j,k) < 0.50) then + kbot(i,j)=k-1; exit + endif + enddo; enddo; enddo + ! must not be zero + kbot = max(kbot,1) + endif + + end function compute_lowest_level + +!####################################################################### + +end module bgrid_masks_mod + diff --git a/MOM_code/src/atmos_bgrid/tools/bgrid_polar_filter.F90 b/MOM_code/src/atmos_bgrid/tools/bgrid_polar_filter.F90 new file mode 100644 index 0000000..7c136ab --- /dev/null +++ b/MOM_code/src/atmos_bgrid/tools/bgrid_polar_filter.F90 @@ -0,0 +1,976 @@ + +module bgrid_polar_filter_mod +!----------------------------------------------------------------------- + +use bgrid_horiz_mod, only: horiz_grid_type, bgrid_type, & + TGRID, VGRID + +use fft_mod, only: fft_init, fft_grid_to_fourier, & + fft_fourier_to_grid + +use fms_mod, only: error_mesg, FATAL, & + write_version_number, & + mpp_npes, mpp_pe, mpp_root_pe, & + mpp_clock_id, mpp_clock_begin, & + mpp_clock_end, MPP_CLOCK_SYNC, & + CLOCK_ROUTINE + +use mpp_domains_mod, only: domain2d, domain1d, & + mpp_redistribute, & + mpp_define_layout, & + mpp_define_domains, & + mpp_get_domain_components, & + mpp_get_layout, & + mpp_get_global_domain, & + mpp_get_data_domain, & + mpp_get_compute_domains, & + CYCLIC_GLOBAL_DOMAIN + +implicit none +private + + public :: polar_filter, polar_filter_wind, polar_filter_init + public :: TGRID, VGRID + + interface polar_filter + module procedure polar_filter_3d, polar_filter_two_3d, & + polar_filter_2d, polar_filter_two_2d + end interface polar_filter + + interface polar_filter_wind + module procedure polar_filter_wind_3d, polar_filter_wind_2d + end interface polar_filter_wind + +!-------------------------------- +! derived types + public :: pfilt_domain_type, pfilt_index_type, pfilt_control_type + + type pfilt_domain_type + private + type (domain2d) :: Domain + integer :: isd, ied, jsd, jed + end type pfilt_domain_type + + type pfilt_index_type + private + integer :: leng, lenc + integer :: is, ie, js, je + integer :: isd, ied, jsd, jed + integer :: weight + logical :: sigma, rowend + real :: cph0 + real, pointer :: sklm(:) =>NULL(), cph(:) =>NULL() + integer ,pointer :: jpf(:) =>NULL() + type (pfilt_domain_type) :: Local, Zonal, Local2, Zonal2 + end type pfilt_index_type + + type pfilt_control_type + private + integer :: nlpf, nlev + integer :: isize, jsize + real, pointer, dimension(:) :: slm =>NULL(), clm =>NULL() + type (pfilt_index_type) :: Tmp, Vel + end type pfilt_control_type + +!-------------------------------- +! version id info + character(len=128) :: version='$Id: bgrid_polar_filter.F90,v 10.0 2003/10/24 22:00:19 fms Exp $' + character(len=128) :: tagname='$Name: tikal $' + logical :: do_log = .true. +!-------------------------------- +! private data + real , allocatable :: xsum(:) + integer, allocatable :: xknt(:) + +! performance timing data + integer :: id_pfiltr + logical :: do_clock_init = .true. + +contains + +!####################################################################### +! public routines for polaring filtering +!####################################################################### + + subroutine polar_filter_3d ( Control, u, grid, mask ) + +!----------------------------------------------------- +! Polar filter a single 3D field +! +! Control = control parameters for polar filter +! u = 3D data +! grid = grid identifier, use: TGRID, VGRID +! mask = grid box mask for eta coordinate topography +!------------------------------------------------------- + + type(pfilt_control_type), intent(in) :: Control + real, intent(inout), dimension(:,:,:) :: u + integer, intent(in) :: grid + real, intent(in), dimension(:,:,:), optional :: mask + + ! error checks + if (size(u,1) /= Control%isize .or. size(u,2) /= Control%jsize) & + call error_mesg ('polar_filter_mod', 'incorrect horizontal dimension', FATAL) + if (size(u,3) /= Control%nlev) & + call error_mesg ('polar_filter_mod', 'incorrect number of levels', FATAL ) + + ! select grid + select case (grid) + case (TGRID) + call filter_field ( Control%Tmp, u, mask=mask ) + case (VGRID) + call filter_field ( Control%Vel, u, mask=mask ) + case default + call error_mesg ('polar_filter_mod', 'invalid grid argument', FATAL) + end select + + end subroutine polar_filter_3d + +!======================================================================= + + subroutine polar_filter_two_3d ( Control, u, v, grid, mask ) + +!----------------------------------------------------- +! Polar filter two 3D fields on the same grid +! +! Control = control parameters for polar filter +! u, v = 3D data field on the same grid +! grid = grid identifier, use: TGRID, VGRID +! mask = grid box mask for eta coordinate topography +!------------------------------------------------------- + + type(pfilt_control_type), intent(in) :: Control + real, intent(inout), dimension(:,:,:) :: u, v + integer, intent(in) :: grid + real, intent(in), dimension(:,:,:), optional :: mask + + ! error checks + if (size(u,1) /= Control%isize .or. size(u,2) /= Control%jsize) & + call error_mesg ('polar_filter_mod', 'incorrect horizontal dimension', FATAL) + if (size(u,3) /= Control%nlev .or. size(v,3) /= Control%nlev) & + call error_mesg ('polar_filter_mod', 'incorrect number of levels', FATAL ) + + ! select grid + select case (grid) + case (TGRID) + call filter_two_fields ( Control%Tmp, u, v, mask=mask ) + case (VGRID) + call filter_two_fields ( Control%Vel, u, v, mask=mask ) + case default + call error_mesg ('polar_filter_mod', 'invalid grid argument', FATAL) + end select + + end subroutine polar_filter_two_3d + +!======================================================================= + + subroutine polar_filter_wind_3d ( Control, u, v, mask ) + +!----------------------------------------------------- +! Polar filter 3D momentum fields +! +! Control = control parameters for polar filter +! u, v = 3D data field on the same grid +! mask = grid box mask for eta coordinate topography +! +! NOTE: a polar stereographic transformation of the +! wind components done when the filter is applied +!------------------------------------------------------- + + type(pfilt_control_type), intent(in) :: Control + real, intent(inout), dimension(:,:,:) :: u, v + real, intent(in), dimension(:,:,:), optional :: mask + + ! error checks + if (size(u,1) /= Control%isize .or. size(u,2) /= Control%jsize) & + call error_mesg ('polar_filter_mod', 'incorrect horizontal dimension', FATAL) + if (size(u,3) /= Control%nlev .or. size(v,3) /= Control%nlev) & + call error_mesg ('polar_filter_mod', 'incorrect number of levels', FATAL ) + + call filter_two_fields ( Control%Vel, u, v, & + slm=Control%slm, clm=Control%clm, mask=mask ) + + end subroutine polar_filter_wind_3d + +!####################################################################### +!=============== overloaded 2D interfaces ==================== + + subroutine polar_filter_2d ( Control, u, grid, mask ) + +!----------------------------------------------------- +! Polar filter a single 2D field +! +! Control = control parameters for polar filter +! u = 2D data +! grid = grid identifier, use: TGRID, VGRID +! mask = grid box mask for eta coordinate topography +!------------------------------------------------------- + + type(pfilt_control_type), intent(in) :: Control + real, intent(inout), dimension(:,:) :: u + integer, intent(in) :: grid + real, intent(in), dimension(:,:), optional :: mask + + real, dimension(size(u,1),size(u,2),1) :: u3, m3 + + u3(:,:,1) = u + if (present(mask)) then + m3(:,:,1) = mask + call polar_filter_3d ( Control, u3, grid, mask=m3 ) + else + call polar_filter_3d ( Control, u3, grid ) + endif + u = u3(:,:,1) + + end subroutine polar_filter_2d + +!======================================================================= + + subroutine polar_filter_two_2d ( Control, u, v, grid, mask ) + +!----------------------------------------------------- +! Polar filter two 2D fields on the same grid +! +! Control = control parameters for polar filter +! u, v = 2D data field on the same grid +! grid = grid identifier, use: TGRID, VGRID +! mask = grid box mask for eta coordinate topography +!------------------------------------------------------- + + type(pfilt_control_type), intent(in) :: Control + real, intent(inout), dimension(:,:) :: u, v + integer, intent(in) :: grid + real, intent(in), dimension(:,:), optional :: mask + + real, dimension(size(u,1),size(u,2),1) :: u3, v3, m3 + + u3(:,:,1) = u + v3(:,:,1) = v + if (present(mask)) then + m3(:,:,1) = mask + call polar_filter_two_3d ( Control, u3, v3, grid, mask=m3 ) + else + call polar_filter_two_3d ( Control, u3, v3, grid ) + endif + u = u3(:,:,1) + v = v3(:,:,1) + + end subroutine polar_filter_two_2d + +!======================================================================= + + subroutine polar_filter_wind_2d ( Control, u, v, mask ) + +!----------------------------------------------------- +! Polar filter 2D momentum fields +! +! Control = control parameters for polar filter +! u, v = 2D data field on the same grid +! mask = grid box mask for eta coordinate topography +! +! NOTE: a polar stereographic transformation of the +! wind components done when the filter is applied +!------------------------------------------------------- + + type(pfilt_control_type), intent(in) :: Control + real, intent(inout), dimension(:,:) :: u, v + real, intent(in), dimension(:,:), optional :: mask + + real, dimension(size(u,1),size(u,2),1) :: u3, v3, m3 + + ! error checks + if (size(u,1) /= Control%isize .or. size(u,2) /= Control%jsize) & + call error_mesg ('polar_filter_mod', 'incorrect horizontal dimension', FATAL) + + u3(:,:,1) = u + v3(:,:,1) = v + if (present(mask)) then + m3(:,:,1) = mask + call filter_two_fields ( Control%Vel, u3, v3, & + slm=Control%slm, clm=Control%clm, mask=m3 ) + else + call filter_two_fields ( Control%Vel, u3, v3, & + slm=Control%slm, clm=Control%clm ) + endif + u = u3(:,:,1) + v = v3(:,:,1) + + end subroutine polar_filter_wind_2d + +!####################################################################### +! filter a single field + + subroutine filter_field ( Index, u, mask ) + + type(pfilt_index_type), intent(in) :: Index + real, intent(inout), dimension(Index%isd:,Index%jsd:,:) :: u + real, intent(in), dimension(Index%isd:,Index%jsd:,:), & + optional :: mask + + real, dimension( Index%Local%isd:Index%Local%ied, & + Index%Local%jsd:Index%Local%jed ) :: g, gm + real, dimension( Index%Zonal%isd:Index%Zonal%ied, & + Index%Zonal%jsd:Index%Zonal%jed ) :: z, zm + + real, dimension( Index%lenc, Index%Zonal%jsd:Index%Zonal%jed ) :: ss + complex, dimension( Index%lenc, Index%Zonal%jsd:Index%Zonal%jed ) :: c + + integer :: i, j, k, n, nlev, is, ie, isg, ieg + logical :: use_mask + real :: zm_min + + call mpp_clock_begin (id_pfiltr) + +! scalar constants + nlev = size(u,3) + is = Index%is; ie = Index%ie + isg = Index%Zonal%isd; ieg = Index%Zonal%ied-1 + use_mask = .not.Index%sigma .and. present(mask) + zm_min = 1.0 + +!-------------------------------------------- +! reorder indexing i*k*j + + n = Index%Local%jsd - 1 + do j = Index%js, Index%je + do k = 1, nlev + if (Index%jpf(j) /= 0) then + n = n + 1 + do i = is, ie + g(i,n) = u(i,j,k) + enddo + ! add cosine latitude to end of rows + if (Index%rowend) g(ie+1,n) = Index%cph(j) + ! step-mountain mask + if (use_mask) then + do i = is, ie + gm(i,n) = mask(i,j,k) + enddo + endif + endif + enddo + enddo +!-------------------------------------------- +! distribute the data across all processors + call mpp_redistribute ( Index%Local%Domain, g, Index%Zonal%Domain, z ) +! mask ? + if (use_mask) then + call mpp_redistribute ( Index%Local%Domain, gm, Index%Zonal%Domain, zm ) + zm_min = minval(zm(isg:ieg,:)) + if (zm_min < .01) call fill_missing (zm(isg:ieg,:), z(isg:ieg,:)) + endif + +! compute filter response + call set_filter_response ( Index, z(ieg+1,:), ss ) +! transform to fourier coefficients + c = fft_grid_to_fourier (z) +! filter + c = c * ss +! transform back to grid spce + z = fft_fourier_to_grid (c) +! restore zonal mean if mask used + if (zm_min < .01) call fix_missing (zm(isg:ieg,:), z(isg:ieg,:)) + +! distribute the data back to original processor + call mpp_redistribute ( Index%Zonal%Domain, z, Index%Local%Domain, g ) + +!-------------------------------------------- +! place data back in original arrays + + n = Index%Local%jsd - 1 + do j = Index%js, Index%je + do k = 1, nlev + ! only replace filtered data + if (Index%jpf(j) /= 0) then + n = n + 1 + do i = is, ie + u(i,j,k) = g(i,n) + enddo + endif + ! apply mask for step-mountain coord + if (use_mask) then + do i = is, ie + u(i,j,k) = u(i,j,k) * mask(i,j,k) + enddo + endif + enddo + enddo + + call mpp_clock_end (id_pfiltr) +!-------------------------------------------- + +end subroutine filter_field + +!####################################################################### +! filter two fields on the same grid + + subroutine filter_two_fields ( Index, u, v, slm, clm, mask ) + + type(pfilt_index_type), intent(in) :: Index + real, intent(inout), dimension(Index%isd:,Index%jsd:,:) :: u, v + real, intent(in), dimension(Index%isd:), optional :: slm, clm + real, intent(in), dimension(Index%isd:,Index%jsd:,:), & + optional :: mask + + real, dimension( Index%Local2%isd:Index%Local2%ied, & + Index%Local2%jsd:Index%Local2%jed ) :: g, gm + real, dimension( Index%Zonal2%isd:Index%Zonal2%ied, & + Index%Zonal2%jsd:Index%Zonal2%jed ) :: z, zm + + real, dimension( Index%lenc, Index%Zonal2%jsd:Index%Zonal2%jed ) :: ss + complex, dimension( Index%lenc, Index%Zonal2%jsd:Index%Zonal2%jed ) :: c + + integer :: i, j, k, n1, n2, nlev, nfld, is, ie, isg, ieg + logical :: vectors, use_mask + real :: zm_min + + call mpp_clock_begin (id_pfiltr) + +! initialize scalars + nlev = size(u,3) + nfld = 2 + is = Index%is; ie = Index%ie + isg = Index%Zonal2%isd; ieg = Index%Zonal2%ied-1 + vectors = present(slm) .and. present(clm) + use_mask = .not.Index%sigma .and. present(mask) + zm_min = 1.0 + +!-------------------------------------------- +! reorder indexing i*k*j +! add cosine latitude to end of rows + + n1 = Index%Local2%jsd - 2 + do j = Index%js, Index%je + do k = 1, nlev + if (Index%jpf(j) /= 0) then + n1 = n1 + 2 + n2 = n1 + 1 + if (vectors) then + ! convert u/v components using streographic projection + select case (Index%jpf(j)) + case (-1) ! so.hemis. + do i = is, ie + g(i,n1) = -u(i,j,k)*slm(i) + v(i,j,k)*clm(i) + g(i,n2) = +u(i,j,k)*clm(i) + v(i,j,k)*slm(i) + enddo + case (+1) ! no.hemis. + do i = is, ie + g(i,n1) = -u(i,j,k)*slm(i) - v(i,j,k)*clm(i) + g(i,n2) = +u(i,j,k)*clm(i) - v(i,j,k)*slm(i) + enddo + end select + else + ! two distinct fields - no conversion necessary + do i = is, ie + g(i,n1) = u(i,j,k) + g(i,n2) = v(i,j,k) + enddo + endif + ! insert cosine latitude at end of global latitude rows + if (Index%rowend) then + g(ie+1,n1) = Index%cph(j) + g(ie+1,n2) = Index%cph(j) + endif + ! step-mountain mask (need two copies) + if (use_mask) then + do i = is, ie + gm(i,n1) = mask(i,j,k) + gm(i,n2) = mask(i,j,k) + enddo + endif + endif + enddo + enddo +!-------------------------------------------- +! distribute the data across all processors + call mpp_redistribute ( Index%Local2%Domain, g, Index%Zonal2%Domain, z ) +! mask ? + if (use_mask) then + call mpp_redistribute ( Index%Local2%Domain, gm, Index%Zonal2%Domain, zm ) + zm_min = minval(zm(isg:ieg,:)) + if (zm_min < .01) call fill_missing (zm(isg:ieg,:), z(isg:ieg,:)) + endif + +! compute filter response + call set_filter_response ( Index, z(ieg+1,:), ss ) +! transform to fourier coefficients + c = fft_grid_to_fourier (z) +! filter + c = c * ss +! transform back to grid spce + z = fft_fourier_to_grid (c) +! restore zonal mean if mask used + if (zm_min < .01) call fix_missing (zm(isg:ieg,:), z(isg:ieg,:)) + +! distribute the data back to original processor + call mpp_redistribute ( Index%Zonal2%Domain, z, Index%Local2%Domain, g ) + +!-------------------------------------------- +! place data back in original arrays + + n1 = Index%Local2%jsd - 2 + do j = Index%js, Index%je + do k = 1, nlev + if (Index%jpf(j) /= 0) then + n1 = n1 + 2 + n2 = n1 + 1 + if (vectors) then + ! convert stereographic projection back to u/v components + select case (Index%jpf(j)) + case (-1) ! so. hemis. + do i = is, ie + u(i,j,k) = -g(i,n1)*slm(i) + g(i,n2)*clm(i) + v(i,j,k) = +g(i,n1)*clm(i) + g(i,n2)*slm(i) + enddo + case (+1) ! no. hemis. + do i = is, ie + u(i,j,k) = -g(i,n1)*slm(i) + g(i,n2)*clm(i) + v(i,j,k) = -g(i,n1)*clm(i) - g(i,n2)*slm(i) + enddo + end select + else + ! two distinct fields + do i = is, ie + u(i,j,k) = g(i,n1) + v(i,j,k) = g(i,n2) + enddo + endif + endif + ! apply mask for step-mountain coord + if (use_mask) then + do i = is, ie + u(i,j,k) = u(i,j,k) * mask(i,j,k) + v(i,j,k) = v(i,j,k) * mask(i,j,k) + enddo + endif + enddo + enddo + + call mpp_clock_end (id_pfiltr) +!-------------------------------------------- + +end subroutine filter_two_fields + +!####################################################################### +! computes standard filter response (after arakawa & lamb) + + subroutine set_filter_response ( Index, cph, ss ) + type(pfilt_index_type), intent(in) :: Index + real , intent(in) :: cph (:) + real , intent(out) :: ss (:,:) + + real, dimension(Index%lenc) :: cph0_sklm + integer :: j, k + + ! longitude dependent values + do k = 2, Index%lenc + cph0_sklm (k) = Index%cph0 * Index%sklm(k) + enddo + + ! mean always one + ss (1,:) = 1.0 + + ! compute response function (range 0. to 1.) + do j = 1, size(ss,2) + do k = 2, Index%lenc + ss (k,j) = max(0.0, min( 1.0, cph(j)/cph0_sklm(k) )) + enddo + enddo + + end subroutine set_filter_response + +!####################################################################### +!======== routines for step-mountain coordinate ========= +!####################################################################### + +subroutine fill_missing ( mask, dat ) +real, intent(in), dimension(:,:) :: mask +real, intent(inout), dimension(:,:) :: dat +integer :: i, j, nlon, nlat + +! computes zonal mean at points where mask /= 0 +! interpolates values into points where mask = 0 + + nlon = size(dat,1); nlat = size(dat,2) + allocate ( xknt(nlat), xsum(nlat) ) + xknt = 0; xsum = 0. + + do j = 1, nlat + do i = 1, nlon + if (mask(i,j) < .01) cycle + xknt(j) = xknt(j) + 1 + xsum(j) = xsum(j) + dat(i,j) + enddo + if (xknt(j) == nlon .or. xknt(j) == 0) cycle + call intrp ( mask(:,j), dat(:,j) ) + !where (mask(:,j)<.01) dat(:,j)=xsum(j)/real(xknt(j)) + enddo + +end subroutine fill_missing + +!======================================================================= + +subroutine fix_missing ( mask, dat ) +real, intent(in), dimension(:,:) :: mask +real, intent(inout), dimension(:,:) :: dat +integer :: i, j, nlon, nlat +real :: avg, dif + +! restores zonal mean in latitude rows with missing values + + nlon = size(dat,1); nlat = size(dat,2) + + do j = 1, nlat + if (xknt(j) == nlon .or. xknt(j) == 0) cycle + avg = 0. + do i = 1, nlon + if (mask(i,j) < .01) cycle + avg = avg + dat(i,j) + enddo + dif = (xsum(j)-avg)/real(xknt(j)) + do i = 1, nlon + if (mask(i,j) < .01) cycle + dat(i,j) = dat(i,j) + dif + enddo + enddo + deallocate ( xknt, xsum ) + +end subroutine fix_missing + +!======================================================================= + +subroutine intrp ( mask, dat ) +real, intent(in), dimension(:) :: mask +real, intent(inout), dimension(:) :: dat + +integer, dimension(size(dat,1)) :: m1, m2, mbas +real, dimension(size(dat,1)) :: base, slop +integer :: nlon, last, nseg, i, m, n + +! fill in missing values by linear interpolating + + m1(:)=99999 + m2(:)=99999 + mbas(:)=99999 + base(:)=99999. + slop(:)=99999. + + nlon = size(dat,1) + last = -1 + nseg = 1 + + do i = 1, nlon + if (mask(i) < .01) then + if (last == 1) then + m1(nseg) = i + mbas(nseg) = i-1 + base(nseg) = dat(i-1) + endif + last = 0 + else + if (last == 0) then + m2(nseg) = i-1 + slop(nseg) = (dat(i)-base(nseg))/real(i-mbas(nseg)) + nseg = nseg+1 + endif + last = 1 + endif + enddo + + if ( m1(nseg) == 99999 .and. m2(nseg) == 99999) nseg = nseg-1 + if ( m1(1) == 99999 .and. m2(nseg) == 99999) then + m1(1) = 1 + m2(nseg) = nlon + mbas(1) = mbas(nseg)-nlon + base(1) = base(nseg) + slop(1) = (dat(m2(1)+1)-base(1))/real(m2(1)+1-mbas(1)) + slop(nseg) = slop(1) + endif + if (m1(1) == 99999) then + m1(1) = 1 + mbas(1) = 0 + base(1) = dat(nlon) + slop(1) = (dat(m2(1)+1)-base(1))/real(m2(1)+1-mbas(1)) + endif + if (m2(nseg) == 99999) then + m2(nseg) = nlon + slop(nseg) = (dat(1)-base(nseg))/real(nlon+1-mbas(nseg)) + endif + + do n = 1, nseg + do m = m1(n), m2(n) + dat(m) = base(n) + real(m-mbas(n))*slop(n) + enddo + enddo + +end subroutine intrp + +!####################################################################### +! initialization routines +!####################################################################### + + subroutine polar_filter_init ( Control, Hgrid, nlev, reflat, weight, sigma, verbose ) + +!----------------------------------------------------------------------- +! Hgrid = horizontal grid constants +! nlev = number of vertical model levels +! all input data must have this number of levels +! reflat = reference latitude in degrees, default=60., +! poleward of this latitude the filter is applied +! weight = weight to strengthen filter (not recommended) +! sigma = flag to improve optimization for sigma coordinate models +! default=FALSE, set to TRUE for sigma models +! verbose = not used? +!----------------------------------------------------------------------- + + type(pfilt_control_type), intent(inout) :: Control + type(horiz_grid_type), intent(in) :: Hgrid + integer, intent(in) :: nlev + real, intent(in), optional :: reflat + integer, intent(in), optional :: weight, verbose + logical, intent(in), optional :: sigma + + integer :: nlpf, i + real :: filter_lats +!----------------------------------------------------------------------- + + if (do_log) then + call write_version_number (version,tagname) + do_log = .false. + endif + + ! reference latitude + filter_lats = 30. + if (present(reflat)) then + if ( reflat-epsilon(reflat) <= 90. .and. reflat >= 0. ) then + filter_lats = 90. - reflat + else + call error_mesg ('polar_filter_init', & + 'reflat must lie between 0 and 90.', FATAL) + endif + endif + ! number of latitude rows of filtering per hemisphere + nlpf = int(float(Hgrid%Tmp%jeg-Hgrid%Tmp%jsg+1)*filter_lats/180.) + Control%nlpf = nlpf + Control%nlev = nlev + ! grid size (for error checking) + Control%isize = Hgrid%isize + Control%jsize = Hgrid%jsize + + ! Temp/Vel grid constants + call set_index_type ( nlpf, nlev, Hgrid%dlm, Hgrid%dph, Hgrid%Tmp, & + Control%Tmp, weight, sigma ) + call set_index_type ( nlpf, nlev, Hgrid%dlm, Hgrid%dph, Hgrid%Vel, & + Control%Vel, weight, sigma ) + + ! fourier transform initialization + call fft_init (Hgrid%nlon) + + ! trig constants for converting u,v to polar stereographic + allocate ( Control%slm(Control%Vel%isd:Control%Vel%ied), & + Control%clm(Control%Vel%isd:Control%Vel%ied) ) + do i = Control%Vel%isd, Control%Vel%ied + Control%slm(i) = sin( Hgrid%Vel%tlm(i) ) + Control%clm(i) = cos( Hgrid%Vel%tlm(i) ) + enddo + + ! initialize performance clock + if (do_clock_init) then + id_pfiltr = mpp_clock_id ('BGRID: polar_filter (TOTAL)', & + flags=MPP_CLOCK_SYNC, grain=CLOCK_ROUTINE) + do_clock_init = .false. + endif + +end subroutine polar_filter_init + +!======================================================================= + + subroutine set_index_type ( nlpf, nlev, dlm, dph, Grid, Index, weight, sigma ) + integer, intent(in) :: nlpf, nlev + real, intent(in) :: dlm, dph + type(bgrid_type), intent(in) :: Grid + type(pfilt_index_type), intent(inout) :: Index + integer, optional, intent(in) :: weight + logical, optional, intent(in) :: sigma + + integer :: leng, lenc, j, k + real :: hpi, rlat + + ! optional arguments + Index%weight = 1; if (present(weight)) Index%weight = weight + Index%sigma = .false.; if (present(sigma)) Index%sigma = sigma + + ! east-most box in zonal row needs one more point + ! this is used to store the latitude value + Index % rowend = Grid%ie == Grid%ieg + ! for full zonal rows + leng = Grid%ieg - Grid%isg + 1 + lenc = leng/2+1 + + Index % leng = leng + Index % lenc = lenc + + ! copy indexing for this domain + Index % is = Grid%is + Index % ie = Grid%ie + Index % js = Grid%js + Index % je = Grid%je + Index % isd = Grid%isd + Index % ied = Grid%ied + Index % jsd = Grid%jsd + Index % jed = Grid%jed + + ! reference latitude (first lat w/o filtering) + hpi = acos(0.0) + rlat = hpi - (float(nlpf)+0.50)*dph + Index % cph0 = cos(rlat) + + allocate ( Index%jpf(Index%js:Index%je), & + Index%cph(Index%js:Index%je) ) + do j = Index%js, Index%je + Index%jpf(j) = 0 ! jpf non-zero for filtered rows + if (j <= Grid%jsg+nlpf-1) Index%jpf(j) = -1 + if (j >= Grid%jeg-nlpf+1) Index%jpf(j) = +1 + Index%cph(j) = cos( Grid%tph(j) ) + enddo + + ! set trig constants for response function + allocate ( Index%sklm(lenc) ) + do k = 2, lenc + Index%sklm(k) = sin( 0.5*float(k-1)*dlm ) + enddo + + ! set domain types + call pf_domain_init ( nlpf, nlev, & + Grid%Domain, Index%Local%Domain, Index%Zonal%Domain ) + call mpp_get_data_domain ( Index%Local%Domain, & + Index%Local%isd, Index%Local%ied, & + Index%Local%jsd, Index%Local%jed ) + call mpp_get_data_domain ( Index%Zonal%Domain, & + Index%Zonal%isd, Index%Zonal%ied, & + Index%Zonal%jsd, Index%Zonal%jed ) + call pf_domain_init ( nlpf, nlev*2, & + Grid%Domain, Index%Local2%Domain, Index%Zonal2%Domain ) + call mpp_get_data_domain ( Index%Local2%Domain, & + Index%Local2%isd, Index%Local2%ied, & + Index%Local2%jsd, Index%Local2%jed ) + call mpp_get_data_domain ( Index%Zonal2%Domain, & + Index%Zonal2%isd, Index%Zonal2%ied, & + Index%Zonal2%jsd, Index%Zonal2%jed ) + + end subroutine set_index_type + +!======================================================================= + +subroutine pf_domain_init ( nlpf, nlev, Dom, Dom1, Dom2 ) +integer , intent(in) :: nlpf, nlev +type(domain2d), intent(in) :: Dom +type(domain2d), intent(inout) :: Dom1, Dom2 + +type(domain1d) :: Dx, Dy +integer, allocatable, dimension(:) :: xext, yext, yext1, ybeg, yend +logical, allocatable, dimension(:,:) :: mask +integer :: layout(2), nlon, nlat, npes, ndiv, lin, rem, n +integer :: isg, ieg, jsg, jeg, rows +logical :: mask_rows + + npes = mpp_npes() + +! get x/y extents + call mpp_get_domain_components ( Dom, Dx, Dy ) + call mpp_get_layout ( Dom, layout ) + allocate ( xext(layout(1)), yext(layout(2)) ) + allocate ( ybeg(layout(2)), yend(layout(2)) ) + call mpp_get_compute_domains ( Dx, size=xext ) + call mpp_get_compute_domains ( Dy, size=yext ) + call mpp_get_compute_domains ( Dy, begin=ybeg, end=yend ) + call mpp_get_global_domain ( Dom, isg, ieg, jsg, jeg, & + xsize=nlon, ysize=nlat ) + ! compute number of filtered rows per y-axis processor + mask_rows = .false. + do n = 1, layout(2) + rows = max(0, min(jsg+nlpf-1,yend(n))-max(jsg,ybeg(n))+1) + & + max(0, min(jeg,yend(n))-max(jeg-nlpf+1,ybeg(n))+1) + if (rows == 0) then + yext(n) = 1 ! one row minimum + mask_rows = .true. + else + yext(n) = rows*nlev + endif + enddo + xext(layout(1)) = xext(layout(1)) + 1 ! extra column will hold cos(lat) + !if (mpp_pe()==mpp_root_pe()) then + ! print *, 'layout = ', layout + ! print *, 'xext = ', xext + ! print *, 'yext = ', yext + !endif + +! define new domain for polar filter + call mpp_define_domains ( (/1,nlon+1,1,sum(yext)/), layout, Dom1, & + xflags = CYCLIC_GLOBAL_DOMAIN, & + xextent = xext, yextent = yext ) + !xextent = xext, yextent = yext, name = 'global' ) +!------------------------------------------------------ +! define zonal domain + ndiv = npes + if (mask_rows) ndiv = npes+1 ! setup extra division for masking rows + layout = (/ 1, ndiv /) ! one-dimensional decomposition + allocate ( yext1(ndiv), mask(layout(1),layout(2)) ) + yext1 = 0 + mask = .false. + +! determine number of rows per PE in each hemisphere +! this can only be done when running on multiple PEs + if (npes > 1) then + ! sh + lin = max(nlpf*nlev/((npes+1)/2), 1) + rem = max(nlpf*nlev - lin*((npes+1)/2), 0) + do n = 1, (npes+1)/2 + yext1(n) = lin + mask (1,n) = .true. + enddo + do n = 1, rem + yext1(n+1) = yext1(n+1) + 1 + enddo + ! nh + lin = max(nlpf*nlev/(npes/2), 1) + rem = max(nlpf*nlev - lin*(npes/2), 0) + do n = ndiv, ndiv-(npes/2)+1, -1 + yext1(n) = lin + mask (1,n) = .true. + enddo + do n = ndiv, ndiv-rem+1, -1 + yext1(n) = yext1(n) + 1 + enddo + ! non filtered row + if (mask_rows) then + lin = sum(yext1) + yext1((npes+1)/2+1) = sum(yext) - lin + endif + else +! special case for NPES=1 +! just copy original decomposition + yext1 = yext + mask = .true. + endif + + !if (mpp_pe()==mpp_root_pe()) then + ! do n = npes, 0, -1 + ! print *, 'yext1, mask = ', yext1(n+1), mask(1,n+1) + ! enddo + ! print *, 'sum(yext1) = ', sum(yext1) + !endif + + call mpp_define_domains ( (/1,nlon+1,1,sum(yext1)/), layout, Dom2, & + xflags = CYCLIC_GLOBAL_DOMAIN, & + yextent = yext1, maskmap = mask ) + !yextent = yext1, maskmap = mask, name = 'filter' ) + + deallocate ( xext, yext, yext1, mask ) + + end subroutine pf_domain_init + +!####################################################################### + +end module bgrid_polar_filter_mod + diff --git a/MOM_code/src/atmos_bgrid/tools/bgrid_prog_var.F90 b/MOM_code/src/atmos_bgrid/tools/bgrid_prog_var.F90 new file mode 100644 index 0000000..fe6302b --- /dev/null +++ b/MOM_code/src/atmos_bgrid/tools/bgrid_prog_var.F90 @@ -0,0 +1,802 @@ + +module bgrid_prog_var_mod + +!----------------------------------------------------------------------- +! +! allocates memory for B-grid core prognostics variables +! and provides several routines for handling these variables +! +! the module has routines for: +! 1) setting up the prognostic variables in a data structure +! 2) performing simple arithmetic with this data structure +! 3) applying forward explicit time differencing +! 4) reading and writing prognostic variable restart files +! +!----------------------------------------------------------------------- + +use bgrid_horiz_mod, only: horiz_grid_type +use bgrid_vert_mod, only: vert_grid_type +use bgrid_masks_mod, only: grid_mask_type +use bgrid_halo_mod, only: update_halo, TEMP, UWND, VWND +use bgrid_cold_start_mod, only: cold_start_resol, cold_start +use fms_mod, only: file_exist, open_restart_file, mpp_error, & + FATAL, close_file, mpp_pe, mpp_root_pe, & + set_domain, read_data, write_data, & + write_version_number, nullify_domain, & + field_size, NOTE, mpp_chksum, & + error_mesg, FATAL, stdout, stdlog, & + uppercase +use field_manager_mod, only: MODEL_ATMOS +use tracer_manager_mod, only: get_tracer_names, set_tracer_profile + +use platform_mod, only: I8_KIND + +implicit none +private + +public :: prog_var_type, prog_var_init, var_init, & + prog_var_time_diff, prog_var_times_scalar, & + prog_var_equals_scalar +public :: open_prog_var_file, read_prog_var, write_prog_var + +!----------------------------------------------------------------------- +! type(prog_var_type) +! data structure that contains all prognostic fields and tracers +! +! nlon = size of the global x-axis compute grid +! (i.e., number of longitude points) +! nlat = size of the global y-axis compute grid +! (i.e., number of latitude points) +! nlev = number of vertical levels +! ntrace = number of tracers (in the current data structure) +! +! ilb, iub = lower and upper index bounds of x-axis (data domain) +! jlb, jub = lower and upper index bounds of y-axis (data domain) +! klb, kub = lower and upper index bounds of k-axis +! +! arrays with dimension(ilb:iub,jlb:jub) +! ps = surface pressure +! pssl = surface pressure adjusted to eta=1. (for eta coordinate) +! +! arrays with dimension(ilb:iub,jlb:jub,klb:kub) +! u = zonal wind component +! v = meridional wind component +! t = temperature +! +! arrays with dimension(ilb:iub,jlb:jub,klb:kub,1:ntrace) +! r = arbitrary number of tracers +! +!----------------------------------------------------------------------- + +type prog_var_type + integer :: nlon, nlat, nlev, ntrace + integer :: ilb, iub, jlb, jub, klb, kub + real, pointer :: ps(:,:) =>NULL(), & + pssl(:,:) =>NULL() + real, pointer :: u(:,:,:) =>NULL(), & + v(:,:,:) =>NULL(), & + t(:,:,:) =>NULL(), & + r(:,:,:,:) =>NULL() +end type prog_var_type + +! overloaded interface for initializing real model arrays +interface var_init + module procedure var_init_type_4d, var_init_bound_4d, & + var_init_type_3d, var_init_bound_3d, & + var_init_type_2d, var_init_bound_2d +end interface + +!----------------------------------------------------------------------- +! private data + +logical :: do_log = .true. +character(len=128) :: version='$Id: bgrid_prog_var.F90,v 13.0 2006/03/28 21:05:18 fms Exp $' +character(len=128) :: tagname='$Name: tikal $' + +integer :: unit_in +character(len=128) :: directory_in +logical :: read_pssl +logical :: old_restart_format, do_cold_start + +character(len=64) :: res_file_name = 'bgrid_prog_var.res' + +character(len=80) :: restart_format = & + 'bgrid grid atmospheric dynamical core: restart format 05' + +contains + +!####################################################################### +! creates a prog_var_type variable + + subroutine prog_var_init (Hgrid, nlev, ntrs, Vars) + + type(horiz_grid_type), intent(in) :: Hgrid + integer, intent(in) :: nlev, ntrs + type(prog_var_type) , intent(inout) :: Vars +!----------------------------------------------------------------------- +! write version info to logfile + if (do_log) then + call write_version_number (version,tagname) + do_log = .false. + endif + +! all arrays have the same horizontal dimensions regardless of +! whether the field is on the temperature or velocity grid + + Vars % ilb = Hgrid % ilb + Vars % iub = Hgrid % iub + Vars % jlb = Hgrid % jlb + Vars % jub = Hgrid % jub + Vars % klb = 1 + Vars % kub = nlev + + Vars % nlon = Hgrid % nlon + Vars % nlat = Hgrid % nlat + Vars % nlev = nlev + Vars % ntrace = ntrs + + Vars % ps => var_init_bound_2d (Vars % ilb, Vars % iub, & + Vars % jlb, Vars % jub) + + Vars % pssl => var_init_bound_2d (Vars % ilb, Vars % iub, & + Vars % jlb, Vars % jub) + + Vars % u => var_init_bound_3d (Vars % ilb, Vars % iub, & + Vars % jlb, Vars % jub, & + nlev) + Vars % v => var_init_bound_3d (Vars % ilb, Vars % iub, & + Vars % jlb, Vars % jub, & + nlev) + Vars % t => var_init_bound_3d (Vars % ilb, Vars % iub, & + Vars % jlb, Vars % jub, & + nlev) + Vars % r => var_init_bound_4d (Vars % ilb, Vars % iub, & + Vars % jlb, Vars % jub, & + nlev, ntrs) + + end subroutine prog_var_init + +!####################################################################### +!##### overloaded functions that allocate a single real variable ####### +!####################################################################### +! +! variables must be declard as pointers +! real, pointer :: field(:,:,:) +! field => var_init (Hgrid,nlev) +! +!####################################################################### + + function var_init_bound_2d (ilb, iub, jlb, jub) result (var) + + integer, intent(in) :: ilb, iub, jlb, jub + real, dimension(:,:), pointer :: var + + allocate ( var (ilb:iub, jlb:jub) ) + var = 0.0 + + end function var_init_bound_2d + +!####################################################################### + + function var_init_type_2d (Hgrid) result (var) + + type(horiz_grid_type), intent(in) :: Hgrid + real, dimension(:,:), pointer :: var + + var => var_init_bound_2d (Hgrid % ilb, Hgrid % iub, & + Hgrid % jlb, Hgrid % jub) + + end function var_init_type_2d + +!####################################################################### + + function var_init_bound_3d (ilb, iub, jlb, jub, kdim) result (var) + + integer, intent(in) :: ilb, iub, jlb, jub, kdim + real, dimension(:,:,:), pointer :: var + + allocate ( var (ilb:iub, jlb:jub, 1:kdim) ) + var = 0.0 + + end function var_init_bound_3d + +!####################################################################### + + function var_init_type_3d (Hgrid, kdim) result (var) + + type(horiz_grid_type), intent(in) :: Hgrid + integer, intent(in) :: kdim + real, dimension(:,:,:), pointer :: var + + var => var_init_bound_3d (Hgrid % ilb, Hgrid % iub, & + Hgrid % jlb, Hgrid % jub, kdim) + + end function var_init_type_3d + +!####################################################################### + + function var_init_bound_4d (ilb, iub, jlb, jub, kdim, ntrace) result (var) + + integer, intent(in) :: ilb, iub, jlb, jub, kdim, ntrace + real, dimension(:,:,:,:), pointer :: var + + allocate ( var (ilb:iub, jlb:jub, 1:kdim, 1:ntrace) ) + var = 0.0 + + end function var_init_bound_4d + +!####################################################################### + + function var_init_type_4d (Hgrid, kdim, ntrace) result (var) + + type(horiz_grid_type), intent(in) :: Hgrid + integer, intent(in) :: kdim, ntrace + real, dimension(:,:,:,:), pointer :: var + + var => var_init_bound_4d (Hgrid % ilb, Hgrid % iub, & + Hgrid % jlb, Hgrid % jub, kdim, ntrace) + + end function var_init_type_4d + +!####################################################################### +!####################################################################### +! sets all prognostic variables to a scalar + + subroutine prog_var_equals_scalar (Var, scalar) + + type(prog_var_type), intent(inout) :: Var + real , intent(in) :: scalar + + Var % u = scalar + Var % v = scalar + Var % t = scalar + Var % r = scalar + Var % ps = scalar + Var % pssl = scalar + + end subroutine prog_var_equals_scalar + +!####################################################################### +! multiplies all prognostic variables by a scalar + + subroutine prog_var_times_scalar (Var, scalar) + + type(prog_var_type), intent(inout) :: Var + real , intent(in) :: scalar + + Var % u = Var % u * scalar + Var % v = Var % v * scalar + Var % t = Var % t * scalar + Var % r = Var % r * scalar + Var % ps = Var % ps * scalar + Var % pssl = Var % pssl * scalar + + end subroutine prog_var_times_scalar + +!####################################################################### +! performs time differencing on all prognostic variables +! Var = Var + dt * Var_dt +! all tracers are used unless argument nt is supplied + + subroutine prog_var_time_diff (dt, Masks, Var_dt, Var, nt) + + real, intent(in) :: dt + type(grid_mask_type), intent(in) :: Masks + type(prog_var_type), intent(inout) :: Var_dt, Var + integer, optional, intent(in) :: nt + + integer :: ntp, i, j, k + +!----- explicit differencing with two time levels ----- + + ntp = Var_dt % ntrace + if (present(nt)) ntp = min(Var_dt%ntrace, nt) + + Var % ps = Var % ps + dt * Var_dt % ps + Var % pssl = Var % pssl + dt * Var_dt % pssl + + Var % u = Var % u + dt * Var_dt % u + Var % v = Var % v + dt * Var_dt % v + Var % t = Var % t + dt * Var_dt % t + + Var % r(:,:,:,1:ntp) = Var % r(:,:,:,1:ntp) + & + dt * Var_dt % r(:,:,:,1:ntp) + + ! apply mask for step-mountain + if (.not.Masks%sigma) then + do k = Var%klb, Var%kub + do j = Var%jlb, Var%jub + do i = Var%ilb, Var%iub + if (Masks%Vel%mask(i,j,k) < .01) then + Var % u (i,j,k) = 0. + Var % v (i,j,k) = 0. + endif + ! temp & tracers + if (Masks%Tmp%mask(i,j,k) < .01) then + Var % t (i,j,k) = 0. + Var % r (i,j,k,1:ntp) = 0. + endif + enddo + enddo + enddo + endif + +!----- zero out tendencies ----- + + Var_dt % ps = 0.0 + Var_dt % pssl = 0.0 + + Var_dt % u = 0.0 + Var_dt % v = 0.0 + Var_dt % t = 0.0 + + Var_dt % r(:,:,:,1:ntp) = 0.0 + + + end subroutine prog_var_time_diff + +!####################################################################### +!########## routines for reading and writing restart files ############# +!####################################################################### + +subroutine open_prog_var_file ( ix, jx, kx, dir ) + +!----------------------------------------------------------------------- +! This routine can open for reading either a NATIVE or NETCDF restart +! file. Only the model resolution is returned. A subsequent call to +! read_prog_var is needed to read the data. +! The restart file is called "INPUT/bgrid_prog_var.res". +! For NetCDF files a ".nc" suffix is added. +! +! ix, jx, kx = global resolution read from the restart file +! dir = directory where input restart files reside +! for the current directory use: "" or "." +! default: "INPUT" +!----------------------------------------------------------------------- + integer, intent(out) :: ix, jx, kx + character(len=*), intent(in), optional :: dir + + integer :: ic, vers, day, sec, ntsd, nt, ntp, siz(4) + character(len=128) :: filename_in + character(len=80) :: control + character(len=2) :: avers + +! write version info to logfile + if (do_log) then + call write_version_number (version,tagname) + do_log = .false. + endif + +! set-up restart directory and file name + directory_in = 'INPUT/' + if (present(dir)) then + if (len_trim(dir) > 0) then + directory_in = trim(dir)//"/" + else + directory_in = '' ! null string + endif + endif + + filename_in = trim(directory_in)//trim(res_file_name) + +! when restart file does not exist +! set up simple initial conditions + + if (file_exist(trim(filename_in)//'.nc') ) then + call field_size (trim(filename_in)//'.nc', 't', siz ) + ix = siz(1); jx = siz(2); kx = siz(3) + if (min(ix,jx,kx) <= 0) call mpp_error ('bgrid_prog_var_mod', & + 'problem reading field size; siz <= 0', FATAL) + old_restart_format = .false. + do_cold_start = .false. + if (mpp_pe() == mpp_root_pe()) call mpp_error ('bgrid_prog_var_mod', & + 'Reading NetCDF formatted restart file.', NOTE) + +! old native format restart files + else if (file_exist(trim(filename_in)) ) then + + ! open restart file and get restart version number + ! if control record cannot be read then file uses older format (1 or 2) + unit_in = open_restart_file ( trim(filename_in), 'read' ) + old_restart_format = .true. + do_cold_start = .false. + if (mpp_pe() == mpp_root_pe()) call mpp_error ('bgrid_prog_var_mod', & + 'Reading native formatted restart file.', NOTE) + read (unit_in,err=2) control + + ! extract version number + ic = index(control,'restart format ') + if (ic == 0) call mpp_error ('bgrid_prog_var_mod', & + 'problem extracting restart version number', FATAL) + avers = control(ic+15:ic+16) + read (avers,'(i2.2)') vers + go to 3 + + ! read version number from old format (first rewind file) + 2 rewind (unit_in) + read (unit_in) vers + write (avers,'(i2.2)') vers + + ! read first (non-control) record of restart file + ! note: ntsd,day,sec are no longer used and + ! number of time levels (nvar) is not read or used + 3 continue + select case (vers) + case (1:2) + read (unit_in) ntsd, day, sec, ix, jx, kx, nt, ntp + read_pssl = .false. + case (3) + read (unit_in) ntsd, day, sec, ix, jx, kx, nt, ntp + read_pssl = .true. + case (4) + read (unit_in) ix, jx, kx, nt, ntp + read_pssl = .true. + case (5) + read (unit_in) ix, jx, kx + read_pssl = .true. + case default + call mpp_error ('bgrid_prog_var_mod', & + 'cannot not read old restart version '//avers, FATAL) + end select + +! no restart --> self start + else + call cold_start_resol ( ix, jx, kx ) + do_cold_start = .true. + read_pssl = .false. + return + endif + +end subroutine open_prog_var_file + +!####################################################################### + +subroutine read_prog_var (Hgrid, Var, eta, peta, fis, res) + +!----------------------------------------------------------------------- +! This routine can read either a NATIVE or NETCDF restart file. +! +! Hgrid = horizontal grid constants +! Var = prognostic variables +! eta = sigma/eta/bk values at model layer interfaces (half levels) +! peta = reference pressures (pk) at model layer interfaces +! fis = geopotential height of the surface +! res = reciprocal of eta at the surface +!----------------------------------------------------------------------- + type(horiz_grid_type), intent(inout) :: Hgrid + type (prog_var_type), intent(inout) :: Var + real, intent(out), dimension(:) :: eta, peta + real, intent(out), dimension(Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub) :: fis, res + integer :: n, unit, siz(4) + integer :: isd,ied,vsd,ved + character(len=64) :: tr_name + character(len=128) :: filename_in + real :: tr_surf, tr_mult + logical :: found + +! set-up file name + filename_in = trim(directory_in)//trim(res_file_name) + if (.not.old_restart_format) filename_in = trim(filename_in)//'.nc' + + if (do_cold_start) then + + ! set up simple initial conditions + ! when restart file does not exist + + call cold_start ( Hgrid, eta, peta, fis, res, Var%ps, Var%pssl, & + Var%u, Var%v, Var%t ) + else + + ! must pass fields to read_data on data domain + ! mass fields are on data domain + ! set up indexing for velocity fields on data domain + + isd = Hgrid%Vel%isd; ied = Hgrid%Vel%ied + vsd = Hgrid%Vel%jsd; ved = Hgrid%Vel%jed + + ! read non-distributed data from root pe (vertical coordinate info) + if (old_restart_format) then + read (unit_in) eta, peta + else + call nullify_domain () + call read_data ( filename_in, 'eta', eta ) + call read_data ( filename_in, 'peta', peta ) + endif + + ! --- read variables --- + + ! initialize domain for temperature grid + ! read surf pres, topog, and more + + if (old_restart_format) then + call set_domain ( Hgrid%Tmp%Domain ) + call read_data ( unit_in, Var%ps ) + if (read_pssl) & + call read_data ( unit_in, Var%pssl) + call read_data ( unit_in, res ) + call read_data ( unit_in, fis ) + else + call read_data ( filename_in, 'ps' , Var%ps , Hgrid%Tmp%Domain ) + if (read_pssl) & + call read_data ( filename_in, 'pssl', Var%pssl, Hgrid%Tmp%Domain ) + call read_data ( filename_in, 'res' , res , Hgrid%Tmp%Domain ) + call read_data ( filename_in, 'fis' , fis , Hgrid%Tmp%Domain ) + endif + + ! initialize domain for velocity grid + ! read u and v wind components + + ! pass velocity fields on data domain + if (old_restart_format) then + call set_domain ( Hgrid%Vel%Domain ) + call read_data ( unit_in, Var%u(isd:ied,vsd:ved,:) ) + call read_data ( unit_in, Var%v(isd:ied,vsd:ved,:) ) + else + call read_data ( filename_in, 'u', Var%u(isd:ied,vsd:ved,:), Hgrid%Vel%Domain ) + call read_data ( filename_in, 'v', Var%v(isd:ied,vsd:ved,:), Hgrid%Vel%Domain ) + endif + + ! re-initialize domain for temperature grid + ! read temperature and tracers + if (old_restart_format) then + call set_domain ( Hgrid%Tmp%Domain ) + call read_data ( unit_in, Var%t ) + call close_file (unit_in) ! done reading B-grid dynamics restart + else + call read_data ( filename_in, 't', Var%t, Hgrid%Tmp%Domain ) + endif + + endif + +! read single tracer restart file + + filename_in = trim(directory_in)//'atmos_tracers.res.nc' + + if (file_exist(trim(filename_in))) then + do n = 1, Var%ntrace + call get_tracer_names ( MODEL_ATMOS, n, tr_name ) + call field_size (trim(filename_in), tr_name, siz, field_found=found) + if (found) then + if (siz(1) == Hgrid%nlon .and. siz(2) == Hgrid%nlat .and. siz(3) == size(eta(:))-1) then + call read_data (trim(filename_in), tr_name, Var%r(:,:,:,n), Hgrid%Tmp%Domain) + else + call error_mesg ('bgrid_prog_var_mod','can not read tracers with wrong size', FATAL) + endif + else + ! initialize new tracers (apply surface value only) + call set_tracer_profile ( MODEL_ATMOS, n, Var%r(:,:,:,n) ) + endif + enddo + else + + ! old format + ! read separate tracer restart files + do n = 1, Var%ntrace + call get_tracer_names ( MODEL_ATMOS, n, tr_name ) + filename_in = trim(directory_in)//'tracer_'//trim(tr_name)//'.res' + + if (file_exist(trim(filename_in))) then + unit = open_restart_file( trim(filename_in), 'read' ) + call set_domain ( Hgrid%Tmp%Domain ) + call read_data ( unit, Var%r(:,:,:,n) ) + call close_file (unit) + else + ! initialize new tracers (apply surface value only) + call set_tracer_profile ( MODEL_ATMOS, n, Var%r(:,:,:,n) ) + endif + enddo + + endif + +! update all boundaries for restart variables + + call update_halo (Hgrid, TEMP, res) + call update_halo (Hgrid, TEMP, fis) + call update_halo (Hgrid, TEMP, Var%ps) + if (read_pssl) & + call update_halo (Hgrid, TEMP, Var%pssl) + call update_halo (Hgrid, TEMP, Var%t) + call update_halo (Hgrid, TEMP, Var%r) + call update_halo (Hgrid, UWND, Var%u) + call update_halo (Hgrid, VWND, Var%v) + +! for old restart formats, initialize pssl + if (.not.read_pssl) Var%pssl = Var%ps * res + +! check sum input data + call print_check_sum ('Check sums for B-grid input data:', & + Hgrid, Var, eta, peta, fis, res) + +end subroutine read_prog_var + +!####################################################################### +! writes a B-grid core restart file named "RESTART/bgrid_prog_var.res" +! For NetCDF files a ".nc" suffix is added. + + subroutine write_prog_var (Var, Hgrid, Vgrid, fis, res, dir, format) + +!----------------------------------------------------------------------- +! Var = prognostic variables +! Hgrid = horizontal grid constants +! Vgrid = vertical grid constants +! fis = geopotential height of the surface +! res = reciprocal of eta at the surface +! dir = directory where output restart files will be written +! for the current directory use: "" or "." +! default: "RESTART" +! format = file format, either: NATIVE or NETCDF +!----------------------------------------------------------------------- + type (prog_var_type), intent(in) :: Var + type(horiz_grid_type), intent(in) :: Hgrid + type (vert_grid_type), intent(in) :: Vgrid + real, intent(in), dimension(Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub) :: fis, res + character(len=*), intent(in), optional :: dir, format + + integer :: n, unit + integer :: isd,ied, vsd,ved + character(len=8) :: oform + character(len=64) :: tr_name + character(len=128) :: directory, restart_name + logical :: use_old_format + +!----------------------------------------------------------------------- +! output format + oform = 'NETCDF'; if (present(format)) oform = format + if (trim(uppercase(oform)) == 'NATIVE') then + use_old_format = .true. + else if (trim(uppercase(oform)) == 'NETCDF') then + use_old_format = .false. + else + call error_mesg ('write_prog_var', & + 'invalid value for optional argument format', FATAL) + endif + +! check sum output data + call print_check_sum ('Check sums for B-grid output data:', & + Hgrid, Var, Vgrid%eta, Vgrid%peta, fis, res) + +! set-up restart file name + directory = 'RESTART/' + if (present(dir)) then + if (len_trim(dir) > 0) then + directory = trim(dir)//'/' ! append / + else + directory = '' ! cwd + endif + endif + + restart_name = trim(directory)//trim(res_file_name) + +! open output restart file + if (use_old_format) then + unit = open_restart_file ( trim(restart_name), 'write' ) + ! write non-distributed data from root pe + if ( mpp_pe() == mpp_root_pe() ) then + write (unit) restart_format + write (unit) Hgrid%nlon, Hgrid%nlat, Vgrid%nlev + write (unit) Vgrid%eta, Vgrid%peta ! vertical coordinate info + endif + else +! netcdf format + restart_name = trim(restart_name)//'.nc' ! add netcdf file suffix + call nullify_domain () + call write_data ( restart_name, 'eta', Vgrid%eta ) + call write_data ( restart_name, 'peta', Vgrid%peta ) + endif + +! must pass fields to write_data on data domain +! mass fields are on data domain +! set up indexing for velocity fields on data domain + + isd = Hgrid%Vel%isd; ied = Hgrid%Vel%ied + vsd = Hgrid%Vel%jsd; ved = Hgrid%Vel%jed + +! output 2d-fields on mass grid (surf pres, topog) + if (use_old_format) then + call set_domain ( Hgrid%Tmp%Domain ) + call write_data ( unit, Var%ps ) + call write_data ( unit, Var%pssl) + call write_data ( unit, res ) + call write_data ( unit, fis ) + else + call write_data ( restart_name, 'ps', Var%ps , Hgrid%Tmp%Domain ) + call write_data ( restart_name, 'pssl', Var%pssl, Hgrid%Tmp%Domain ) + call write_data ( restart_name, 'res', res , Hgrid%Tmp%Domain ) + call write_data ( restart_name, 'fis', fis , Hgrid%Tmp%Domain ) + endif + +! output 3d-fields on velocity grid (u,v) +! pass velocity fields on data domain + if (use_old_format) then + call set_domain ( Hgrid%Vel%Domain ) + call write_data ( unit, Var%u(isd:ied,vsd:ved,:) ) + call write_data ( unit, Var%v(isd:ied,vsd:ved,:) ) + else + call write_data ( restart_name, 'u', Var%u(isd:ied,vsd:ved,:), Hgrid%Vel%Domain ) + call write_data ( restart_name, 'v', Var%v(isd:ied,vsd:ved,:), Hgrid%Vel%Domain ) + endif + +! output 3d temperature field + if (use_old_format) then + ! re-initialize domain for temperature grid (save temp and tracers) + call set_domain ( Hgrid%Tmp%Domain ) + call write_data ( unit, Var%t ) + ! done writing B-grid dynamics restart + call close_file ( unit ) + else + call write_data ( restart_name, 't', Var%t, Hgrid%Tmp%Domain ) + endif + +! write tracer restart file(s) + do n = 1, Var%ntrace + call get_tracer_names ( MODEL_ATMOS, n, tr_name ) + if (use_old_format) then + ! write separate files when using old format + restart_name = trim(directory)//'tracer_'//trim(tr_name)//'.res' + unit = open_restart_file( trim(restart_name), 'write' ) + call write_data ( unit, Var%r(:,:,:,n) ) + call close_file ( unit ) + else + ! write single netcdf tracer file + restart_name = trim(directory)//'atmos_tracers.res.nc' + call write_data ( trim(restart_name), trim(tr_name), & + Var%r(:,:,:,n), Hgrid%Tmp%Domain ) + endif + enddo + + end subroutine write_prog_var + +!####################################################################### + +subroutine print_check_sum (label, Hgrid, Var, eta, peta, fis, res, unit) + + character(len=*), intent(in) :: label + type(horiz_grid_type), intent(in) :: Hgrid + type (prog_var_type), intent(in) :: Var + real, intent(in), dimension(:) :: eta, peta + real, intent(in), dimension(Hgrid%ilb:Hgrid%iub, & + Hgrid%jlb:Hgrid%jub) :: fis, res + integer, intent(in), optional :: unit + integer :: n, chksum_unit + integer :: is, ie, hs, he, vs, ve + integer(I8_KIND) :: zsum + + chksum_unit = stdout() + if (present(unit)) chksum_unit = unit + + is = Hgrid%Tmp%is; ie = Hgrid%Tmp%ie + hs = Hgrid%Tmp%js; he = Hgrid%Tmp%je + vs = Hgrid%Vel%js; ve = Hgrid%Vel%je + + if (mpp_pe() == mpp_root_pe()) write (chksum_unit,'(/a)') trim(label) +! sum all restart variables (except eta,peta) + zsum = mpp_chksum(fis (is:ie,hs:he)) + if (mpp_pe() == mpp_root_pe()) write (chksum_unit,10) '(fis)',zsum + zsum = mpp_chksum(res (is:ie,hs:he)) + if (mpp_pe() == mpp_root_pe()) write (chksum_unit,10) '(res)',zsum + zsum = mpp_chksum(Var%ps (is:ie,hs:he)) + if (mpp_pe() == mpp_root_pe()) write (chksum_unit,10) '(ps)',zsum + zsum = mpp_chksum(Var%pssl(is:ie,hs:he)) + if (mpp_pe() == mpp_root_pe()) write (chksum_unit,10) '(pssl)',zsum + zsum = mpp_chksum(Var%t(is:ie,hs:he,:)) + if (mpp_pe() == mpp_root_pe()) write (chksum_unit,10) '(t)',zsum + zsum = mpp_chksum(Var%u(is:ie,vs:ve,:)) + if (mpp_pe() == mpp_root_pe()) write (chksum_unit,10) '(u)',zsum + zsum = mpp_chksum(Var%v(is:ie,vs:ve,:)) + if (mpp_pe() == mpp_root_pe()) write (chksum_unit,10) '(v)',zsum + zsum = 0 +! sum of all tracers + do n = 1, Var%ntrace + zsum = zsum + mpp_chksum(Var%r(is:ie,hs:he,:,n)) + enddo + if (mpp_pe() == mpp_root_pe()) write (chksum_unit,10) '(r)',zsum +10 format ('chksum',a6,' = ',z16) + +end subroutine print_check_sum + +!####################################################################### + +end module bgrid_prog_var_mod + diff --git a/MOM_code/src/atmos_bgrid/tools/bgrid_vert.F90 b/MOM_code/src/atmos_bgrid/tools/bgrid_vert.F90 new file mode 100644 index 0000000..f06d723 --- /dev/null +++ b/MOM_code/src/atmos_bgrid/tools/bgrid_vert.F90 @@ -0,0 +1,786 @@ + +module bgrid_vert_mod + +!----------------------------------------------------------------------- +! +! allocates memory and initializes vertical grid constants +! +! contains interfaces for computing pressure and height +! +!----------------------------------------------------------------------- + +use constants_mod, only: GRAV, RDGAS, RVGAS +use fms_mod, only: mpp_pe, mpp_root_pe, error_mesg, FATAL, & + write_version_number, stdlog, & + mpp_clock_id, mpp_clock_begin, mpp_clock_end, & + MPP_CLOCK_SYNC, CLOCK_ROUTINE, CLOCK_LOOP + +implicit none +private + +!----------------------------------------------------------------------- +! public derived data type (vert_grid_type) +! ----------------------------------------- +! nlev = number of vertical levels (integer) +! nplev = number of pure pressure levels at the top of the model, +! will equal zero when not using hybrid coordinate (integer) +! +! deta = sigma (aka eta) thicknesses of model layers +! eta = sigma (aka eta, bk) values at model layer interfaces (half levels) +! peta = reference pressure (pk) values at model layer interfaces +! dpeta = reference pressure thicknesses of model layers +! +! **** Note: pfull, phalf, fhalf are based on a SLP=101325. **** +! pfull = pressure profile at model levels (full levels) +! phalf = pressure profile at model layer interfaces (half levels) +! fhalf = profile of geopotental height at half levels +! +! wta,wtb = weights used to determine values at model levels +! (based on pressure profile, useful for hybrid coord) +! +! psmin = minimum allowable surface pressure to avoid negative +! mass in a model layer (important for hybrid coord) +! hybrid = logical flag (true for hybrid coordinate) +! pzero = logical flag (true for pres = 0 at top of model) +! pref,tref,gamma = reference values for computing fhalf +! +! +! public interfaces +! ----------------- +! vert_grid_init - initializes vert_grid_type data +! +! compute_pres_depth - computes pressure depth (mass) of model layers +! compute_pres_full - computes pressure at full model levels +! compute_pres_half - computes pressure at half model levels +! compute_height - computes geopotential height (in meters) at half model levels +! compute_geop_height - computes geopotential height (in m2/s2) +! compute_pres_weights - computes wta & wtb +! compute_pressure - computes pressure at full and half levels +! compute_height_bottom - computes height at the lowest model level +! +!----------------------------------------------------------------------- +!------- interfaces ------- + +public vert_grid_init, compute_geop_height, compute_height, & + compute_pres_depth, compute_pres_full, compute_pres_half, & + compute_pres_weights, compute_pressures, compute_height_bottom + +!------- public defined data type ------- + +public vert_grid_type + +type vert_grid_type + integer :: nlev, nplev + real, pointer, dimension(:) :: deta =>NULL(), & + eta =>NULL(), & + fhalf =>NULL(), & + dpeta =>NULL(), & + pfull =>NULL(), & + phalf =>NULL(), & + peta =>NULL(), & + wta =>NULL(), & + wtb =>NULL() + real :: pref, tref, gamma, psmin + logical :: hybrid, pzero +end type vert_grid_type + +!----------------------------------------------------------------------- + + real, parameter :: d608 = (RVGAS-RDGAS)/RDGAS + real, parameter :: ginv = 1./GRAV + +!------ parameters for eta coordinate reference surface heights -------- + + real, parameter :: pref = 101325., tref = 288., gamma = 0.0065 + +!------ parameters for performance timing of code sections ----- + + logical :: do_clock_init = .true. + integer, dimension(7) :: id + character(len=16), dimension(7) :: & + names = (/ 'comp_pres_depth ', & + 'comp_pres_full ', & + 'comp_pressures ', & + 'comp_pres_half ', & + 'comp_pres_wghts ', & + 'comp_geop_hght ', & + 'comp_height_btm ' /) + +!----------------------------------------------------------------------- + character(len=128) :: version = '$Id: bgrid_vert.F90,v 19.0 2012/01/06 19:55:18 fms Exp $' + character(len=128) :: tagname = '$Name: tikal $' +!----------------------------------------------------------------------- + +contains + +!####################################################################### + +subroutine vert_grid_init ( Vgrid, eta, peta, verbose ) + +!----------------------------------------------------------------------- +! Vgrid = vertical grid constants +! eta = sigma (aka eta,bk) values at model layer interfaces +! the number of model levels will be "size(eta)-1" +! peta = reference pressures (aka pk) at model layer interfaces +! if specified and non-zero then hybrid coord is used +! default: peta=0. +! verbose = controls the amount of printed output +! possible values are verbose=0,1,2 +! default: verbose=1 +!----------------------------------------------------------------------- + + type(vert_grid_type), intent(inout) :: Vgrid + real, intent (in) :: eta(:) + real, intent (in), optional :: peta(:) + integer, intent (in), optional :: verbose + +!----------------------------------------------------------------------- +integer :: k, nlev, lverbose, logunit +real :: rgog +real, dimension(size(eta(:))) :: lphalf, pres +real, dimension(size(eta(:))-1) :: lpfull + +!----------------------------------------------------------------------- + + lverbose = 1; if (present(verbose)) lverbose = verbose + +!--------------derived vertical constants------------------------------- + + nlev = size(eta(:)) - 1 + allocate (Vgrid% deta(nlev), Vgrid% eta(nlev+1), & + Vgrid%dpeta(nlev), Vgrid%pfull(nlev), Vgrid%peta(nlev+1), & + Vgrid%wta (nlev), Vgrid%wtb (nlev), & + Vgrid%phalf(nlev+1), Vgrid% fhalf(nlev+1)) + + Vgrid % nlev = nlev + +!--------- set-up eta values and hybrid pressure levels ---------- +!--------- note: eta(1) and eta(nlev+1) have set values ----- +!--------- also note: peta(nlev+1) = 0.0 ----- + + Vgrid % eta(1) = 0.0 + Vgrid % eta(nlev+1) = 1.0 + Vgrid % eta(2:nlev) = eta(2:nlev) + + Vgrid % peta = 0.0 + if (present(peta)) Vgrid % peta(1:nlev) = peta(1:nlev) + + do k = 1, nlev + Vgrid % deta(k) = Vgrid % eta(k+1) - Vgrid % eta(k) + Vgrid % dpeta(k) = Vgrid % peta(k+1) - Vgrid % peta(k) + Vgrid % pfull(k) = 0.0 + Vgrid % wta (k) = 0.0 + Vgrid % wtb (k) = 0.0 + enddo + +!----------- is this a hybrid coordinate ??? ----- + + Vgrid % hybrid = .false. + + do k = 1, nlev+1 + if ( Vgrid % peta(k) > 0.0 ) then + Vgrid % hybrid = .true. + exit + endif + enddo + +!----------- find lowest pure pressure level -------------- + + Vgrid % nplev = 0 + + do k = 1, nlev + if ( Vgrid % deta(k) > 0.0 ) exit + Vgrid % nplev = k + enddo + +! ---- need average pressure in these layers ---- + + Vgrid % pzero = .true. + + !if ( Vgrid % nplev >= 1 ) then + Vgrid % phalf(:) = Vgrid%peta(:) + Vgrid%eta(:)*pref + if ( Vgrid % phalf(1) <= epsilon(Vgrid % phalf) ) then + lphalf(1) = 0.0 + lphalf(2:) = log(Vgrid % phalf(2:)) + else + lphalf(:) = log(Vgrid % phalf(:)) + Vgrid % pzero = .false. + endif + + do k = 1, nlev + lpfull(k) = (Vgrid%phalf(k+1)*lphalf(k+1) - Vgrid%phalf(k)*lphalf(k)) & + / (Vgrid%phalf(k+1)-Vgrid%phalf(k)) - 1.0 + Vgrid % pfull(k) = exp(lpfull(k)) + Vgrid % wtb (k) = lphalf(k+1) - lpfull(k) + Vgrid % wta (k) = lpfull(k) - lphalf(k) + enddo + if (Vgrid % pzero) Vgrid % wta(1) =Vgrid % wtb(1) + + !endif + +!----------- find the minimum allowable surface pressure ------ + + Vgrid % psmin = 0.0 + + do k = 1, nlev + if ( Vgrid % deta(k) > 0.0 ) Vgrid % psmin = & + max ( Vgrid % psmin, -Vgrid % dpeta(k)/Vgrid % deta(k) ) + enddo + + +!---------- set-up eta coordinate geopotential heights ------------- + + rgog = RDGAS*gamma/GRAV + + do k=1,nlev + pres(k) = Vgrid%peta(k) + Vgrid%eta(k)*pref + Vgrid % fhalf(k) = GRAV*tref*(1.0-(pres(k)/pref)**rgog)/gamma + enddo + Vgrid % fhalf(nlev+1) = 0.0 + + Vgrid % pref = pref + Vgrid % tref = tref + Vgrid % gamma = gamma + +!--- write version info to logfile --- + call write_version_number (version, tagname) + +!--- optional output of coordinate values ---- + logunit= stdlog() + if (mpp_pe() == mpp_root_pe()) then + if (lverbose > 0) then + write (logunit,*) 'Number of vertical levels =', Vgrid%nlev + write (logunit,*) 'Approxiamte model level locations in pascals:' + write (logunit,*) ' Full levels = ', Vgrid%pfull + write (logunit,*) ' Half levels = ', Vgrid%phalf + if (Vgrid%hybrid) & + write (logunit,*) 'Hybrid coordinate with minimum allowable surface pressure =', Vgrid%psmin + endif + if (lverbose > 1) then + write (logunit,*) 'INPUT VALUES:' + write (logunit,*) ' eta =', Vgrid%eta + write (logunit,*) ' peta =', Vgrid%peta + write (logunit,*) 'OTHER VALUES:' + write (logunit,*) ' deta =', Vgrid%deta + write (logunit,*) ' dpeta =', Vgrid%dpeta + write (logunit,*) ' nplev =', Vgrid%nplev + endif + endif + +! initialize code sections for performance timing + if (do_clock_init) then + do k = 1, size(id(:)) + id(k) = mpp_clock_id ('BGRID: vert ('//trim(names(k))//')', & + flags=MPP_CLOCK_SYNC, grain=CLOCK_LOOP) + enddo + do_clock_init = .false. + endif + +!----------------------------------------------------------------------- + +end subroutine vert_grid_init + +!####################################################################### + +subroutine compute_pres_depth (Vgrid, pssl, pdepth) + +!-------------------------------------------------------- +! Compute the pressure depth (mass) of model layers +! +! Vgrid = vertical grid constants +! pssl = pressure at eta=1 +! pdepth = pressure depth of model layers +!-------------------------------------------------------- + + type(vert_grid_type), intent(in) :: Vgrid + real , intent(in) :: pssl(:,:) + real , intent(out) :: pdepth(:,:,:) + + integer :: k, kp, ke + +!----------------------------------------------------------------------- + call mpp_clock_begin (id(1)) + + kp = Vgrid % nplev + ke = Vgrid % nlev + + if (size(pdepth,3) /= ke) call error_mesg ( & + 'compute_pres_depth in bgrid_vert_mod', & + 'incorrect dimension 3 for pdepth', FATAL) + +! --- check for zero/negative depth layers --- + + if (Vgrid % hybrid) then + if (minval(pssl) <= Vgrid % psmin) call error_mesg & + ('compute_pres_depth in bgrid_vert_mod', & + 'pressure depth <= 0.0', FATAL) + endif + +! --- compute depth --- + + do k = 1, kp + pdepth(:,:,k) = Vgrid % dpeta(k) + enddo + + do k = kp+1, ke + pdepth(:,:,k) = Vgrid % dpeta(k) + Vgrid % deta(k) * pssl(:,:) + enddo + + call mpp_clock_end (id(1)) + +end subroutine compute_pres_depth + +!####################################################################### + +subroutine compute_pres_full (Vgrid, pssl, pfull, phalf, dpde) + +!-------------------------------------------------------- +! Compute the pressure at full model levels (plus options) +! +! Vgrid = vertical grid constants +! pssl = pressure at eta=1 +! pfull = pressure at model levels +! phalf = pressure at model layer interfaces (half levels) +! dpde = pressure depth of model layers +!-------------------------------------------------------- + + type(vert_grid_type), intent(in) :: Vgrid + real , intent(in) :: pssl(:,:) + real , intent(out) :: pfull(:,:,:) + real, optional , intent(in) :: phalf(:,:,:), dpde(:,:,:) + + real, dimension(size(pfull,1),size(pfull,2),size(pfull,3)+1) :: ph + real, dimension(size(pfull,1),size(pfull,2),size(pfull,3)) :: dp + integer :: k, kp, ke +!----------------------------------------------------------------------- +! compute the pressure at full model levels +!----------------------------------------------------------------------- + call mpp_clock_begin (id(2)) + + kp = Vgrid % nplev + ke = Vgrid % nlev + + if (size(pfull,3) /= ke) call error_mesg ( & + 'compute_pres_full in bgrid_vert_mod', & + 'incorrect dimension 3 for pfull', FATAL) + +!--- set or compute optional arguments --- + + if (present(phalf)) then + ph = phalf + else + call compute_pres_half (Vgrid, pssl, ph) + endif + + if (present(dpde)) then + dp = dpde + else + call compute_pres_depth (Vgrid, pssl, dp) + endif + +!--- compute p*logp at half levels --- + + if ( Vgrid % pzero ) then + ph(:,:,1) = 0.0 + ph(:,:,2:ke+1) = ph(:,:,2:ke+1) * log(ph(:,:,2:ke+1)) + else + ph(:,:,:) = ph(:,:,:) * log(ph(:,:,:)) + endif + +!--- compute pressure at full levels --- + + do k = 1, kp + pfull(:,:,k) = Vgrid % pfull(k) + enddo + + do k = kp+1, ke + pfull(:,:,k) = exp( (ph(:,:,k+1)-ph(:,:,k))/dp(:,:,k) - 1.0 ) + enddo + + call mpp_clock_end (id(2)) + +end subroutine compute_pres_full + +!####################################################################### + +subroutine compute_pressures (Vgrid, pssl, phalf, pfull, dpde, wta, wtb) + +!-------------------------------------------------------- +! Compute the pressures, layer depths, and weights +! +! Vgrid = vertical grid constants +! pssl = pressure at eta=1 +! phalf = pressure at model layer interfaces (half levels) +! pfull = pressure at model levels (full levels) +! dpde = pressure depth (mass) of model layers +! wta,wtb = weights for computing data at model levels +!-------------------------------------------------------- + + type(vert_grid_type), intent(in) :: Vgrid + real , intent(in) :: pssl(:,:) + real , intent(out) :: phalf(:,:,:), pfull(:,:,:) + real, optional , intent(out) :: dpde(:,:,:) + real, optional , intent(out) :: wta(:,:,:), wtb(:,:,:) + + real, dimension(size(pfull,1),size(pfull,2),size(pfull,3)+1) :: ph,lph + real, dimension(size(pfull,1),size(pfull,2),size(pfull,3)) :: dp,lpf + integer :: k, kp, ke +!----------------------------------------------------------------------- + + kp = Vgrid % nplev + ke = Vgrid % nlev + + if (size(pfull,3) /= ke) call error_mesg ( & + 'compute_pressures in bgrid_vert_mod', & + 'incorrect dimension 3 for pfull', FATAL) + +!--- set or compute optional arguments --- + + call compute_pres_half (Vgrid, pssl, ph) + phalf = ph + + call compute_pres_depth (Vgrid, pssl, dp) + if (present(dpde)) dpde = dp + +! do not include time for previous calls + call mpp_clock_begin (id(3)) + +!--- compute p*logp at half levels --- + + if ( Vgrid % pzero ) then + lph(:,:,1) = 0.0 + ph(:,:,1) = 0.0 + lph(:,:,2:ke+1) = log(ph(:,:,2:ke+1)) + ph(:,:,2:ke+1) = ph(:,:,2:ke+1) * lph(:,:,2:ke+1) + else + lph(:,:,:) = log(ph(:,:,:)) + ph(:,:,:) = ph(:,:,:) * lph(:,:,:) + endif + +!--- compute pressure at full levels --- + + do k = 1, kp + pfull(:,:,k) = Vgrid % pfull(k) + enddo + +! if (present(wta) .or. present(wtb)) then +! do k = 1, kp +! lpf(:,:,k) = log(pfull(:,:,k)) +! enddo +! endif + + do k = kp+1, ke + lpf(:,:,k) = (ph(:,:,k+1)-ph(:,:,k))/dp(:,:,k) - 1.0 + pfull(:,:,k) = exp( lpf(:,:,k) ) + enddo + +!--- compute weights at full levels --- + + if (present(wtb)) then + do k = 1, kp + wtb(:,:,k) = Vgrid % wtb(k) + enddo + do k = kp+1, size(wtb,3) + wtb(:,:,k) = lph(:,:,k+1) - lpf(:,:,k) + enddo + endif + + if (present(wta)) then + do k = 1, kp + wta(:,:,k) = Vgrid % wta(k) + enddo + do k = kp+1, size(wta,3) + wta(:,:,k) = lpf(:,:,k) - lph(:,:,k) + enddo + if (Vgrid % pzero .and. kp == 0) wta(:,:,1) = wtb(:,:,1) + endif + + call mpp_clock_end (id(3)) + +end subroutine compute_pressures + +!####################################################################### + +subroutine compute_pres_half (Vgrid, pssl, phalf) + +!------------------------------------------------------------- +! Compute the pressure at the interface between model layers +! +! Vgrid = vertical grid constants +! pssl = pressure at eta=1 +! phalf = pressure at model layer interfaces (half levels) +!------------------------------------------------------------- + + type(vert_grid_type), intent(in) :: Vgrid + real , intent(in) :: pssl(:,:) + real , intent(out) :: phalf(:,:,:) + + integer :: k, kp, ke + +!----------------------------------------------------------------------- + call mpp_clock_begin (id(4)) + + kp = Vgrid % nplev + 1 + ke = Vgrid % nlev + 1 + + if (size(phalf,3) /= ke) call error_mesg ( & + 'compute_pres_half in bgrid_vert_mod', & + 'incorrect dimension 3 for phalf', FATAL) + +! pure pressure layers + do k = 1, kp + phalf(:,:,k) = Vgrid % peta(k) + enddo + +! sigma/pressure layers + do k = kp+1, ke + phalf(:,:,k) = Vgrid % peta(k) + Vgrid % eta(k) * pssl(:,:) + enddo + + call mpp_clock_end (id(4)) + +end subroutine compute_pres_half + +!####################################################################### + +subroutine compute_pres_weights ( Vgrid, phalf, pfull, wta, wtb ) + +!------------------------------------------------------------ +! Compute the weights for determining data at model levels +! +! Vgrid = vertical grid constants +! phalf = pressure at model layer interfaces (half levels) +! pfull = pressure at model levels (full levels) +! wta,wtb = weights for computing data at model levels +!------------------------------------------------------------ + + type(vert_grid_type), intent(in) :: Vgrid + real, intent(in) :: phalf(:,:,:), pfull(:,:,:) + real, intent(out) :: wta(:,:,:), wtb(:,:,:) + + real, dimension(size(phalf,1),size(phalf,2),size(phalf,3)) :: logph + real, dimension(size(pfull,1),size(pfull,2),size(pfull,3)) :: logpf + integer :: k, kp, kx, ks + + call mpp_clock_begin (id(5)) + + kp = Vgrid % nplev + kx = size(pfull,3) + + ! start indexing at 2 if ptop=0 + if (Vgrid%pzero) then + ks = max(2,kp+1) + else + ks = kp+1 + endif + + logph(:,:,ks :kx+1) = log(phalf(:,:,ks :kx+1)) + logpf(:,:,kp+1:kx ) = log(pfull(:,:,kp+1:kx )) + + ! weights for half level below + do k = 1, kp + wtb(:,:,k) = Vgrid % wtb(k) + enddo + do k = kp+1, kx + wtb(:,:,k) = logph(:,:,k+1) - logpf(:,:,k) + enddo + + ! weights for half level above + if (Vgrid%pzero .and. kp == 0) wta(:,:,1) = wtb(:,:,1) + do k = 1, kp + wta(:,:,k) = Vgrid % wta(k) + enddo + do k = ks, kx + wta(:,:,k) = logpf(:,:,k) - logph(:,:,k) + enddo + + call mpp_clock_end (id(5)) + +end subroutine compute_pres_weights + +!####################################################################### + +subroutine compute_geop_height (Vgrid, fssl, vtemp, wta, wtb, & + zfull, zhalf, mask) + +!----------------------------------------------------------------- +! Compute the geopotential height at full (and half) model levels +! +! Vgrid = vertical grid constants +! fssl = geopotential height at eta=1 +! vtemp = layer mean virtual temperature (at full model levels) +! wta,wtb = weights for computing data at full model levels +! zfull = geop height (m2/s2) at model levels (full levels) +! zhalf = geop height (m2/s2) at model layer interfaces (half levels) +! mask = grid box mask for eta coordinate topography +!------------------------------------------------------------ + + + type(vert_grid_type), intent(in) :: Vgrid + real, intent(in), dimension(:,:) :: fssl + real, intent(in), dimension(:,:,:) :: vtemp, wta, wtb + real, intent(out) :: zfull(:,:,:) + real, intent(out), optional :: zhalf(:,:,:) + real, intent(in), optional :: mask(:,:,:) + + integer :: k, klev + real, dimension(size(vtemp,1),size(vtemp,2)) :: zb, zt, rt + +!----------------------------------------------------------------------- + call mpp_clock_begin (id(6)) + + klev = Vgrid % nlev + + if (size(zfull,3) /= klev) call error_mesg ( & + 'compute_geop_height in bgrid_vert_mod', & + 'incorrect dimension 3 for zfull', FATAL) + + if (present(zhalf)) then + if (size(zhalf,3) /= klev+1) call error_mesg ( & + 'compute_geop_height in bgrid_vert_mod', & + 'incorrect dimension 3 for zhalf', FATAL) + endif + + zb(:,:) = fssl(:,:) + if (present(zhalf)) zhalf(:,:,klev+1) = zb(:,:) + +!------- vertical integration loop (bottom to top) ---------- + + do k = klev, 1, -1 + + rt(:,:) = RDGAS * vtemp(:,:,k) + zt(:,:) = zb(:,:) + rt(:,:) * (wta(:,:,k)+wtb(:,:,k)) + zfull(:,:,k) = zb(:,:) + rt(:,:) * wtb(:,:,k) + ! eta/step-mountain option + if (present(mask)) then + where (mask(:,:,k) < 0.5) + zt(:,:) = Vgrid % fhalf(k) ! use reference height profile + zfull(:,:,k) = 0.5*(Vgrid % fhalf(k)+Vgrid % fhalf(k+1)) + endwhere + endif + zb(:,:) = zt(:,:) + if (present(zhalf)) zhalf(:,:,k) = zb(:,:) + + enddo + + call mpp_clock_end (id(6)) + +end subroutine compute_geop_height + +!####################################################################### + +subroutine compute_height (Vgrid, fssl, temp, sphum, pfull, phalf, & + zfull, zhalf, mask) + +!----------------------------------------------------------------------- +! Compute the geopotential height (in meters) at full and half model levels. +! +! Vgrid = vertical grid constants +! fssl = geopotential height at eta=1 +! temp = layer mean temperature (at full model levels) +! sphum = layer mean specific humidity (at full model levels) +! pfull = pressure at model levels (full levels) +! phalf = pressure at model layer interfaces (half levels) +! zfull = geop height (in meters) at model levels (full levels) +! zhalf = geop height (in meters) at model layer interfaces (half levels) +! mask = grid box mask for eta coordinate topography +! +! Assumes that specific humidity is used to compute virtual temperature. +!----------------------------------------------------------------------- + + type(vert_grid_type), intent(in) :: Vgrid + real, intent(in), dimension(:,:) :: fssl + real, intent(in), dimension(:,:,:) :: temp, sphum, pfull, phalf + real, intent(out), dimension(:,:,:) :: zfull, zhalf + real, intent(in), optional :: mask(:,:,:) + + real, dimension(size(temp,1),size(temp,2),size(temp,3)) :: & + wta, wtb, vtemp + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + + call compute_pres_weights ( Vgrid, phalf, pfull, wta, wtb ) + + vtemp = temp * (1.0+d608*sphum) ! WARNING: also computed in bgrid core + ! potential exists for future problems!!! + + if (present(mask)) then + call compute_geop_height ( Vgrid, fssl, vtemp, wta, wtb, & + zfull, zhalf, mask ) + else + call compute_geop_height ( Vgrid, fssl, vtemp, wta, wtb, & + zfull, zhalf ) + endif + + zfull = zfull * ginv + zhalf = zhalf * ginv + +end subroutine compute_height + +!####################################################################### + +subroutine compute_height_bottom ( Vgrid, pssl, tbot, qbot, & + zbot, pbot, kbot ) + +!----------------------------------------------------------------------- +! Compute the height above surface (in meters) of the lowest model level. +! +! Vgrid = vertical grid constants +! pssl = pressure at eta=1 +! tbot = mean temperature of lowest model layer +! qbot = mean specific humidity of lowest model layer +! +! zbot = height above surface (in meters) of the lowest model level +! pbot = pressure at lowest model level +! +! mask = grid box mask for eta coordinate topography +! + + type(vert_grid_type), intent(in) :: Vgrid + real, intent(in), dimension(:,:) :: pssl, tbot, qbot + real, intent(out), dimension(:,:) :: zbot, pbot + integer, intent(in), optional :: kbot(:,:) + + real, dimension(size(pssl,1),size(pssl,2)) :: rt, dp, phb, pht, & + lphb, lpht, lpf + integer :: i, j, kb + +! ----- pressure at top and bottom interface of bottom level ----- + + call mpp_clock_begin (id(7)) + + ! compute half level pressure at the "top" and "bottom" of lowest model layer + if (present(kbot)) then + do j = 1, size(pssl,2) + do i = 1, size(pssl,1) + kb = kbot(i,j) + pht(i,j) = Vgrid%peta(kb ) + Vgrid%eta(kb )*pssl(i,j) + phb(i,j) = Vgrid%peta(kb+1) + Vgrid%eta(kb+1)*pssl(i,j) + enddo + enddo + else + kb = Vgrid%nlev + pht(:,:) = Vgrid%peta(kb+1) + Vgrid%eta(kb+1)*pssl(:,:) + phb(:,:) = Vgrid%peta(kb ) + Vgrid%eta(kb )*pssl(:,:) + endif + + ! compute log(pressure at lowest level) + dp = phb - pht + lphb = log(phb) + lpht = log(pht) + lpf = (phb*lphb-pht*lpht)/dp -1 + + ! compute virtual temperature using specific humidity + rt = ginv*RDGAS * (tbot * (1.+d608*qbot)) + zbot = rt * (lphb-lpf) + pbot = exp(lpf) + + call mpp_clock_end (id(7)) + +end subroutine compute_height_bottom + +!####################################################################### + +end module bgrid_vert_mod + diff --git a/MOM_code/src/atmos_coupled/atmos_model.F90 b/MOM_code/src/atmos_coupled/atmos_model.F90 new file mode 100644 index 0000000..2d1df3d --- /dev/null +++ b/MOM_code/src/atmos_coupled/atmos_model.F90 @@ -0,0 +1,1004 @@ +module atmos_model_mod +! Bruce Wyman +! +! +! Zhi Liang +! +!----------------------------------------------------------------------- +! +! Driver for the atmospheric model, contains routines to advance the +! atmospheric model state by one time step. +! + +! +! This version of atmos_model_mod has been designed around the implicit +! version diffusion scheme of the GCM. It requires two routines to advance +! the atmospheric model one time step into the future. These two routines +! correspond to the down and up sweeps of the standard tridiagonal solver. +! Most atmospheric processes (dynamics,radiation,etc.) are performed +! in the down routine. The up routine finishes the vertical diffusion +! and computes moisture related terms (convection,large-scale condensation, +! and precipitation). + +! The boundary variables needed by other component models for coupling +! are contained in a derived data type. A variable of this derived type +! is returned when initializing the atmospheric model. It is used by other +! routines in this module and by coupling routines. The contents of +! this derived type should only be modified by the atmospheric model. + +! + +use mpp_mod, only: mpp_pe, mpp_root_pe, mpp_clock_id, mpp_clock_begin +use mpp_mod, only: mpp_clock_end, CLOCK_COMPONENT, mpp_error, mpp_chksum +use mpp_domains_mod, only: domain2d +#ifdef INTERNAL_FILE_NML +use mpp_mod, only: input_nml_file +#else +use fms_mod, only: open_namelist_file +#endif +use fms_mod, only: file_exist, error_mesg, field_size, FATAL, NOTE, WARNING +use fms_mod, only: close_file, write_version_number, stdlog, stdout +use fms_mod, only: read_data, write_data, clock_flag_default +use fms_mod, only: open_restart_file, check_nml_error +use fms_io_mod, only: get_restart_io_mode +use fms_io_mod, only: restart_file_type, register_restart_field +use fms_io_mod, only: save_restart, restore_state, get_mosaic_tile_file +use time_manager_mod, only: time_type, operator(+), get_time +use field_manager_mod, only: MODEL_ATMOS +use tracer_manager_mod, only: get_number_tracers, get_tracer_index, NO_TRACER +use diag_integral_mod, only: diag_integral_init, diag_integral_end +use diag_integral_mod, only: diag_integral_output +use atmosphere_mod, only: atmosphere_cell_area +use xgrid_mod, only: grid_box_type +use atmosphere_mod, only: atmosphere_up, atmosphere_down, atmosphere_init +use atmosphere_mod, only: atmosphere_end, get_bottom_mass, get_bottom_wind +use atmosphere_mod, only: atmosphere_resolution, atmosphere_domain +use atmosphere_mod, only: atmosphere_boundary, get_atmosphere_axes +use atmosphere_mod, only: get_stock_pe +use atmosphere_mod, only: surf_diff_type +use atmosphere_mod, only: atmosphere_restart +use coupler_types_mod, only: coupler_2d_bc_type + + +!----------------------------------------------------------------------- + +implicit none +private + +public update_atmos_model_down, update_atmos_model_up +public atmos_model_init, atmos_model_end, atmos_data_type +public land_ice_atmos_boundary_type, land_atmos_boundary_type +public atm_stock_pe +public ice_atmos_boundary_type +public atmos_model_restart +public atmos_data_type_chksum +public lnd_ice_atm_bnd_type_chksum, lnd_atm_bnd_type_chksum +public ice_atm_bnd_type_chksum +!----------------------------------------------------------------------- + +! + type atmos_data_type + type (domain2d) :: domain ! domain decomposition + integer :: axes(4) ! axis indices (returned by diag_manager) for the atmospheric grid + ! (they correspond to the x, y, pfull, phalf axes) + real, pointer, dimension(:,:) :: lon_bnd => null() ! local longitude axis grid box corners in radians. + real, pointer, dimension(:,:) :: lat_bnd => null() ! local latitude axis grid box corners in radians. + real, pointer, dimension(:,:) :: t_bot => null() ! temperature at lowest model level + real, pointer, dimension(:,:,:) :: tr_bot => null() ! tracers at lowest model level + real, pointer, dimension(:,:) :: z_bot => null() ! height above the surface for the lowest model level + real, pointer, dimension(:,:) :: p_bot => null() ! pressure at lowest model level + real, pointer, dimension(:,:) :: u_bot => null() ! zonal wind component at lowest model level + real, pointer, dimension(:,:) :: v_bot => null() ! meridional wind component at lowest model level + real, pointer, dimension(:,:) :: p_surf => null() ! surface pressure + real, pointer, dimension(:,:) :: slp => null() ! sea level pressure + real, pointer, dimension(:,:) :: gust => null() ! gustiness factor + real, pointer, dimension(:,:) :: coszen => null() ! cosine of the zenith angle + real, pointer, dimension(:,:) :: flux_sw => null() ! net shortwave flux (W/m2) at the surface + real, pointer, dimension(:,:) :: flux_sw_dir =>null() + real, pointer, dimension(:,:) :: flux_sw_dif =>null() + real, pointer, dimension(:,:) :: flux_sw_down_vis_dir =>null() + real, pointer, dimension(:,:) :: flux_sw_down_vis_dif =>null() + real, pointer, dimension(:,:) :: flux_sw_down_total_dir =>null() + real, pointer, dimension(:,:) :: flux_sw_down_total_dif =>null() + real, pointer, dimension(:,:) :: flux_sw_vis =>null() + real, pointer, dimension(:,:) :: flux_sw_vis_dir =>null() + real, pointer, dimension(:,:) :: flux_sw_vis_dif =>null() + real, pointer, dimension(:,:) :: flux_lw => null() ! net longwave flux (W/m2) at the surface + real, pointer, dimension(:,:) :: lprec => null() ! mass of liquid precipitation since last time step (Kg/m2) + real, pointer, dimension(:,:) :: fprec => null() ! ass of frozen precipitation since last time step (Kg/m2) + logical, pointer, dimension(:,:) :: maskmap =>null()! A pointer to an array indicating which + ! logical processors are actually used for + ! the ocean code. The other logical + ! processors would be all land points and + ! are not assigned to actual processors. + ! This need not be assigned if all logical + ! processors are used. This variable is dummy and need + ! not to be set, but it is needed to pass compilation. + type (surf_diff_type) :: Surf_diff ! store data needed by the multi-step version of the diffusion algorithm + type (time_type) :: Time ! current time + type (time_type) :: Time_step ! atmospheric time step. + type (time_type) :: Time_init ! reference time. + integer, pointer :: pelist(:) =>null() ! pelist where atmosphere is running. + logical :: pe ! current pe. + type(coupler_2d_bc_type) :: fields ! array of fields used for additional tracers + type(grid_box_type) :: grid ! hold grid information needed for 2nd order conservative flux exchange + ! to calculate gradient on cubic sphere grid. + end type atmos_data_type +! + +! +type land_ice_atmos_boundary_type + ! variables of this type are declared by coupler_main, allocated by flux_exchange_init. +!quantities going from land+ice to atmos + real, dimension(:,:), pointer :: t =>null() ! surface temperature for radiation calculations + real, dimension(:,:), pointer :: albedo =>null() ! surface albedo for radiation calculations + real, dimension(:,:), pointer :: albedo_vis_dir =>null() + real, dimension(:,:), pointer :: albedo_nir_dir =>null() + real, dimension(:,:), pointer :: albedo_vis_dif =>null() + real, dimension(:,:), pointer :: albedo_nir_dif =>null() + real, dimension(:,:), pointer :: land_frac =>null() ! fraction amount of land in a grid box + real, dimension(:,:), pointer :: dt_t =>null() ! temperature tendency at the lowest level + real, dimension(:,:,:), pointer :: dt_tr =>null() ! tracer tendency at the lowest level + real, dimension(:,:), pointer :: u_flux =>null() ! zonal wind stress + real, dimension(:,:), pointer :: v_flux =>null() ! meridional wind stress + real, dimension(:,:), pointer :: dtaudu =>null() ! derivative of zonal wind stress w.r.t. the lowest zonal level wind speed + real, dimension(:,:), pointer :: dtaudv =>null() ! derivative of meridional wind stress w.r.t. the lowest meridional level wind speed + real, dimension(:,:), pointer :: u_star =>null() ! friction velocity + real, dimension(:,:), pointer :: b_star =>null() ! bouyancy scale + real, dimension(:,:), pointer :: q_star =>null() ! moisture scale + real, dimension(:,:), pointer :: rough_mom =>null() ! surface roughness (used for momentum) + real, dimension(:,:), pointer :: frac_open_sea =>null() ! non-seaice fraction (%) + real, dimension(:,:,:), pointer :: data =>null() !collective field for "named" fields above + integer :: xtype !REGRID, REDIST or DIRECT +end type land_ice_atmos_boundary_type +! + +! +type :: land_atmos_boundary_type + real, dimension(:,:), pointer :: data =>null() ! quantities going from land alone to atmos (none at present) +end type land_atmos_boundary_type +! + +! +!quantities going from ice alone to atmos (none at present) +type :: ice_atmos_boundary_type + real, dimension(:,:), pointer :: data =>null() ! quantities going from ice alone to atmos (none at present) +end type ice_atmos_boundary_type +! + +!Balaji +integer :: atmClock + +!for restart +integer :: ipts, jpts, dto +type(restart_file_type), pointer, save :: Atm_restart => null() +type(restart_file_type), pointer, save :: Til_restart => null() +logical :: in_different_file = .false. + +!----------------------------------------------------------------------- + +character(len=128) :: version = '$Id: atmos_model.F90,v 20.0 2013/12/13 23:08:05 fms Exp $' +character(len=128) :: tagname = '$Name: tikal $' + +integer :: ivapor = NO_TRACER ! index of water vapor tracer + +!----------------------------------------------------------------------- +character(len=80) :: restart_format = 'atmos_coupled_mod restart format 01' +!----------------------------------------------------------------------- +logical :: do_netcdf_restart = .true. +logical :: restart_tbot_qbot = .false. +namelist /atmos_model_nml/ do_netcdf_restart, restart_tbot_qbot + +contains + +!####################################################################### +! +! +! +! compute the atmospheric tendencies for dynamics, radiation, +! vertical diffusion of momentum, tracers, and heat/moisture. +! +! +! +! Called every time step as the atmospheric driver to compute the +! atmospheric tendencies for dynamics, radiation, vertical diffusion of +! momentum, tracers, and heat/moisture. For heat/moisture only the +! downward sweep of the tridiagonal elimination is performed, hence +! the name "_down". +! + +! + +! +! Derived-type variable that contains quantities going from land+ice to atmos. +! + +! +! Derived-type variable that contains fields needed by the flux exchange module. +! These fields describe the atmospheric grid and are needed to +! compute/exchange fluxes with other component models. All fields in this +! variable type are allocated for the global grid (without halo regions). +! + +subroutine update_atmos_model_down( Surface_boundary, Atmos ) +! +!----------------------------------------------------------------------- + type(land_ice_atmos_boundary_type), intent(inout) :: Surface_boundary + type (atmos_data_type), intent(inout) :: Atmos + +!----------------------------------------------------------------------- + call mpp_clock_begin(atmClock) + + call atmosphere_down (Atmos%Time, Surface_boundary%land_frac, & + Surface_boundary%t, Surface_boundary%albedo, & + Surface_boundary%albedo_vis_dir, & + Surface_boundary%albedo_nir_dir, & + Surface_boundary%albedo_vis_dif, & + Surface_boundary%albedo_nir_dif, & + Surface_boundary%rough_mom, & + Surface_boundary%u_star, & + Surface_boundary%b_star, & + Surface_boundary%q_star, & + Surface_boundary%dtaudu, & + Surface_boundary%dtaudv, & + Surface_boundary%u_flux, & + Surface_boundary%v_flux, & + Surface_boundary%frac_open_sea, & + Atmos%gust, & + Atmos%coszen, & + Atmos%flux_sw, & + Atmos%flux_sw_dir, & + Atmos%flux_sw_dif, & + Atmos%flux_sw_down_vis_dir, & + Atmos%flux_sw_down_vis_dif, & + Atmos%flux_sw_down_total_dir, & + Atmos%flux_sw_down_total_dif, & + Atmos%flux_sw_vis, & + Atmos%flux_sw_vis_dir, & + Atmos%flux_sw_vis_dif, & + Atmos%flux_lw, & + Atmos%Surf_diff ) + +!----------------------------------------------------------------------- + + call mpp_clock_end(atmClock) + end subroutine update_atmos_model_down +! + +!####################################################################### +! +! +!----------------------------------------------------------------------- +! +! upward vertical diffusion of heat/moisture and moisture processes +! + +! +! Called every time step as the atmospheric driver to finish the upward +! sweep of the tridiagonal elimination for heat/moisture and compute the +! convective and large-scale tendencies. The atmospheric variables are +! advanced one time step and tendencies set back to zero. +! + +! + +! +! Derived-type variable that contains quantities going from land+ice to atmos. +! + +! +! Derived-type variable that contains fields needed by the flux exchange module. +! These fields describe the atmospheric grid and are needed to +! compute/exchange fluxes with other component models. All fields in this +! variable type are allocated for the global grid (without halo regions). +! + + subroutine update_atmos_model_up( Surface_boundary, Atmos ) + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + +type(land_ice_atmos_boundary_type), intent(in) :: Surface_boundary +type (atmos_data_type), intent(inout) :: Atmos + +!----------------------------------------------------------------------- + call mpp_clock_begin(atmClock) + + + Atmos%Surf_diff%delta_t = Surface_boundary%dt_t + Atmos%Surf_diff%delta_tr = Surface_boundary%dt_tr + + call atmosphere_up (Atmos%Time, Surface_boundary%land_frac, Atmos%Surf_diff, & + Atmos%lprec, Atmos%fprec, Atmos%gust, & + Surface_boundary%u_star, Surface_boundary%b_star, Surface_boundary%q_star) + +! --- advance time --- + + Atmos % Time = Atmos % Time + Atmos % Time_step + + + call get_bottom_mass (Atmos % t_bot, Atmos % tr_bot, & + Atmos % p_bot, Atmos % z_bot, & + Atmos % p_surf, Atmos % slp ) + + call get_bottom_wind (Atmos % u_bot, Atmos % v_bot) + + +!------ global integrals ------ + + call diag_integral_output (Atmos % Time) + +!----------------------------------------------------------------------- + call mpp_clock_end(atmClock) + +end subroutine update_atmos_model_up +! + +!####################################################################### +! +! +! +! Routine to initialize the atmospheric model +! + +! +! This routine allocates storage and returns a variable of type +! atmos_boundary_data_type, and also reads a namelist input and restart file. +! + +! + +! +! The base (or initial) time of the experiment. +! + +! +! The current time. +! + +! +! The atmospheric model/physics time step. +! + +! +! Derived-type variable that contains fields needed by the flux exchange module. +! + +subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) + + +type (atmos_data_type), intent(inout) :: Atmos +type (time_type), intent(in) :: Time_init, Time, Time_step + + integer :: unit, ntrace, ntprog, ntdiag, ntfamily, i, j + integer :: mlon, mlat, nlon, nlat, sec, day, dt + character(len=80) :: control + real, dimension(:,:), allocatable :: area + integer :: ierr, io, logunit + character(len=64) :: filename, filename2 + integer :: id_restart +!----------------------------------------------------------------------- + +!---- set the atmospheric model time ------ + + Atmos % Time_init = Time_init + Atmos % Time = Time + Atmos % Time_step = Time_step + logunit = stdlog() + + IF ( file_exist('input.nml')) THEN +#ifdef INTERNAL_FILE_NML + read(input_nml_file, nml=atmos_model_nml, iostat=io) + ierr = check_nml_error(io, 'atmos_model_nml') +#else + unit = open_namelist_file ( ) + ierr=1 + do while (ierr /= 0) + read (unit, nml=atmos_model_nml, iostat=io, end=10) + ierr = check_nml_error(io,'atmos_model_nml') + enddo + 10 call close_file (unit) +#endif + endif + call get_restart_io_mode(do_netcdf_restart) + +!----------------------------------------------------------------------- +! how many tracers have been registered? +! (will print number below) + call get_number_tracers ( MODEL_ATMOS, ntrace, ntprog, ntdiag, ntfamily ) + if ( ntfamily > 0 ) call error_mesg ('atmos_model', 'ntfamily > 0', FATAL) + ivapor = get_tracer_index( MODEL_ATMOS, 'sphum' ) + if (ivapor==NO_TRACER) & + ivapor = get_tracer_index( MODEL_ATMOS, 'mix_rat' ) + if (ivapor==NO_TRACER) & + call error_mesg('atmos_model_init', 'Cannot find water vapor in ATM tracer table', FATAL) + +!----------------------------------------------------------------------- +! ----- initialize atmospheric model ----- + + call atmosphere_init (Atmos%Time_init, Atmos%Time, Atmos%Time_step,& + Atmos%Surf_diff, Atmos%grid ) + +!----------------------------------------------------------------------- +!---- allocate space ---- + + call atmosphere_resolution (mlon, mlat, global=.true.) + call atmosphere_resolution (nlon, nlat, global=.false.) + call atmosphere_domain (Atmos%domain) + + allocate ( Atmos % lon_bnd (nlon+1,nlat+1), & + Atmos % lat_bnd (nlon+1,nlat+1), & + Atmos % t_bot (nlon,nlat), & + Atmos % tr_bot (nlon,nlat, ntprog), & + Atmos % z_bot (nlon,nlat), & + Atmos % p_bot (nlon,nlat), & + Atmos % u_bot (nlon,nlat), & + Atmos % v_bot (nlon,nlat), & + Atmos % p_surf (nlon,nlat), & + Atmos % slp (nlon,nlat), & + Atmos % gust (nlon,nlat), & + Atmos % flux_sw (nlon,nlat), & + Atmos % flux_sw_dir (nlon,nlat), & + Atmos % flux_sw_dif (nlon,nlat), & + Atmos % flux_sw_down_vis_dir (nlon,nlat), & + Atmos % flux_sw_down_vis_dif (nlon,nlat), & + Atmos % flux_sw_down_total_dir (nlon,nlat), & + Atmos % flux_sw_down_total_dif (nlon,nlat), & + Atmos % flux_sw_vis (nlon,nlat), & + Atmos % flux_sw_vis_dir (nlon,nlat), & + Atmos % flux_sw_vis_dif(nlon,nlat), & + Atmos % flux_lw (nlon,nlat), & + Atmos % coszen (nlon,nlat), & + Atmos % lprec (nlon,nlat), & + Atmos % fprec (nlon,nlat) ) + + do j = 1, nlat + do i = 1, nlon + Atmos % flux_sw(i,j) = 0.0 + Atmos % flux_lw(i,j) = 0.0 + Atmos % flux_sw_dir (i,j) = 0.0 + Atmos % flux_sw_dif (i,j) = 0.0 + Atmos % flux_sw_down_vis_dir (i,j) = 0.0 + Atmos % flux_sw_down_vis_dif (i,j) = 0.0 + Atmos % flux_sw_down_total_dir (i,j) = 0.0 + Atmos % flux_sw_down_total_dif (i,j) = 0.0 + Atmos % flux_sw_vis (i,j) = 0.0 + Atmos % flux_sw_vis_dir (i,j) = 0.0 + Atmos % flux_sw_vis_dif(i,j) = 0.0 + Atmos % coszen(i,j) = 0.0 + enddo + enddo +!----------------------------------------------------------------------- +!------ get initial state for dynamics ------- + + call get_atmosphere_axes ( Atmos % axes ) + + call atmosphere_boundary ( Atmos % lon_bnd, Atmos % lat_bnd, & + global=.false. ) + + call get_bottom_mass (Atmos % t_bot, Atmos % tr_bot, & + Atmos % p_bot, Atmos % z_bot, & + Atmos % p_surf, Atmos % slp ) + + call get_bottom_wind (Atmos % u_bot, Atmos % v_bot) + +!----------------------------------------------------------------------- +!---- print version number to logfile ---- + + call write_version_number ( version, tagname ) +! write the namelist to a log file + if (mpp_pe() == mpp_root_pe()) then + unit = stdlog( ) + write (unit, nml=atmos_model_nml) + call close_file (unit) +! number of tracers + write (unit, '(a,i3)') 'Number of tracers =', ntrace + write (unit, '(a,i3)') 'Number of prognostic tracers =', ntprog + write (unit, '(a,i3)') 'Number of diagnostic tracers =', ntdiag + endif + +!------ read initial state for several atmospheric fields ------ + filename = 'atmos_coupled.res.nc' + call get_mosaic_tile_file(filename, filename2, .false., Atmos%domain ) + allocate(Atm_restart) + if(trim(filename2) == trim(filename)) then + Til_restart => Atm_restart + in_different_file = .false. + id_restart = register_restart_field(Atm_restart, filename, 'glon_bnd', ipts, domain=Atmos%domain) + id_restart = register_restart_field(Atm_restart, filename, 'glat_bnd', jpts, domain=Atmos%domain) + id_restart = register_restart_field(Atm_restart, filename, 'dt', dto, domain=Atmos%domain) + else + in_different_file = .true. + allocate(Til_restart) + id_restart = register_restart_field(Atm_restart, filename, 'glon_bnd', ipts, no_domain=.true.) + id_restart = register_restart_field(Atm_restart, filename, 'glat_bnd', jpts, no_domain=.true.) + id_restart = register_restart_field(Atm_restart, filename, 'dt', dto, no_domain=.true.) + endif + + id_restart = register_restart_field(Til_restart, filename, 'lprec', Atmos % lprec, domain=Atmos%domain) + id_restart = register_restart_field(Til_restart, filename, 'fprec', Atmos % fprec, domain=Atmos%domain) + id_restart = register_restart_field(Til_restart, filename, 'gust', Atmos % gust, domain=Atmos%domain) + if (restart_tbot_qbot) then + id_restart = register_restart_field(Til_restart, filename, 't_bot', Atmos%t_bot, domain=Atmos%domain) + id_restart = register_restart_field(Til_restart, filename, 'q_bot', Atmos%tr_bot(:,:,ivapor), domain=Atmos%domain) + end if + + call get_time (Atmos % Time_step, sec, day) + dt = sec + 86400*day ! integer seconds + + filename = 'INPUT/atmos_coupled.res.nc' + if ( file_exist(filename, domain=Atmos%domain) ) then + if(mpp_pe() == mpp_root_pe() ) call mpp_error ('atmos_model_mod', & + 'Reading netCDF formatted restart file: INPUT/atmos_coupled.res.nc', NOTE) + call restore_state(Atm_restart) + if(in_different_file)call restore_state(Til_restart) + if (ipts /= mlon .or. jpts /= mlat) call error_mesg & + ('coupled_atmos_init', 'incorrect resolution on restart file', WARNING) + +!---- if the time step has changed then convert ---- +! tendency to conserve mass of water + if (dto /= dt) then + Atmos % lprec = Atmos % lprec * real(dto)/real(dt) + Atmos % fprec = Atmos % fprec * real(dto)/real(dt) + if (mpp_pe() == mpp_root_pe()) write (logunit,50) + endif + else if (file_exist('INPUT/atmos_coupled.res')) then + if(mpp_pe() == mpp_root_pe() ) call mpp_error ('atmos_model_mod', & + 'Reading native formatted restart file: INPUT/atmos_coupled.res', NOTE) + unit = open_restart_file ('INPUT/atmos_coupled.res', 'read') + !--- check version number (format) of restart file --- + read (unit) control + if (trim(control) /= trim(restart_format)) call error_mesg & + ('coupled_atmos_init', 'invalid restart format', FATAL) + !--- check resolution and time step --- + read (unit) ipts,jpts,dto + if (ipts /= mlon .or. jpts /= mlat) call error_mesg & + ('coupled_atmos_init', 'incorrect resolution on restart file', FATAL) + + !--- read data --- + call read_data ( unit, Atmos % lprec ) + call read_data ( unit, Atmos % fprec ) + call read_data ( unit, Atmos % gust ) + if (restart_tbot_qbot) then + call read_data ( unit, Atmos % t_bot ) + call read_data ( unit, Atmos % tr_bot(:,:,ivapor) ) + endif + call close_file (unit) + +!---- if the time step has changed then convert ---- +! tendency to conserve mass of water + if (dto /= dt) then + Atmos % lprec = Atmos % lprec * real(dto)/real(dt) + Atmos % fprec = Atmos % fprec * real(dto)/real(dt) + if (mpp_pe() == mpp_root_pe()) write (logunit,50) + 50 format (/,'The model time step changed .... & + &modifying precipitation tendencies') + endif + else + Atmos % lprec = 0.0 + Atmos % fprec = 0.0 + Atmos % gust = 1.0 + endif + + ! to be written to restart file + ipts = mlon + jpts = mlat + dto = dt + +!------ initialize global integral package ------ +!**** TEMPORARY FIX FOR GRID CELL CORNER PROBLEM **** + + allocate (area (nlon, nlat)) +! call atmosphere_cell_area to obtain array of grid cell areas needed +! by diag_integral_init + call atmosphere_cell_area (area) + call diag_integral_init (Atmos % Time_init, Atmos % Time, & + Atmos % lon_bnd(:,:), & + Atmos % lat_bnd(:,:), area) + deallocate (area) + +!----------------------------------------------------------------------- +atmClock = mpp_clock_id( 'Atmosphere', flags=clock_flag_default, grain=CLOCK_COMPONENT ) +end subroutine atmos_model_init +! + +!####################################################################### +! +! +! +! termination routine for atmospheric model +! + +! +! Call once to terminate this module and any other modules used. +! This routine writes a restart file and deallocates storage +! used by the derived-type variable atmos_boundary_data_type. +! + +! + +! +! Derived-type variable that contains fields needed by the flux exchange module. +! + +subroutine atmos_model_end (Atmos) + +type (atmos_data_type), intent(inout) :: Atmos + +!----------------------------------------------------------------------- +!---- termination routine for atmospheric model ---- + + call atmosphere_end (Atmos % Time, Atmos%grid) + +!------ global integrals ------ + + call diag_integral_end (Atmos % Time) + +!------ write several atmospheric fields ------ +! also resolution and time step + call atmos_model_local_restart(Atmos) + +!-------- deallocate space -------- + + deallocate ( Atmos % lon_bnd , & + Atmos % lat_bnd , & + Atmos % t_bot , & + Atmos % tr_bot , & + Atmos % z_bot , & + Atmos % p_bot , & + Atmos % u_bot , & + Atmos % v_bot , & + Atmos % p_surf , & + Atmos % slp , & + Atmos % gust , & + Atmos % flux_sw , & + Atmos % flux_sw_dir , & + Atmos % flux_sw_dif , & + Atmos % flux_sw_down_vis_dir , & + Atmos % flux_sw_down_vis_dif , & + Atmos % flux_sw_down_total_dir , & + Atmos % flux_sw_down_total_dif , & + Atmos % flux_sw_vis , & + Atmos % flux_sw_vis_dir , & + Atmos % flux_sw_vis_dif , & + Atmos % flux_lw , & + Atmos % coszen , & + Atmos % lprec , & + Atmos % fprec ) + +!----------------------------------------------------------------------- + +end subroutine atmos_model_end +! + !####################################################################### + ! + ! + ! Write out restart files registered through register_restart_file + ! + subroutine atmos_model_restart(Atmos, timestamp) + type (atmos_data_type), intent(inout) :: Atmos + character(len=*), intent(in) :: timestamp + + call atmosphere_restart(timestamp) + call atmos_model_local_restart(Atmos, timestamp) + + end subroutine atmos_model_restart + ! + + !####################################################################### + ! + ! + ! Write out restart files registered through register_restart_file + ! + subroutine atmos_model_local_restart(Atmos, timestamp) + type (atmos_data_type), intent(inout) :: Atmos + character(len=*), intent(in), optional :: timestamp + integer :: unit + if( do_netcdf_restart) then + if(mpp_pe() == mpp_root_pe()) then + call mpp_error ('atmos_model_mod', 'Writing netCDF formatted restart file.', NOTE) + endif + call save_restart(Atm_restart, timestamp) + if(in_different_file) call save_restart(Til_restart, timestamp) + else + if(present(timestamp)) call mpp_error ('atmos_model_mod', & + 'intermediate restart capability is not implemented for non-netcdf file', FATAL) + unit = open_restart_file ('RESTART/atmos_coupled.res', 'write') + if (mpp_pe() == mpp_root_pe()) then + write (unit) restart_format + write (unit) ipts, jpts, dto + endif + call write_data ( unit, Atmos % lprec ) + call write_data ( unit, Atmos % fprec ) + call write_data ( unit, Atmos % gust ) + if(restart_tbot_qbot) then + call write_data ( unit, Atmos % t_bot ) + call write_data ( unit, Atmos % tr_bot(:,:,ivapor) ) + endif + call close_file (unit) + endif + + end subroutine atmos_model_local_restart + ! +!####################################################################### +! +! +! +! returns the total stock in atmospheric model +! + +! +! Called to compute and return the total stock (e.g., water, heat, etc.) +! in the atmospheric on the current PE. +! + +! + +! +! Derived-type variable that contains fields needed by the flux exchange module. +! +! +! +! Index of stock to be computed. +! +! +! +! Value of stock on the current processor. +! + +subroutine atm_stock_pe (Atm, index, value) + +type (atmos_data_type), intent(inout) :: Atm +integer, intent(in) :: index +real, intent(out) :: value + + value = 0.0 + if(Atm%pe) call get_stock_pe (index, value) + +end subroutine atm_stock_pe + +! + +!####################################################################### +!####################################################################### +! +! +! +! Print checksums of the various fields in the atmos_data_type. +! + +! +! Routine to print checksums of the various fields in the atmos_data_type. +! + +! + +! +! Derived-type variable that contains fields in the atmos_data_type. +! +! +! +! Label to differentiate where this routine in being called from. +! +! +! +! An integer to indicate which timestep this routine is being called for. +! +! +subroutine atmos_data_type_chksum(id, timestep, atm) +type(atmos_data_type), intent(in) :: atm + character(len=*), intent(in) :: id + integer , intent(in) :: timestep + integer :: n, outunit + +100 format("CHECKSUM::",A32," = ",Z20) +101 format("CHECKSUM::",A16,a,'%',a," = ",Z20) + + outunit = stdout() + write(outunit,*) 'BEGIN CHECKSUM(Atmos_data_type):: ', id, timestep + write(outunit,100) ' atm%lon_bnd ', mpp_chksum(atm%lon_bnd ) + write(outunit,100) ' atm%lat_bnd ', mpp_chksum(atm%lat_bnd ) + write(outunit,100) ' atm%t_bot ', mpp_chksum(atm%t_bot ) + do n = 1, size(atm%tr_bot,3) + write(outunit,100) ' atm%tr_bot(:,:,n) ', mpp_chksum(atm%tr_bot(:,:,n) ) + enddo + write(outunit,100) ' atm%z_bot ', mpp_chksum(atm%z_bot ) + write(outunit,100) ' atm%p_bot ', mpp_chksum(atm%p_bot ) + write(outunit,100) ' atm%u_bot ', mpp_chksum(atm%u_bot ) + write(outunit,100) ' atm%v_bot ', mpp_chksum(atm%v_bot ) + write(outunit,100) ' atm%p_surf ', mpp_chksum(atm%p_surf ) + write(outunit,100) ' atm%slp ', mpp_chksum(atm%slp ) + write(outunit,100) ' atm%gust ', mpp_chksum(atm%gust ) + write(outunit,100) ' atm%coszen ', mpp_chksum(atm%coszen ) + write(outunit,100) ' atm%flux_sw ', mpp_chksum(atm%flux_sw ) + write(outunit,100) ' atm%flux_sw_dir ', mpp_chksum(atm%flux_sw_dir ) + write(outunit,100) ' atm%flux_sw_dif ', mpp_chksum(atm%flux_sw_dif ) + write(outunit,100) ' atm%flux_sw_down_vis_dir ', mpp_chksum(atm%flux_sw_down_vis_dir ) + write(outunit,100) ' atm%flux_sw_down_vis_dif ', mpp_chksum(atm%flux_sw_down_vis_dif ) + write(outunit,100) ' atm%flux_sw_down_total_dir ', mpp_chksum(atm%flux_sw_down_total_dir) + write(outunit,100) ' atm%flux_sw_down_total_dif ', mpp_chksum(atm%flux_sw_down_total_dif) + write(outunit,100) ' atm%flux_sw_vis ', mpp_chksum(atm%flux_sw_vis ) + write(outunit,100) ' atm%flux_sw_vis_dir ', mpp_chksum(atm%flux_sw_vis_dir ) + write(outunit,100) ' atm%flux_sw_vis_dif ', mpp_chksum(atm%flux_sw_vis_dif ) + write(outunit,100) ' atm%flux_lw ', mpp_chksum(atm%flux_lw ) + write(outunit,100) ' atm%lprec ', mpp_chksum(atm%lprec ) + write(outunit,100) ' atm%fprec ', mpp_chksum(atm%fprec ) +! call surf_diff_type_chksum(id, timestep, atm%surf_diff) + +end subroutine atmos_data_type_chksum + +! + +!####################################################################### +! +! +! +! Print checksums of the various fields in the land_ice_atmos_boundary_type. +! + +! +! Routine to print checksums of the various fields in the land_ice_atmos_boundary_type. +! + +! + +! +! Derived-type variable that contains fields in the land_ice_atmos_boundary_type. +! +! +! +! Label to differentiate where this routine in being called from. +! +! +! +! An integer to indicate which timestep this routine is being called for. +! +! + + +subroutine lnd_ice_atm_bnd_type_chksum(id, timestep, bnd_type) + + character(len=*), intent(in) :: id + integer , intent(in) :: timestep + type(land_ice_atmos_boundary_type), intent(in) :: bnd_type + integer :: n, outunit + + outunit = stdout() + write(outunit,*) 'BEGIN CHECKSUM(lnd_ice_Atm_bnd_type):: ', id, timestep +100 format("CHECKSUM::",A32," = ",Z20) + write(outunit,100) 'lnd_ice_atm_bnd_type%t ',mpp_chksum(bnd_type%t ) + write(outunit,100) 'lnd_ice_atm_bnd_type%albedo ',mpp_chksum(bnd_type%albedo ) + write(outunit,100) 'lnd_ice_atm_bnd_type%albedo_vis_dir',mpp_chksum(bnd_type%albedo_vis_dir ) + write(outunit,100) 'lnd_ice_atm_bnd_type%albedo_nir_dir',mpp_chksum(bnd_type%albedo_nir_dir ) + write(outunit,100) 'lnd_ice_atm_bnd_type%albedo_vis_dif',mpp_chksum(bnd_type%albedo_vis_dif ) + write(outunit,100) 'lnd_ice_atm_bnd_type%albedo_nir_dif',mpp_chksum(bnd_type%albedo_nir_dif ) + write(outunit,100) 'lnd_ice_atm_bnd_type%land_frac ',mpp_chksum(bnd_type%land_frac ) + write(outunit,100) 'lnd_ice_atm_bnd_type%dt_t ',mpp_chksum(bnd_type%dt_t ) + do n = 1, size(bnd_type%dt_tr,3) + write(outunit,100) 'lnd_ice_atm_bnd_type%dt_tr(:,:,n) ',mpp_chksum(bnd_type%dt_tr(:,:,n) ) + enddo + write(outunit,100) 'lnd_ice_atm_bnd_type%u_flux ',mpp_chksum(bnd_type%u_flux ) + write(outunit,100) 'lnd_ice_atm_bnd_type%v_flux ',mpp_chksum(bnd_type%v_flux ) + write(outunit,100) 'lnd_ice_atm_bnd_type%dtaudu ',mpp_chksum(bnd_type%dtaudu ) + write(outunit,100) 'lnd_ice_atm_bnd_type%dtaudv ',mpp_chksum(bnd_type%dtaudv ) + write(outunit,100) 'lnd_ice_atm_bnd_type%u_star ',mpp_chksum(bnd_type%u_star ) + write(outunit,100) 'lnd_ice_atm_bnd_type%b_star ',mpp_chksum(bnd_type%b_star ) + write(outunit,100) 'lnd_ice_atm_bnd_type%q_star ',mpp_chksum(bnd_type%q_star ) + write(outunit,100) 'lnd_ice_atm_bnd_type%rough_mom ',mpp_chksum(bnd_type%rough_mom ) +! write(outunit,100) 'lnd_ice_atm_bnd_type%data ',mpp_chksum(bnd_type%data ) + +end subroutine lnd_ice_atm_bnd_type_chksum +! + +!####################################################################### +! +! +! +! Print checksums of the various fields in the land_atmos_boundary_type. +! + +! +! Routine to print checksums of the various fields in the land_atmos_boundary_type. +! + +! + +! +! Derived-type variable that contains fields in the land_atmos_boundary_type. +! +! +! +! Label to differentiate where this routine in being called from. +! +! +! +! An integer to indicate which timestep this routine is being called for. +! +! + + +subroutine lnd_atm_bnd_type_chksum(id, timestep, bnd_type) + use fms_mod, only: stdout + use mpp_mod, only: mpp_chksum + + character(len=*), intent(in) :: id + integer , intent(in) :: timestep + type(land_atmos_boundary_type), intent(in) :: bnd_type + integer :: n, outunit + + outunit = stdout() + write(outunit,*) 'BEGIN CHECKSUM(lnd_atmos_boundary_type):: ', id, timestep +! write(outunit,100) 'lnd_atm_bnd_type%data',mpp_chksum(bnd_type%data) + +100 format("CHECKSUM::",A32," = ",Z20) + +end subroutine lnd_atm_bnd_type_chksum +! + +!####################################################################### +! +! +! +! Print checksums of the various fields in the ice_atmos_boundary_type. +! + +! +! Routine to print checksums of the various fields in the ice_atmos_boundary_type. +! + +! + +! +! Derived-type variable that contains fields in the ice_atmos_boundary_type. +! +! +! +! Label to differentiate where this routine in being called from. +! +! +! +! An integer to indicate which timestep this routine is being called for. +! +! + + +subroutine ice_atm_bnd_type_chksum(id, timestep, bnd_type) + use fms_mod, only: stdout + use mpp_mod, only: mpp_chksum + + character(len=*), intent(in) :: id + integer , intent(in) :: timestep + type(ice_atmos_boundary_type), intent(in) :: bnd_type + integer :: n, outunit + + outunit = stdout() + write(outunit,*) 'BEGIN CHECKSUM(ice_atmos_boundary_type):: ', id, timestep +! write(outunit,100) 'ice_atm_bnd_type%data',mpp_chksum(data_type%data) + +100 format("CHECKSUM::",A32," = ",Z20) + + +end subroutine ice_atm_bnd_type_chksum +! + + +end module atmos_model_mod + diff --git a/MOM_code/src/atmos_ebm/atmosphere.F90 b/MOM_code/src/atmos_ebm/atmosphere.F90 new file mode 100644 index 0000000..ca4fc79 --- /dev/null +++ b/MOM_code/src/atmos_ebm/atmosphere.F90 @@ -0,0 +1,1470 @@ +module atmosphere_mod +! +! +! B.L. Samuels +! +! +! Zhi Liang +! + +! +! interface for spherical grid dynamical core and physics +! for the energy balance model (EBM) +! +! +! +! The Energy Balance Model is a simple spectral atmospheric model +! using diffusion and radiative balance. The EBM solves two +! prognostic equations for atmospheric temperature and specific +! humidity +! +! +! +! The Energy Balance Model was originally developed at GFDL +! by I. Held and extensively modified by J. Russell to be +! MOM4 compatible. Zhi Liang made the appropriate modifications +! for the code to be fms_io compatible and meet RTS standards. +! No current reference of this code exists. +! +! +! Zhang,Rong and Geoffrey Vallis, " The Role of the Deep Western Boundary Current in the +! Separation of the Gulf Stream", Journal of Physical Oceanography,submitted 2004 +! see Appendix A +! +! +! Note by J. Russell: the number of processors you use must be less than the number of +! atmospheric latitude boxes and must divide into that number equally +! +! +!----------------------------------------------------------------------- +! +! interface for spherical grid dynamical core and physics +! for the energy balance model (EBM) +! +!----------------------------------------------------------------------- +!---------------- m o d u l e i n f o r m a t i o n ------------------ + +use mpp_mod, only: mpp_pe, stdout, stdlog, mpp_error +use fms_mod, only: file_exist, close_file, read_data, write_data +use fms_mod, only: error_mesg, FATAL, check_nml_error, open_namelist_file +use fms_mod, only: write_version_number +use constants_mod, only: radius, rdgas, rvgas, cp_air, hlv, hlf, tfreeze, stefan, PI +use transforms_mod, only: transforms_init, grid_domain, spectral_domain +use transforms_mod, only: trans_grid_to_spherical, trans_spherical_to_grid +use transforms_mod, only: get_deg_lat, get_eigen_laplacian, compute_gradient_cos +use transforms_mod, only: compute_div, get_grid_boundaries, divide_by_cos2 +use transforms_mod, only: triangular_truncation, get_grid_domain, get_spec_domain +use transforms_mod, only: get_wts_lat +use time_manager_mod, only: time_type, get_time, get_date, operator(+) +use ebm_diagnostics_mod, only: ebm_diagnostics_init, ebm_diagnostics_up, ebm_diagnostics_down +use astronomy_mod, only: astronomy_init, daily_mean_solar, annual_mean_solar +use sat_vapor_pres_mod, only: escomp, descomp +use mpp_domains_mod, only: domain2D +use tracer_manager_mod, only: get_number_tracers +use xgrid_mod, only: grid_box_type + +!================================================================================== +implicit none +private +!================================================================================== + +! version information + +character(len=128), parameter :: version = & +'$Id: atmosphere.F90,v 19.0 2012/01/06 20:00:07 fms Exp $' + +character(len=128), parameter :: tagname = & +'$Name: tikal $' + +!================================================================================== + +! public interfaces + +public :: atmosphere_init, atmosphere_down, atmosphere_up +public :: atmosphere_end, atmosphere_resolution, atmosphere_boundary +public :: get_bottom_mass, get_bottom_wind, get_atmosphere_axes +public :: surf_diff_type, radiation, precipitation +public :: diffusion, atmosphere_domain +public :: get_stock_pe, atmosphere_cell_area +public :: atmosphere_restart + +!================================================================================== + +! module variables + +! +type surf_diff_type + real, pointer, dimension(:,:) :: dtmass => NULL() ! dt/mass, where dt = atmospheric time step (sec) + ! mass = mass of lowest atmospheric layer (Kg/m2) + real, pointer, dimension(:,:) :: dflux_t => NULL() ! derivative of the temperature flux at the top of the lowest + ! atmospheric layer with respect to the temperature + ! of that layer (J/(m2 K)) + real, pointer, dimension(:,:,:) :: dflux_tr => NULL() ! derivative of the flux of specific humidity + ! at the top of the lowest atmospheric layer with respect to + ! the specific humidity of that layer (--/(m2 K)) + real, pointer, dimension(:,:) :: delta_t => NULL() ! the increment in temperature in the lowest atmospheric + ! layer (((i+1)-(i-1) if atmos model is leapfrog) (K) + ! (defined in gcm_vert_diff_down as the increment computed up + ! to this point in model, including effect of vertical + ! diffusive flux at top of lowest model level, presumed + ! to be modified to include effects of surface fluxes + ! outside of this module, then used to start upward + ! tridiagonal sweep, + real, pointer, dimension(:,:,:):: delta_tr => NULL() ! similarly for the increment in specific humidity + ! (non-dimensional = Kg/Kg) + real, pointer, dimension(:,:) :: delta_u => NULL() + real, pointer, dimension(:,:) :: delta_v => NULL() + real, pointer, dimension(:,:) :: sst_miz => NULL() +end type surf_diff_type +! + +complex, allocatable, dimension(:,:) :: ts ! atmospheric temperature deg_k +complex, allocatable, dimension(:,:) :: qs ! specific humidity no units +complex, allocatable, dimension(:,:) :: dt_ts ! rate of change in atmospheric temperature (degK/s) +complex, allocatable, dimension(:,:) :: dt_qs ! rate of change in specific humidity (1/s) +real , allocatable, dimension(:,:) :: tg ! atmospheric temperature ( deg_k ) +real , allocatable, dimension(:,:) :: qg ! specific humidity ( no units ) +real , allocatable, dimension(:,:) :: dt_tg ! rate of change in atmospheric temperature (degK/s) +real , allocatable, dimension(:,:) :: dt_qg ! rate of change in specific humidity (1/s) +real , allocatable, dimension(:,:) :: u_bot ! zonal wind component at lowest model level (m/s) +real , allocatable, dimension(:,:) :: v_bot ! meridional wind component at lowest model level (m/s) +real , allocatable, dimension(:,:) :: t_bot ! temperature at lowest model level (deg k) +real , allocatable, dimension(:,:) :: q_bot ! specific humidity at lowest model level (kg/kg) + +real , allocatable, dimension(:) :: deg_lat, deg_lon, rad_lat, annual_solar, annual_cosz + +integer, dimension(4) :: axis_id ! axes identifiers provided by ebm_diagnostics_mod +real :: dt ! time step (secs) +type(time_type) :: Time, Time_next, Time_step + +integer :: is,ie,js,je,ms,me,ns,ne + +real, parameter :: d622 = rdgas/rvgas +real, parameter :: d378 = 1.-d622 +logical :: module_is_initialized =.false. +integer :: q_ind = 1 +!----------------------------------------------------------------------- +!---- namelist (saved in file input.nml) ---- +! +! namelist parameters with default values +! Default values are based on ebm run with 1p5 ocean model +! 120 x 65 as run by Joellen Russell + +integer :: lon_max = 180 +integer :: lat_max = 120 +integer :: num_fourier = 42 + +real :: diff = 1.e04 +real :: nu = 4.0e16 +real :: solar_constant = 1360.0 +real :: atm_abs = 0.15 +real :: atm_ref = 0.05 +real :: mass = 8.e03 +real :: rh = 0.8 +real :: t_bot_atm = 30.0 +logical :: seasonal_solar = .true. +logical :: diff_is_uniform = .false. + +real :: tg_init = 273.0 +real :: gustiness = 1.0 + +logical :: debug_ebm_atm = .false. + +! +! namelist/atmosphere_nml/ lon_max, lat_max, num_fourier, & +! mass, rh, t_bot_atm, & +! solar_constant, atm_abs, atm_ref, seasonal_solar, & +! diff_is_uniform, nu, diff, tg_init, debug_ebm_atm +! +! This is the longitude of the spectral atmospheric grid +! +! +! This is the latitude of the spectral atmospheric grid +! Note that the number of processors you use must be less than the number of +! atmospheric latitude boxes and must divide into that number equally +! +! +! num_fourier is used along with lon_max, lat_max in the spectral transforms of grids +! +! +! background atmospheric lateral eddy diffusion coefficient for the EBM +! +! +! scaling factor for spherical grid analysis used in diffusion subroutine +! +! +! standard value for the annual mean solar flux at the top of atmosphere. +! Default value if seasonal_solar=.false. +! +! +! atmospheric absorption (fraction) +! +! +! atmosphere reflectance (fraction) +! +! +! mass = mass of lowest atmospheric layer (Kg/m2) +! +! +! relative humidity (fraction) +! +! +! temperature at the bottom of the atmosphere +! +! +! If .true., seasonal solar value is computed +! +! +! +! +! constant value for inital atmospheric temperature (degK) +! +! +! For debugging purposes. +! + +namelist/atmosphere_nml/ lon_max, lat_max, num_fourier, mass, rh, t_bot_atm, & + solar_constant, atm_abs, atm_ref, seasonal_solar, & + diff_is_uniform, nu, diff, tg_init, debug_ebm_atm, gustiness +! + +!================================================================================== + +contains + + + +! ================================================================================== +! ================================================================================== + +! +! +! +! public routine required for atmospheric components of coupled models +! Read in restart files and initialize arrays +! +! +! +! public routine required for atmospheric components of coupled models +! Read in restart files and initialize arrays +! +! +! +! +! +! The base (or initial) time of the experiment. +! + +! +! The current time. +! + +! +! The atmospheric model/physics time step. +! + +! +! The surface terms for vertical diffusion that are exchanged +! with other component models. On input fields have not been +! allocated, on output all arrays are allocated. +! + +! +! Contains information about the grid cells +! + +subroutine atmosphere_init(Time_init, Time_in, Time_step_in, Surf_diff, Grid_box) + +type(time_type), intent(in) :: Time_init, Time_in, Time_step_in +type(surf_diff_type), intent(inout) :: Surf_diff +type(grid_box_type), intent(inout) :: Grid_box + +integer :: ierr, io, unit, seconds, days, m, n +character(len=64) :: filename +real, allocatable, dimension(:,:) :: real_part, imag_part +!----------------------------------------------------------------------------------------- +! managing time + +Time = Time_in +Time_step = Time_step_in + +call get_time(Time_step, seconds, days) +dt = float(86400*days + seconds) + +!----------------------------------------------------------------------------------------- +! read namelist and copy to logfile + +unit = open_namelist_file() +read (unit, nml=atmosphere_nml,iostat=io) +write (stdout(),'(/)') +write (stdout(), atmosphere_nml) +write (stdlog(), atmosphere_nml) +ierr = check_nml_error(io, 'atmosphere_nml') +call close_file(unit) + +!--- write out version information +call write_version_number( version, tagname ) + + +!----------------------------------------------------------------------------------------- +! Initialize spherical fourier +call transforms_init(radius, lat_max, lon_max, num_fourier, 1, num_fourier+1) + +!----------------------------------------------------------------------------------------- + +call get_grid_domain(is,ie,js,je) +call get_spec_domain(ms,me,ns,ne) + +! allocate module variables + +allocate ( tg (is:ie, js:je) ) +allocate ( qg (is:ie, js:je) ) +allocate ( dt_tg (is:ie, js:je) ) +allocate ( dt_qg (is:ie, js:je) ) + +allocate ( u_bot (is:ie, js:je) ) +allocate ( v_bot (is:ie, js:je) ) +allocate ( t_bot (is:ie, js:je) ) +allocate ( q_bot (is:ie, js:je) ) + +allocate ( ts (ms:me, ns:ne) ) +allocate ( qs (ms:me, ns:ne) ) +allocate ( dt_ts (ms:me, ns:ne) ) +allocate ( dt_qs (ms:me, ns:ne) ) + +allocate ( deg_lon (is:ie) ) +allocate ( deg_lat (js:je) ) +allocate ( rad_lat (js:je) ) + +allocate ( annual_cosz (js:je) ) +allocate ( annual_solar (js:je) ) + +allocate (real_part( ms:me, ns:ne) ) +allocate (imag_part( ms:me, ns:ne) ) + +! hack: in case EBM use more than 1 tracer other than water vapor, revamp this code. +! fil +allocate (Surf_diff%dtmass (is:ie, js:je) ) +allocate (Surf_diff%dflux_t (is:ie, js:je) ) +allocate (Surf_diff%dflux_tr (is:ie, js:je, q_ind) ) +allocate (Surf_diff%delta_t (is:ie, js:je) ) +allocate (Surf_diff%delta_tr (is:ie, js:je, q_ind) ) +allocate (Surf_diff%delta_u (is:ie, js:je) ) +allocate (Surf_diff%delta_v (is:ie, js:je) ) + +Surf_diff%dtmass = 0.0 +Surf_diff%dflux_t = 0.0 +Surf_diff%dflux_tr = 0.0 +Surf_diff%delta_t = 0.0 +Surf_diff%delta_tr = 0.0 +Surf_diff%delta_u = 0.0 +Surf_diff%delta_v = 0.0 + +!----------------------------------------------------------------------------------------- + +! these elements of Surf_diff are static + +Surf_diff%dtmass = dt/mass +Surf_diff%dflux_t = 0.0 +Surf_diff%dflux_tr = 0.0 + +!----------------------------------------------------------------------------------------- + +! read restart + +filename = 'INPUT/atmosphere.res.nc' + +if(file_exist(filename)) then + + call read_data(filename, 'ts_real', real_part, spectral_domain) + call read_data(filename, 'ts_imag', imag_part, spectral_domain) + do n = ns, ne + do m = ms, me + ts(m,n) = cmplx(real_part(m,n),imag_part(m,n)) + enddo + enddo + call read_data(filename, 'qs_real', real_part, spectral_domain) + call read_data(filename, 'qs_imag', imag_part, spectral_domain) + + do n = ns, ne + do m = ms, me + qs(m,n) = cmplx(real_part(m,n),imag_part(m,n)) + enddo + enddo + + call read_data(filename, 'tg', tg, grid_domain) + call read_data(filename, 'qg', qg, grid_domain) +else +! tg-initial atmospheric temperature default value 273 deg Kelvin +! qg-initial atmospheric specific humidity + tg = tg_init + qg = rh*sat_mixing_ratio(tg) + + call trans_grid_to_spherical(tg, ts) + call trans_grid_to_spherical(qg, qs) + +endif + +v_bot = 0.0 +t_bot = tg + t_bot_atm +q_bot = rh*sat_mixing_ratio(t_bot) + +! initalize other modules + +call ebm_diagnostics_init(Time, lon_max, lat_max, axis_id) +call astronomy_init() + +! get latitudes of grid points in degrees and radians +call get_deg_lat(deg_lat) +rad_lat = deg_lat*PI/180. + +! if annual mean option is used, compute solar radiation here +! Use version for spectral 2-layer model +if(.not.seasonal_solar) call annual_mean_solar ( rad_lat, annual_cosz, annual_solar ) + +module_is_initialized = .true. + +return +end subroutine atmosphere_init +! + +! ================================================================================== +! +! +! public routine required for atmospheric components of coupled models +! + +! +! atmosphere_down +! This routine calls the dynamical core and the +! "downward pass" of the atmospheric physics. +! It should only be called once per time step and before +! calling atmosphere_up. +! + +! + +! +! time at the current time level (tau) +! + +! +! fraction (0. to 1.) of underlying surface which covered by land +! + +! +! surface (skin) temperature (in deg k) +! + +! +! surface albedo +! + +! +! momentum roughness length (units=m) +! + +! +! friction velocity +! + +! +! buoyancy scale +! + +! +! moisture scale +! + +! +! derivative of zonal wind stress w.r.t. the lowest level wind speed +! + +! +! derivative of meridional wind stress w.r.t. the lowest level wind speed +! + +! +! wind gustiness +! + +! +! cosine of the zenith angle +! + +! +! net shortwave surface flux (down minus up) (in watts/m**2) +! + +! +! downward longwave surface flux (in watts/m**2) +! + +! +! Surface diffusion terms computed by the vertical diffusion scheme +! + +subroutine atmosphere_down(Time, frac_land, t_surf, albedo, albedo_vis_dir, & + albedo_nir_dir, albedo_vis_dif, albedo_nir_dif, & + rough_mom, u_star, b_star, q_star, dtau_du, dtau_dv, & + tau_x, tau_y,frac_open_sea, gust, coszen, net_surf_sw_down, & + flux_sw_dir, flux_sw_dif, flux_sw_down_vis_dir, & + flux_sw_down_vis_dif, flux_sw_down_total_dir, & + flux_sw_down_total_dif, flux_sw_vis, & + flux_sw_vis_dir, flux_sw_vis_dif,surf_lw_down, & + Surf_diff) + +! public routine required for atmospheric components of coupled models +type(time_type), intent(in) :: Time +real, intent(in), dimension(is:ie,js:je) :: frac_land, t_surf, albedo, rough_mom +real, intent(in), dimension(is:ie,js:je) :: albedo_vis_dir, albedo_nir_dir +real, intent(in), dimension(is:ie,js:je) :: albedo_vis_dif, albedo_nir_dif +real, intent(in), dimension(is:ie,js:je) :: u_star, b_star, q_star, dtau_du, dtau_dv, frac_open_sea +real, intent(inout), dimension(is:ie,js:je) :: tau_x, tau_y +real, intent(out), dimension(is:ie,js:je) :: gust, coszen, net_surf_sw_down, surf_lw_down +real, intent(out), dimension(is:ie,js:je) :: flux_sw_dir, flux_sw_dif, flux_sw_down_vis_dir +real, intent(out), dimension(is:ie,js:je) :: flux_sw_down_vis_dif, flux_sw_down_total_dir +real, intent(out), dimension(is:ie,js:je) :: flux_sw_down_total_dif, flux_sw_vis +real, intent(out), dimension(is:ie,js:je) :: flux_sw_vis_dir, flux_sw_vis_dif +type(surf_diff_type), intent(inout) :: Surf_diff + +! initialize tendencies of temperature and mixing ratio to zero +dt_tg = 0.0 +dt_qg = 0.0 + +! add temperature tendency due to radiation, and compute radiative fluxes and +! zenith angle needed by flux module + +call radiation (Time, t_surf, albedo, coszen, net_surf_sw_down, surf_lw_down) + +! +! VIS NIR VIS+NIR +!----------------------------------------------------- +! | | | +! DIR |flux_sw_vis_dir | | flux_sw_dir +! | | | +!----------------------------------------------------- +! | | | +! DIF |flux_sw_vis_dif | | flux_sw_dif +!----------------------------------------------------- +! | | | +!DIR+DIF|flux_sw_vis | | flux_sw +! | | |(diagnostic only) +!----------------------------------------------------- + +! bls-total Short wave is equally divided into VIS and NIR +! flux_sw_dif - total Diffusive Short wave : VIS + NIR +flux_sw_dif = .5*net_surf_sw_down +! flux_sw_dir - total Direct Short wave : VIS + NIR +flux_sw_dir = net_surf_sw_down - flux_sw_dif + +! bls- Visible Direct and Diffusive short wave will be assumed to be +! half of the total VIS+DIR components +flux_sw_vis_dir = .5*flux_sw_dir +flux_sw_vis_dif = .5*flux_sw_dif +! Total Visible short wave (DIR + DIFFUSE) + flux_sw_vis = flux_sw_vis_dir + flux_sw_vis_dif +! NIR components are determined in the ice model + +! for surface flux computation +gust = gustiness +v_bot = 0.0 +t_bot = tg + t_bot_atm +q_bot = rh*sat_mixing_ratio(t_bot) + +Surf_diff%delta_t = dt*dt_tg ! needed in this form for surface models +Surf_diff%delta_tr(:,:,q_ind) = dt*dt_qg + +return +end subroutine atmosphere_down +! + + +! ================================================================================== +! +! +! public routine required for atmospheric components of coupled models +! +! +! +! atmosphere_up +! This routine calls the "upward pass" of the atmospheric physics, +! spherical diagnostics, and time differencing. The prognostic +! variables are advanced to the next time step. It should only be +! called once per time step and after calling atmosphere_down. +! + +! + +! +! time at the current time level (tau) +! + +! +! fraction (0. to 1.) of underlying surface which covered by land +! + +! +! liquid precipitation rate (rain) in kg/m2/s +! + +! +! frozen precipitation rate (snow) in kg/m2/s +! + +! +! wind gustiness +! + +! +! urface diffusion terms computed by the vertical diffusion scheme +! + +! +! NOT USED in this routine. Dummy argument added for compilation success. +! +! +! NOT USED in this routine. Dummy argument added for compilation success. +! +! +! NOT USED in this routine. Dummy argument added for compilation success. +! + +subroutine atmosphere_up(Time, frac_land, Surf_diff, lprec, fprec, gust, u_star, b_star, q_star ) + + +type(time_type), intent(in) :: Time +real, intent(in), dimension(is:ie,js:je) :: frac_land +type(surf_diff_type), intent(in) :: Surf_diff +real, intent(out), dimension(is:ie,js:je) :: lprec, fprec, gust +real, intent(in), dimension(:,:) :: u_star, b_star, q_star + +complex, dimension(ms:me,ns:ne) :: lap, spec +real, dimension(ms:me,ns:ne) :: eigen + +integer :: year, month, day, hour, minute, second + +dt_tg = Surf_diff%delta_t/dt +dt_qg = Surf_diff%delta_tr(:,:,q_ind)/dt + +!initialize arrays to zero + gust = gustiness + +call precipitation(lprec, fprec) +call diffusion + +Time_next = Time + Time_step + if(debug_ebm_atm) then + call get_date(Time_next, year, month, day, hour, minute, second) + if (mpp_pe() == 0 .and. hour+minute == 0 ) then + print *,"atmosphere_up:Current time: year =",year," month = ",month," day = ",day + write (stdout(),1000) tg(ie,je), qg(ie,je), lprec(ie,je), fprec(ie,je) + endif + endif +call ebm_diagnostics_up(Time_next, tg, qg, lprec, fprec, dt_qg) + if(debug_ebm_atm) then +! print out a few things for degbugging + if (mpp_pe() == 0 .and. hour+minute == 0 ) then + print *,"atmosphere_up aft diag:Current time: year =",year," month = ",month," day = ",day + write (stdout(),1000) tg(ie,je), qg(ie,je), lprec(ie,je), fprec(ie,je) + endif + 1000 format(4(1x,e11.4)) + endif + + +return +end subroutine atmosphere_up +! + +! ================================================================================== +! +! +! radiation +! Radiation module for prognostic equation of atmospheric temperature +! The atmospheric tendency term (dt_tg) includes the balance of shortwave +! and longwave radiation terms at the surface +! +! +! + +! +! time at the current time level (tau) +! + +! +! surface (skin) temperature (in deg k) +! + +! +! surface albedo +! + +! +! cosine of the zenith angle +! + +! +! net shortwave surface flux (down minus up) (in watts/m**2) +! + +! +! downward longwave surface flux (in watts/m**2) +! + +subroutine radiation (Time, t_surf, albedo, coszen, net_surf_sw_down, surf_lw_down) +! +type(time_type), intent(in) :: Time +real, intent(in), dimension(is:ie,js:je) :: t_surf, albedo +real, intent(out), dimension(is:ie,js:je) :: coszen, net_surf_sw_down, surf_lw_down + +integer :: j + +real, dimension(is:ie,js:je) :: net_top_sw_down, top_lw_up, surf_lw_up +real, dimension(js:je) :: cosz, solar, incident_solar + +integer :: year, month, day, hour, minute, second + +if(seasonal_solar) then +! Use spectral 2-layer model version + call daily_mean_solar (rad_lat, Time, cosz, solar) +else + cosz = annual_cosz + solar = annual_solar +endif +incident_solar = solar_constant*solar + + if(debug_ebm_atm) then + call get_date(Time, year, month, day, hour, minute, second) + endif + +do j = js, je + + net_top_sw_down (:,j) = incident_solar(j)*(1.0 - atm_ref - (1.0 - atm_ref - atm_abs)*albedo(:,j)) + net_surf_sw_down (:,j) = incident_solar(j)*(1.0 - atm_ref- atm_abs)*(1. - albedo(:,j)) + top_lw_up (:,j) = stefan*( tg (:,j) **4) + surf_lw_down (:,j) = stefan*((tg (:,j)+20.0)**4) + surf_lw_up (:,j) = stefan*( t_surf (:,j) **4) + + dt_tg (:,j) = dt_tg(:,j) + & + ( + surf_lw_up (:,j) & + - top_lw_up (:,j) - surf_lw_down (:,j) & + + net_top_sw_down(:,j) - net_surf_sw_down(:,j) )/(cp_air*mass) + + coszen (:,j) = cosz(j) + + if(debug_ebm_atm) then + if (mpp_pe() == 0 .and. hour+minute == 0 ) then + print *,"radiation:Current time: year =",year," month = ",month," day = ",day, " j=",j + write (stdout(),1000) incident_solar(j),albedo(ie,j),atm_ref,atm_abs + write (stdout(),1000) tg(ie,j), qg(ie,j), net_top_sw_down(ie,j), net_surf_sw_down(ie,j) + write (stdout(),1000) top_lw_up(ie,j), surf_lw_down(ie,j), surf_lw_up(ie,j), dt_tg(ie,j) + endif + 1000 format(4(1x,e11.4)) + endif +enddo + +call ebm_diagnostics_down(Time, top_lw_up, surf_lw_down, surf_lw_up, net_top_sw_down, net_surf_sw_down) + + if(debug_ebm_atm) then + if (mpp_pe() == 0 .and. hour+minute == 0 ) then + print *,"radiation aft diag:Current time: year =",year," month = ",month," day = ",day, " j=",j-1 + write (stdout(),1000) incident_solar(j-1),albedo(ie,j-1),atm_ref,atm_abs + write (stdout(),1000) tg(ie,j-1), qg(ie,j-1), net_top_sw_down(ie,j-1), net_surf_sw_down(ie,j-1) + write (stdout(),1000) top_lw_up(ie,j-1), surf_lw_down(ie,j-1), surf_lw_up(ie,j-1), dt_tg(ie,j-1) + endif + endif + +return +end subroutine radiation +! + + +! ================================================================================== +! +! +! +! Precipiatation module for prognostic equation of atmospheric temperature +! and specific humidity +! + +! +! Precipiatation module for prognostic equation of atmospheric temperature +! and specific humidity +! The atmospheric tendency term (dt_tg) includes the latent heat flux released +! during precipitation (tdel) +! The specific humidity is the balance of evaporation and precipitation (dt_qg) +! + +! + +! +! liquid precipitation rate (rain) in kg/m2/s +! + +! +! frozen precipitation rate (snow) in kg/m2/s +! + +subroutine precipitation(lprec, fprec) + +real, intent(out), dimension(is:ie,js:je) :: lprec, fprec +real, dimension(is:ie,js:je) :: qsat, dqsat, tdel, qdel, & + tg_temp, qg_temp +real :: hlcp, hfcp +integer :: i,j + +integer :: year, month, day, hour, minute, second + +tg_temp = tg + dt_tg*dt + t_bot_atm +qg_temp = qg + dt_qg*dt + +qsat = sat_mixing_ratio(tg_temp) +dqsat = deriv_sat_mixing_ratio(tg_temp) +! tfreeze - temperature where fresh water freezes 273.16 degK +! hlv - Latent heat of evaporation J/kg +! hlf - latent heat of fusion J/kg condensate +! cp_air - specific heat of air at J/kg air/K +hlcp = hlv /cp_air +hfcp = (hlv + hlf)/cp_air +! initialize precipiation to zero +lprec = 0.0 +fprec = 0.0 + +where (qg_temp > qsat .and. tg_temp > tfreeze) + qdel = (qsat - qg_temp)/(1.0 + hlcp*dqsat) + tdel = -hlcp*qdel + lprec = -qdel*mass/dt +elsewhere (qg_temp > qsat .and. tg_temp <= tfreeze) + qdel = (qsat - qg_temp)/(1.0 + hfcp*dqsat) + tdel = -hfcp*qdel + fprec = -qdel*mass/dt +elsewhere + qdel = 0.0 + tdel = 0.0 +endwhere +dt_tg = dt_tg + tdel/dt +dt_qg = dt_qg + qdel/dt + + if(debug_ebm_atm) then + if (mpp_pe() == 0 ) then + print *,"in precip:" + write (stdout(),1000) qg_temp(ie,je), qsat(ie,je), tg_temp(ie,je), dqsat(ie,je) + write (stdout(),1000) tg(ie,je), qg(ie,je), lprec(ie,je), fprec(ie,je) + write (stdout(),1000) dt_tg(ie,je), dt_qg(ie,je), tdel(ie,je), qdel(ie,je) + endif + 1000 format(4(1x,e11.4)) + endif + +return +end subroutine precipitation +! + +! ================================================================================== +! +! +! +! Lateral eddy diffusion module for prognostic equation of atmospheric temperature +! and specific humidity +! + +! +! Lateral eddy diffusion module for prognostic equation of atmospheric temperature +! and specific humidity +! There are two options: uniform or variable diffusion +! + +! + +subroutine diffusion + +real , dimension (ms:me,ns:ne) :: eigen, denom +complex, dimension (ms:me,ns:ne) :: dxs, dys, div +real , dimension (is:ie,js:je) :: dxg, dyg, d + +integer :: m, n + +! real :: nu = 4.0e16 + +call trans_grid_to_spherical(dt_tg, dt_ts) +call trans_grid_to_spherical(dt_qg, dt_qs) + +call get_eigen_laplacian(eigen) + +if(diff_is_uniform) then + + dt_ts = dt_ts - diff*eigen*ts + dt_qs = dt_qs - diff*eigen*qs + +else + + d = diffusivity() + +! temperature + + call compute_gradient_cos(ts, dxs, dys) + + call trans_spherical_to_grid(dxs,dxg) + call trans_spherical_to_grid(dys,dyg) + + dxg = d*dxg + dyg = d*dyg + + call divide_by_cos2(dxg) + call divide_by_cos2(dyg) + + call trans_grid_to_spherical(dxg,dxs) + call trans_grid_to_spherical(dyg,dys) + + div = compute_div(dxs, dys) + call triangular_truncation(div) + + dt_ts = dt_ts + div + +! water vapor + + call compute_gradient_cos(qs, dxs, dys) + + call trans_spherical_to_grid(dxs,dxg) + call trans_spherical_to_grid(dys,dyg) + + dxg = d*dxg + dyg = d*dyg + + call divide_by_cos2(dxg) + call divide_by_cos2(dyg) + + call trans_grid_to_spherical(dxg,dxs) + call trans_grid_to_spherical(dyg,dys) + + div = compute_div(dxs, dys) + call triangular_truncation(div) + + dt_qs = dt_qs + div + +endif + + +dt_ts = dt_ts - nu*eigen*eigen*ts +dt_qs = dt_qs - nu*eigen*eigen*qs + + +denom = 1./(1.0 + (diff*eigen + nu*eigen*eigen)*dt) + +ts = ts + denom*dt*dt_ts +qs = qs + denom*dt*dt_qs + +call trans_spherical_to_grid(ts,tg) +call trans_spherical_to_grid(qs,qg) + + if(debug_ebm_atm) then + if (mpp_pe() == 0 ) then + print *,"diffusion:" + write (stdout(),1000) tg(ie,je), qg(ie,je), denom(me,ne), eigen(me,ne) + write (stdout(),1000) ts(me,ne), qs(me,ne), dt_qs(me,ne), dt_ts(me,ne) + endif + 1000 format(4(1x,e11.4)) + endif + +return +end subroutine diffusion +! + +! ================================================================================== +! +! +! +! For the a given scalar diffusion coefficient the routine returns an array +! + +! +! For the a given scalar diffusion coefficient the routine returns an array +! + +! + +function diffusivity() result(d) + +real, dimension(is:ie,js:je) :: d +d = diff + +return +end function diffusivity +! + + +!####################################################################### +! +! +! +! For the given temperatures routine returns the saturation mixing ratio +! esat - saturation vapor pressure +! +! +! +! For the given temperatures routine returns the saturation mixing ratio +! esat - saturation vapor pressure +! + +function sat_mixing_ratio(t) result(q) + +real, dimension(is:ie,js:je) :: t, q, esat + +call escomp (t, esat) +q = d622*esat/1.e05 + +return +end function sat_mixing_ratio +! + +! ================================================================================== +! +! +! +! For the given temperatures, routine returns the derivative of the saturation mixing ratio +! + +! +! For the given temperatures, routine returns the derivative of the saturation mixing ratio +! + +! +function deriv_sat_mixing_ratio(t) result(q) + +real, dimension(is:ie,js:je) :: t, q, desat + +call descomp (t, desat) +q = d622*desat/1.e05 + +return +end function deriv_sat_mixing_ratio +! + +! ================================================================================== +! +! +! +! returns temp, sphum, pres, height at the lowest model level +! and surface pressure +! + +! +! public routine required for atmospheric components of coupled models +! returns temp, sphum, pres, height at the lowest model level +! and surface pressure +! + +! + +! +! near surface temperature in degrees Kelvin +! + +! +! near surface mixing ratio +! + +! +! pressure at which atmos near usrface values are assumed to be defined +! + +! +! height at which atmos near usrface values are assumed to be defined +! + +! +! surface pressure +! + +subroutine get_bottom_mass (t_bot_out, tr_bot_out, p_bot, z_bot, p_surf, slp) +real, intent(out), dimension(is:ie,js:je) :: t_bot_out, p_bot, z_bot, p_surf, slp +real, intent(out), dimension(:,:,:) :: tr_bot_out + +p_surf = 1000.0e02 ! surface pressure +p_bot = 990.0e02 ! pressure at which atmos near usrface values are assumed to be defined +z_bot = 100.0 ! height at which atmos near surface values are assumed to be defined +t_bot_out = t_bot(is:ie,js:je) ! near surface temperature +tr_bot_out(:,:,1) = q_bot(is:ie,js:je) ! near surface mixing ratio +slp = p_surf + +return +end subroutine get_bottom_mass +! + +! ================================================================================== +! +! +! +! returns u and v on the mass grid at the lowest model level +! + +! +! public routine required for atmospheric components of coupled models +! returns u and v on the mass grid at the lowest model level +! + +! + +! +! near surface zonal wind +! + +! +! near surface meridional wind +! + +subroutine get_bottom_wind (u_bot_out, v_bot_out) +real, intent(out), dimension(is:ie,js:je) :: u_bot_out, v_bot_out + +u_bot_out = u_bot(is:ie,js:je) ! near surface zonal wind +v_bot_out = v_bot(is:ie,js:je) ! near surface meridional wind + +return +end subroutine get_bottom_wind +! + +! ================================================================================== +! +! +! returns the number of longitude and latitude grid points +! for either the local PEs grid (default) or the global grid +! + +! +! public routine required for atmospheric components of coupled models +! returns the number of longitude and latitude grid points +! for either the local PEs grid (default) or the global grid +! + +! + +! +! The number of longitude points in the compute domain. +! + +! +! The number of latitude points in the compute domain. +! + +! +! Flag that specifies whether the returned compute domain size is +! for the global grid (TRUE) or for the current processor (FALSE). +! + +subroutine atmosphere_resolution(num_lon_out, num_lat_out, global) + +integer, intent(out) :: num_lon_out, num_lat_out +logical, intent(in), optional :: global +logical :: global_tmp + +if (present(global)) then + global_tmp = global +else + global_tmp = .false. +endif + +if(global_tmp) then + num_lon_out = lon_max + num_lat_out = lat_max +else + num_lon_out = ie+1-is + num_lat_out = je+1-js +endif + +return +end subroutine atmosphere_resolution +! + +! ================================================================================== +! +! +! +! returns the axis indices associated with the coupling grid +! + +! +! public routine required for atmospheric components of coupled models +! returns the axis indices associated with the coupling grid +! + +! + +! +! The axis identifiers for the atmospheric grids. +! The size of axes must be least 1 but not greater than 4. +! The axes are returned in the order (/ x, y, p_full, p_half /) +! + +subroutine get_atmosphere_axes(axes_out) +integer, intent(out), dimension(:) :: axes_out + +axes_out = axis_id + +return +end subroutine get_atmosphere_axes +! + +! ================================================================================== +! +! +! returns the longitude and latitude grid box edges +! for either the local PEs grid (default) or the global grid +! +! +! public routine required for atmospheric components of coupled models +! returns the longitude and latitude grid box edges +! for either the local PEs grid (default) or the global grid +! + +! + +! +! The west-to-east longitude edges of grid boxes (in radians). +! + +! +! The south-to-north latitude edges of grid boxes (in radians). +! + +! +! Flag that specifies whether the returned grid box edges are +! for the global grid (TRUE) or for the current processor (FALSE). +! +subroutine atmosphere_boundary(lon_boundaries, lat_boundaries, global) + +real, intent(out), dimension(:,:) :: lon_boundaries, lat_boundaries +logical, intent(in), optional :: global +real, dimension(size(lon_boundaries,1)) :: tmpx +real, dimension(size(lon_boundaries,2)) :: tmpy +integer :: i +logical :: global_tmp + + +if(present(global)) then + global_tmp = global +else + global_tmp = .false. +endif +call get_grid_boundaries(tmpx, tmpy, global_tmp) + +do i = 1, size(lon_boundaries,2) + lon_boundaries(:,i) = tmpx(:) +end do + +do i = 1, size(lon_boundaries,1) + lat_boundaries(i,:) = tmpy(:) +end do + +return +end subroutine atmosphere_boundary +! + +! ================================================================================== +! +! +! +! returns grid cell areas for the domain +! +! +! +! returns grid cell areas for the domain +! + + subroutine atmosphere_cell_area(area_out) + real, dimension(:,:), intent(out) :: area_out + integer :: xsize, ysize, j + real, dimension(size(area_out,2)) :: wts_lat + + xsize = ie-is+1 + ysize = je-js+1 + if(any(shape(area_out) /= (/xsize,ysize/))) then + call mpp_error(FATAL,'atmosphere_cell_area: argument has wrong shape. Its shape is ', & + shape(area_out),' It should be ',(/xsize,ysize/)) + endif + + call get_wts_lat(wts_lat) + do j=1,ysize + area_out(:,j) = 2*PI*radius*radius*wts_lat(j)/lon_max + enddo + + end subroutine atmosphere_cell_area + +! + +! ================================================================================== +! +! +! +! returns the domain2d variable associated with the coupling grid +! +! +! +! public routine required for atmospheric components of coupled models +! returns the domain2d variable associated with the coupling grid +! note: coupling is done using the mass/temperature grid with no halos +! +!OUTPUT +! Domain The domain2d variable describing the grid used for coupling. +! For the B-grid, this corresponds to the temperature grid +! without halos. +! + +! + +! +! The domain2d variable describing the grid used for coupling. +! For the B-grid, this corresponds to the temperature grid +! without halos. +! + +subroutine atmosphere_domain(domain) + +type (domain2d), intent(inout) :: domain + + +domain = grid_domain; + +end subroutine atmosphere_domain +! + +! ===================================================================== +! +! +! +! write out restart file +! Termination routine for atmosphere_mod. +! +! +! public routine required for atmospheric components of coupled models +! write out restart file +! Termination routine for atmosphere_mod. +! + +! + +! +! time at the current time level (tau) +! + +! +! Contains information about the grid cells +! + +subroutine atmosphere_end(Time, Grid_box) + +type(time_type), intent(in) :: Time +type(grid_box_type), intent(inout) :: Grid_box +integer :: time_level,seconds,days,unit +character(len=64) :: filename + +if(.not.module_is_initialized) then + call error_mesg('atmosphere_end',' atmosphere_init has not been called.', FATAL) +end if + +!--- write out restart file +filename = 'RESTART/atmosphere.res.nc' + +call write_data(filename, 'ts_real', real(ts), spectral_domain) +call write_data(filename, 'ts_imag', aimag(ts), spectral_domain) +call write_data(filename, 'qs_real', real(qs), spectral_domain) +call write_data(filename, 'qs_imag', aimag(qs), spectral_domain) +call write_data(filename, 'tg', tg, grid_domain) +call write_data(filename, 'qg', qg, grid_domain) + +return +end subroutine atmosphere_end +! + + !####################################################################### + ! + ! + ! dummy routine. + ! + subroutine atmosphere_restart(timestamp) + character(len=*), intent(in) :: timestamp + + call error_mesg ('atmosphere_restart in atmosphere_mod', & + 'intermediate restart capability is not implemented for this model', FATAL) + + end subroutine atmosphere_restart + ! + +! ===================================================================== +! +! +! +! Not implemented properly. Puts value=0 +! +! +! This is a stub routine needed for compilation of mom4_test6. +! It puts value=0 for any index. +! + +! + +! +! +! +! + +subroutine get_stock_pe(index, value) + use stock_constants_mod, only : ISTOCK_WATER, ISTOCK_HEAT + integer, intent(in) :: index + real, intent(out) :: value + + select case (index) + + case (ISTOCK_WATER) + ! don't know how to compute water stock + value = 0 + + case (ISTOCK_HEAT) + ! don't know how to compute water stock + value = 0 + + case default + value = 0.0 + end select + +end subroutine get_stock_pe + +! ================================================================================== +! ================================================================================== + +end module atmosphere_mod diff --git a/MOM_code/src/atmos_ebm/ebm_diagnostics.F90 b/MOM_code/src/atmos_ebm/ebm_diagnostics.F90 new file mode 100644 index 0000000..ae6e329 --- /dev/null +++ b/MOM_code/src/a