diff --git a/.gitattributes b/.gitattributes index 2cee0e56b..de87e69fe 100644 --- a/.gitattributes +++ b/.gitattributes @@ -9,16 +9,16 @@ # Fortran files *.f text diff=fortran *.for text diff=fortran -*.f90 text diff=fortran -*.F90 text diff=fortran -*.f95 text diff=fortran -*.f03 text diff=fortran -*.x90 text diff=fortran -*.X90 text diff=fortran -*.t90 text diff=fortran -*.T90 text diff=fortran -*.pf text diff=fortran -*.PF text diff=fortran +*.f90 text diff=fortran-free-form +*.F90 text diff=fortran-free-form +*.f95 text diff=fortran-free-form +*.f03 text diff=fortran-free-form +*.x90 text diff=fortran-free-form +*.X90 text diff=fortran-free-form +*.t90 text diff=fortran-free-form +*.T90 text diff=fortran-free-form +*.pf text diff=fortran-free-form +*.PF text diff=fortran-free-form # Enable syntax highlighting for files with `.pf` extensions. # diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS index 69546f6a4..be6ff9ab5 100644 --- a/.github/CODEOWNERS +++ b/.github/CODEOWNERS @@ -1 +1,62 @@ +# This CODEOWNERS file includes a primary codeowner and a deputy for each section. +# Codeowners who are not in a comment will be automatically notified of changes +# to the listed files. All codeowners listed are valid points of contact +# for discussing changes and seeking approval for work. +# By default anything not listed here will be owned by the +# @MetOffice/core-capability-development team. + * @MetOffice/core-capability-development + +# Applications +/applications/ @MetOffice/core-capability-development +/applications/coupled/ @mike-hobson # @MetOffice/core-capability-development +/applications/lbc_demo/ @mo-rickywong # @MetOffice/core-capability-development +/mesh_tools/ @mo-rickywong # @MetOffice/core-capability-development + +# Components +/components/ @MetOffice/core-capability-development +/components/coupling/ @mike-hobson # @MetOffice/core-capability-development +/components/science/ @tommbendall # @thomasmelvin + +# Infrastructure +/infrastructure/ @MetOffice/core-capability-development +/infrastructure/**/configuration/ @mo-rickywong # @matthewhambley +/infrastructure/**/field/ @mike-hobson # @MetOffice/core-capability-development +/infrastructure/**/function_space/ @mike-hobson # @MetOffice/core-capability-development +/infrastructure/**/io/ @andrewcoughtrie # @mo-rickywong +/infrastructure/**/key_value/ @mo-rickywong # @mike-hobson +/infrastructure/**/kernel_metadata/ @teranivy # @stevemullerworth +/infrastructure/**/mesh/ @mo-rickywong # @mike-hobson +/infrastructure/**/PSYKE/ @christophermaynard # @teranivy +/infrastructure/**/quadrature/ @thomasmelvin # @tommbendall +/infrastructure/**/scalar/ @mike-hobson # @MetOffice/core-capability-development +/infrastructure/**/time/ @matthewhambley # @andrewcoughtrie +/infrastructure/integration-test/ @matthewhambley # @MetOffice/core-capability-development + +/infrastructure/build/ @matthewhambley # @stevemullerworth +/infrastructure/build/tools/ @mo-rickywong @matthewhambley +**/MakeFile @matthewhambley # @stevemullerworth +/lfric_build/ @matthewhambley # @allynt + +# Documentation +/documentation/** # No code owner for most docs +/documentation/source/index.rst @andrewcoughtrie @stevemullerworth +/documentation/source/conf.py @andrewcoughtrie # @allynt +/documentation/templates/ @andrewcoughtrie # @allynt +/documentation/static/ @andrewcoughtrie # @allynt +/documentation/source/accessibility.rst @stevemullerworth # @yaswant + +# System Components +rose-stem/* @james-bruten-mo # @jennyhickson +rose-stem/templates/ @james-bruten-mo # @jennyhickson +rose-stem/lib/ @james-bruten-mo # @jennyhickson +rose-stem/bin/ @james-bruten-mo # @jennyhickson +rose-stem/site/meto/common/ @james-bruten-mo # @jennyhickson +rose-stem/site/meto/macros/ @james-bruten-mo # @jennyhickson +rose-stem/apps # Mostly updated by macros, no codeowner + +# Other +/etc/psyclone.cfg @teranivy # @MetOffice/ToolsCollabDev +/.github/ @andrewcoughtrie # @yaswant +LICENSE @stevemullerworth # @yaswant + diff --git a/.github/ISSUE_TEMPLATE/bug_report.yml b/.github/ISSUE_TEMPLATE/bug_report.yml index d186d921a..8314c000f 100644 --- a/.github/ISSUE_TEMPLATE/bug_report.yml +++ b/.github/ISSUE_TEMPLATE/bug_report.yml @@ -7,14 +7,6 @@ body: attributes: value: | Thanks for taking the time to fill out this bug report! - - type: input - id: contact - attributes: - label: Contact Details - description: How can we get in touch with you if we need more info? - placeholder: e.g. email@example.com @octocat - validations: - required: false - type: dropdown id: version attributes: @@ -24,7 +16,7 @@ body: - main default: 0 validations: - required: true + required: true - type: input id: linked-issues attributes: diff --git a/.github/ISSUE_TEMPLATE/custom_issue.yml b/.github/ISSUE_TEMPLATE/custom_issue.yml index 148b9401b..cc0c7dc93 100644 --- a/.github/ISSUE_TEMPLATE/custom_issue.yml +++ b/.github/ISSUE_TEMPLATE/custom_issue.yml @@ -7,14 +7,6 @@ body: attributes: value: | Thanks for taking the time to help improve LFRic Core. - - type: input - id: contact - attributes: - label: Contact Details - description: How can we get in touch with you if we need more info? - placeholder: e.g. email@example.com @octocat - validations: - required: false - type: input id: linked-issues attributes: diff --git a/.github/ISSUE_TEMPLATE/documentation.yml b/.github/ISSUE_TEMPLATE/documentation.yml index 27ea9d29d..1a1307a3a 100644 --- a/.github/ISSUE_TEMPLATE/documentation.yml +++ b/.github/ISSUE_TEMPLATE/documentation.yml @@ -1,5 +1,5 @@ name: Documentation Issue -description: Report an issue with the LFRic Core documentation or suggest an improvement. +description: Report an issue with the LFRic Core documentation or suggest an improvement. labels: ["documentation"] type: task body: @@ -7,14 +7,6 @@ body: attributes: value: | Thanks for taking the time to help improve the LFRic Core documentation. - - type: input - id: contact - attributes: - label: Contact Details - description: How can we get in touch with you if we need more info? - placeholder: e.g. email@example.com @octocat - validations: - required: false - type: input id: linked-issues attributes: diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md index b0a170eed..403dcc900 100644 --- a/.github/pull_request_template.md +++ b/.github/pull_request_template.md @@ -1,6 +1,6 @@ # PR Summary -Sci/Tech Reviewer: +Sci/Tech Reviewer: Code Reviewer: @@ -22,28 +22,19 @@ Code Reviewer: ## Code Quality Checklist -(_Some checks are automatically carried out via the CI pipeline_) - - [ ] I have performed a self-review of my own code -- [ ] My code follows the project's - [style guidelines](https://metoffice.github.io/lfric_core/how_to_contribute/index.html#how-to-contribute-index) -- [ ] Comments have been included that aid undertanding and enhance the - readability of the code +- [ ] My code follows the project's [style guidelines](https://metoffice.github.io/lfric_core/how_to_contribute/index.html#how-to-contribute-index) +- [ ] Comments have been included that aid understanding and enhance the readability of the code - [ ] My changes generate no new warnings +- [ ] All automated checks in the CI pipeline have completed successfully ## Testing - [ ] I have tested this change locally, using the LFRic Core rose-stem suite -- [ ] If required (eg. API changes) I have also run the LFRic Apps test suite - using this branch -- [ ] If any tests fail (rose-stem or CI) the reason is understood and - acceptable (eg. kgo changes) -- [ ] I have added tests to cover new functionality as appropriate (eg. system - tests, unit tests, etc.) -- [ ] Any new tests have been assigned an appropriate amount of compute resource - and have been allocated to an appropriate testing group (i.e. the - developer tests are for jobs which use a small amount of compute resource - and complete in a matter of minutes) +- [ ] If required (e.g. API changes) I have also run the LFRic Apps test suite using this branch +- [ ] If any tests fail (rose-stem or CI) the reason is understood and acceptable (e.g. kgo changes) +- [ ] I have added tests to cover new functionality as appropriate (e.g. system tests, unit tests, etc.) +- [ ] Any new tests have been assigned an appropriate amount of compute resource and have been allocated to an appropriate testing group (i.e. the developer tests are for jobs which use a small amount of compute resource and complete in a matter of minutes) @@ -59,30 +50,21 @@ Code Reviewer: ## Performance Impact -- [ ] Performance of the code has been considered and, if applicable, suitable - performance measurements have been conducted +- [ ] Performance of the code has been considered and, if applicable, suitable performance measurements have been conducted ## AI Assistance and Attribution -- [ ] Some of the content of this change has been produced with the assistance - of _Generative AI tool name_ (e.g., Met Office Github Copilot Enterprise, - Github Copilot Personal, ChatGPT GPT-4, etc) and I have followed the - [Simulation Systems AI policy](https://metoffice.github.io/simulation-systems/FurtherDetails/ai.html) - (including attribution labels) +- [ ] Some of the content of this change has been produced with the assistance of _Generative AI tool name_ (e.g., Met Office Github Copilot Enterprise, Github Copilot Personal, ChatGPT GPT-4, etc) and I have followed the [Simulation Systems AI policy](https://metoffice.github.io/simulation-systems/FurtherDetails/ai.html) (including attribution labels) ## Documentation -- [ ] Where appropriate I have updated documentation related to this change and - confirmed that it builds correctly +- [ ] Where appropriate I have updated documentation related to this change and confirmed that it builds correctly ## PSyclone Approval -- [ ] If you have edited any PSyclone-related code (eg. PSyKAl-lite, Kernel - interface, optimisation scripts, LFRic data structure code) then please - contact the - [tooscollabdevteam@metoffice.gov.uk](tooscollabdevteam@metoffice.gov.uk) +- [ ] If you have edited any PSyclone-related code (e.g. PSyKAl-lite, Kernel interface, optimisation scripts, LFRic data structure code) then please contact the [TCD Team](mailto:ToolsCollabDevTeam@metoffice.gov.uk) # Sci/Tech Review @@ -94,7 +76,7 @@ Code Reviewer: - [ ] Documentation is sufficient (do documentation papers need updating) - [ ] Sufficient testing has been completed -_Please alert the code reviewer via a tag when you have approved the SR_ +(_Please alert the code reviewer via a tag when you have approved the SR_) # Code Review diff --git a/.github/workflows/ci.yml b/.github/workflows/ci_docs.yml similarity index 81% rename from .github/workflows/ci.yml rename to .github/workflows/ci_docs.yml index 381f55787..a580467c1 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci_docs.yml @@ -4,13 +4,16 @@ # under which the code may be used. # ------------------------------------------------------------------------------ -name: ci -run-name: CI +name: Documentation +run-name: Docs Build and Deploy - ${{ github.ref_name }} on: push: branches: - main + paths: + - 'documentation/**' + - '.github/workflows/**' concurrency: group: ${{ github.workflow }}-${{github.ref}} diff --git a/.github/workflows/pr.yml b/.github/workflows/pr_docs.yml similarity index 82% rename from .github/workflows/pr.yml rename to .github/workflows/pr_docs.yml index 72693292e..ab32daaf9 100644 --- a/.github/workflows/pr.yml +++ b/.github/workflows/pr_docs.yml @@ -4,12 +4,16 @@ # under which the code may be used. # ------------------------------------------------------------------------------ -name: pr -run-name: Pull Request ${{github.event.pull_request.number}} +name: Docs Build for Pull Requests +run-name: Docs build on: pull_request: branches: - main + paths: + - 'documentation/**' + - '.github/workflows/**' + concurrency: group: pr-${{github.ref}}-${{github.event.pull_request.number || github.run_number}} diff --git a/.github/workflows/ru_deploy-docs.yml b/.github/workflows/ru_deploy-docs.yml index 2867b69d7..708260f93 100644 --- a/.github/workflows/ru_deploy-docs.yml +++ b/.github/workflows/ru_deploy-docs.yml @@ -11,6 +11,7 @@ on: jobs: deploy: + if: ${{ github.repository == 'MetOffice/lfric_core' }} environment: name: github-pages permissions: diff --git a/.github/workflows/track-review-project.yaml b/.github/workflows/track-review-project.yaml new file mode 100644 index 000000000..639477cd2 --- /dev/null +++ b/.github/workflows/track-review-project.yaml @@ -0,0 +1,17 @@ +name: Track Review Project + +on: + workflow_run: + workflows: [Trigger Review Project] + types: + - completed + +permissions: + actions: read + contents: read + pull-requests: write + +jobs: + track_review_project: + uses: MetOffice/growss/.github/workflows/track-review-project.yaml@main + secrets: inherit diff --git a/.github/workflows/trigger-project-workflow.yaml b/.github/workflows/trigger-project-workflow.yaml new file mode 100644 index 000000000..ccb7a55b0 --- /dev/null +++ b/.github/workflows/trigger-project-workflow.yaml @@ -0,0 +1,17 @@ +name: Trigger Review Project + +on: + pull_request_target: + types: ["opened", "synchronize", "reopened", "edited", "review_requested", "review_request_removed", "closed"] + pull_request_review: + pull_request_review_comment: + +permissions: + actions: read + contents: read + pull-requests: write + +jobs: + trigger_project_workflow: + uses: MetOffice/growss/.github/workflows/trigger-project-workflow.yaml@main + secrets: inherit diff --git a/.gitignore b/.gitignore index 31cbc46f8..164a542f5 100644 --- a/.gitignore +++ b/.gitignore @@ -57,6 +57,19 @@ __pycache__ # LFRic CL Builds applications/**/bin applications/**/working +applications/**/test +applications/**/documents applications/**/example*/ +mesh_tools/**/bin +mesh_tools/**/working +mesh_tools/**/test +components/**/bin +components/**/working +components/**/test +components/**/documents +infrastructure/**/bin +infrastructure/**/working +infrastructure/**/test +infrastructure/**/documents science/**/bin science/**/working diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index d0f7ae14d..8fbcb1c91 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -1,6 +1,25 @@ # Contributors -| GitHub user | Real Name | Affiliation | Date | -| ----------- | --------- | ----------- | ---- | -| james-bruten-mo | James Bruten | Met Office | 2025-12-09 | -| jennyhickson | Jenny Hickson | Met Office | 2025-12-10 | +| GitHub user | Real Name | Affiliation | Date | +| ---------------- | ---------------------- | ----------- | ---------- | +| andrewcoughtrie | Andrew Coughtrie | Met Office | 2025.12.12 | +| james-bruten-mo | James Bruten | Met Office | 2025-12-09 | +| jedbakerMO | Jed Baker | Met Office | 2025-12-29 | +| jennyhickson | Jenny Hickson | Met Office | 2025-12-10 | +| mo-marqh | Mark Hedley | Met Office | 2025-12-11 | +| mo-rickywong | Ricky Wong | Met Office | 2025-01-30 | +| mike-hobson | Mike Hobson | Met Office | 2025-12-17 | +| MatthewHambley | Matthew Hambley | Met Office | 2025-12-15 | +| mo-lottieturner | Lottie Turner | Met Office | 2025-12-16 | +| tommbendall | Thomas Bendall | Met Office | 2026-01-23 | +| yaswant | Yaswant Pradhan | Met Office | 2025-12-16 | +| stevemullerworth | Steve Mullerworth | Met Office | 2026-01-08 | +| harry-shepherd | Harry Shepherd | Met Office | 2026-01-08 | +| EdHone | Ed Hone | Met Office | 2026-01-09 | +| tom-j-h | Tom Hill | Met Office | 2026-01-19 | +| mo-alistairp | Alistair Pirrie | Met Office | 2026-01-12 | +| t00sa | Sam Clarke-Green | Met Office | 2026-01-27 | +| MetBenjaminWent | Benjamin Went | Met Office | 2026-01-30 | +| jcsmeto | James Cunningham-Smith | Met Office | 2026-02-06 | +| thomasmelvin | Thomas Melvin | Met Office | 2026-01-15 | +| ericaneininger | Erica Neininger | Met Office | 2026-03-02 | \ No newline at end of file diff --git a/CodeOwners.txt b/CodeOwners.txt deleted file mode 100644 index 306770f46..000000000 --- a/CodeOwners.txt +++ /dev/null @@ -1,73 +0,0 @@ -Code Owners -=========== - -This page lists ownership of major components of the LFRic codebase -including components, applications and also generic capabilities. - -Responsibility for a named source code directory implies -responsibility for the unit and integration tests for its code that -live in separate parallel directory paths. - -* Code owners should be given the option to be a science/technical reviewer - for any code that alters their sections. -* Developers should consider discussing changes with the code owner - early in the planning stage if appropriate. -* Ownership imposes a responsibility to deal with requests in a timely - manner. -* Ownership is not a commitment for the individual to undertake all work - requested or all reviewing for the owned section. However, it would - be expected that the code owner can delegate to ensure requests are - dealt with, or to justify an inability to engage. - -# Start of script readable lines - -= LFRic Fortran source code = - -{{{ -Area First Contact Second Contact Team -applications/simple_diffusion andrewcoughtrie stevemullerworth core_capability_development -applications/skeleton mikehobson stevemullerworth core_capability_development -components/driver mikehobson stevemullerworth core_capability_development -components/inventory stevemullerworth mikehobson core_capability_development -components/lfric-xios andrewcoughtrie stevemullerworth core_capability_development -components/science thomasbendall thomasmelvin core_capability_development -infrastructure_configuration rickywong matthewhambley core_capability_development -infrastructure_field mikehobson stevemullerworth core_capability_development -infrastructure_function_space mikehobson stevemullerworth core_capability_development -infrastructure_io andrewcoughtrie rickywong core_capability_development -infrastructure_kernel_metadata ivakavcic stevemullerworth tools_and_collaborative_development -infrastructure_key_value mikehobson stevemullerworth core_capability_development -infrastructure_mesh rickywong mikehobson core_capability_development -infrastructure_operator mikehobson stevemullerworth core_capability_development -infrastructure_PSYKE christophermaynard ivakavcic technical_optimisation -infrastructure_quadrature thomasmelvin thomasbendall dynamics_research -infrastructure_scalar mikehobson stevemullerworth core_capability_development -infrastructure_time matthewhambley andrewcoughtrie core_capability_development -infrastructure_utilities matthewhambley mikehobson core_capability_development -mesh_tools rickywong matthewhambley core_capability_development -}}} - -= System Components = -{{{ -Area First Contact Second Contact Team -Makefile matthewhambley stevemullerworth core_capability_development -applications/create_miniapp.py matthewhambley rickywong core_capability_development -bin matthewhambley rickywong core_capability_development -etc matthewhambley lucygordon core_capability_development -rose-stem matthewhambley jamesbruten core_capability_development -infrastructure/Makefile matthewhambley stevemullerworth core_capability_development -infrastructure/build matthewhambley stevemullerworth core_capability_development -infrastructure/documentation stevemullerworth mikehobson core_capability_development -infrastructure/rose-stem matthewhambley stevemullerworth core_capability_development -}}} - -= Other Projects = - -{{{ -Area First Contact Second Contact Team -Docs jameskent thomasbendall dynamics_research -GPL-utilities rickywong lottieturner core_capability_development -physics-dev(deprecated) benshipway -- dynamics_research -Spectator matthewhambley -- core_capability_development -vendor(deprecated) matthewhambley -- core_capability_development -}}} diff --git a/README.md b/README.md index 52a4c4949..6889a1022 100644 --- a/README.md +++ b/README.md @@ -1,19 +1,27 @@ # LFRic Core -[![ci](https://github.com/MetOffice/lfric_core/actions/workflows/ci.yml/badge.svg)](https://github.com/MetOffice/lfric_core/actions/workflows/ci.yml) +Welcome to LFRic Core! -Location for LFRic infrastructure source code and documentation +LFRic Core provides the underlying infrastructure for the Momentum® Atmosphere model and associated applications. -On the Met Office Azure Spice machine the main LFRic module environment -contains all the required packages to build the documentation. To build use -`make html` in the documentation directory. `make help` will give you the other -options available. Additionally, `make deploy` will build a copy of the -documentation and deploy it to a directory in `$(HOME)/public_html` named after -the git branch. +| | | +|-----------|-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------| +|:repeat: CI| [![Documentation](https://github.com/MetOffice/lfric_core/actions/workflows/ci_docs.yml/badge.svg)](https://github.com/MetOffice/lfric_core/actions/workflows/ci_docs.yml) | +|:speech_balloon: Community| [![Static Badge](https://img.shields.io/badge/GitHub-discussions-gold)](https://github.com/MetOffice/simulation-systems/discussions/categories/lfric) | +|:package: Repo | [![GitHub License](https://img.shields.io/github/license/metoffice/lfric_core)](https://github.com/MetOffice/lfric_core?tab=BSD-3-Clause-1-ov-file#readme) [![GitHub Release](https://img.shields.io/github/v/release/metoffice/lfric_core?color=purple)](https://github.com/MetOffice/lfric_core/releases) ![GitHub commits since latest release](https://img.shields.io/github/commits-since/metoffice/lfric_core/latest) | +| | | -## Contributing Guidelines +## Getting Started + +Please find information on getting started using the LFRic Core infrastructure +in the [documentation](https://metoffice.github.io/lfric_core/). If you are +looking for the LFRic Atmosphere model this can be found in the +[LFRic Apps](https://github.com/MetOffice/lfric_apps) repository. -Welcome! +The LFRic Core release schedule and deadlines can be viewed in the +[milestones](https://github.com/metoffice/lfric_core/milestones). + +## Contributing Guidelines The following links are here to help set clear expectations for everyone contributing to this project. By working together under a shared understanding, @@ -23,7 +31,7 @@ space for all contributors. ### Contributors Licence Agreement Please see the -[Momentum Contributors Licence Agreement](https://github.com/MetOffice/Momentum/blob/main/CLA.md) +[Momentum Contributors Licence Agreement.](https://github.com/MetOffice/Momentum/blob/main/CLA.md) Agreement of the CLA can be shown by adding yourself to the CONTRIBUTORS file alongside this one, and is a requirement for contributing to this project. @@ -31,7 +39,7 @@ alongside this one, and is a requirement for contributing to this project. ### Code of Conduct Please be aware of and follow the -[Momentum Code of Coduct](https://github.com/MetOffice/Momentum/blob/main/docs/CODE_OF_CONDUCT.md) +[Momentum Code of Conduct.](https://github.com/MetOffice/Momentum/blob/main/docs/CODE_OF_CONDUCT.md) ### Working Practices diff --git a/applications/coupled/rose-meta/lfric-coupled/version30_31.py b/applications/coupled/rose-meta/lfric-coupled/version30_31.py new file mode 100644 index 000000000..12c7c2a21 --- /dev/null +++ b/applications/coupled/rose-meta/lfric-coupled/version30_31.py @@ -0,0 +1,45 @@ +import re +import sys + +from metomi.rose.upgrade import MacroUpgrade + +from .version22_30 import * + + +class UpgradeError(Exception): + """Exception created when an upgrade fails.""" + + def __init__(self, msg): + self.msg = msg + + def __repr__(self): + sys.tracebacklimit = 0 + return self.msg + + __str__ = __repr__ + + +""" +Copy this template and complete to add your macro +class vnXX_txxx(MacroUpgrade): + # Upgrade macro for by + BEFORE_TAG = "vnX.X" + AFTER_TAG = "vnX.X_txxx" + def upgrade(self, config, meta_config=None): + # Add settings + return config, self.reports +""" + + +class vn30_t306(MacroUpgrade): + """Upgrade macro for ticket TTTT by Unknown.""" + + BEFORE_TAG = "vn3.0" + AFTER_TAG = "vn3.1" + + def upgrade(self, config, meta_config=None): + # Commands From: rose-meta/lfric-driver + # Blank Upgrade Macro + # Commands From: rose-meta/lfric-coupled + # Blank Upgrade Macro + return config, self.reports diff --git a/applications/coupled/rose-meta/lfric-coupled/versions.py b/applications/coupled/rose-meta/lfric-coupled/versions.py index 152c043d0..01798ad2b 100644 --- a/applications/coupled/rose-meta/lfric-coupled/versions.py +++ b/applications/coupled/rose-meta/lfric-coupled/versions.py @@ -1,8 +1,8 @@ import sys -from metomi.rose.upgrade import MacroUpgrade +from metomi.rose.upgrade import MacroUpgrade # noqa: F401 -from .version22_30 import * +from .version30_31 import * class UpgradeError(Exception): diff --git a/applications/coupled/rose-meta/lfric-coupled/vn3.1/rose-meta.conf b/applications/coupled/rose-meta/lfric-coupled/vn3.1/rose-meta.conf new file mode 100644 index 000000000..b9730e75e --- /dev/null +++ b/applications/coupled/rose-meta/lfric-coupled/vn3.1/rose-meta.conf @@ -0,0 +1 @@ +import=lfric-driver/vn3.1 diff --git a/applications/coupled/source/coupled.f90 b/applications/coupled/source/coupled.f90 index 503740ed6..b1e4f280a 100644 --- a/applications/coupled/source/coupled.f90 +++ b/applications/coupled/source/coupled.f90 @@ -13,7 +13,7 @@ program coupled - use cli_mod, only: get_initial_filename + use cli_mod, only: parse_command_line use constants_mod, only: precision_real use driver_collections_mod, only: init_collections, final_collections use driver_comm_mod, only: init_comm, final_comm @@ -38,11 +38,12 @@ program coupled character(:), allocatable :: cpl_component_name character(:), allocatable :: filename - call get_initial_filename( filename, component_name=cpl_component_name ) + call parse_command_line( filename, component_name=cpl_component_name ) call modeldb%values%initialise( 'values', 5 ) call modeldb%configuration%initialise( program_name, table_len=10 ) + call modeldb%config%initialise( program_name ) write(log_scratch_space,'(A)') & 'Application built with '// trim(precision_real) // & @@ -53,8 +54,12 @@ program coupled call modeldb%values%add_key_value('cpl_name', cpl_component_name) call init_comm( "coupled", modeldb ) - call init_config( filename, coupled_required_namelists, & - modeldb%configuration ) + + call init_config( filename, & + coupled_required_namelists, & + configuration=modeldb%configuration, & + config=modeldb%config ) + call init_logger( modeldb%mpi%get_comm(), & program_name//"_"//cpl_component_name ) call init_collections() diff --git a/applications/coupled/source/driver/coupled_driver_mod.f90 b/applications/coupled/source/driver/coupled_driver_mod.f90 index 892f59215..ba5ded978 100644 --- a/applications/coupled/source/driver/coupled_driver_mod.f90 +++ b/applications/coupled/source/driver/coupled_driver_mod.f90 @@ -32,7 +32,7 @@ module coupled_driver_mod LOG_LEVEL_INFO use mesh_mod, only : mesh_type use mesh_collection_mod, only : mesh_collection - use namelist_mod, only : namelist_type + use sci_checksum_alg_mod, only : checksum_alg implicit none @@ -69,13 +69,9 @@ subroutine initialise( program_name, modeldb, calendar ) class(extrusion_type), allocatable :: extrusion type(uniform_extrusion_type), allocatable :: extrusion_2d - type(namelist_type), pointer :: base_mesh_nml - type(namelist_type), pointer :: planet_nml - type(namelist_type), pointer :: extrusion_nml - character(str_def) :: prime_mesh_name - integer(i_def) :: stencil_depth + integer(i_def) :: stencil_depth(1) integer(i_def) :: geometry integer(i_def) :: method integer(i_def) :: number_of_layers @@ -89,18 +85,12 @@ subroutine initialise( program_name, modeldb, calendar ) ! Extract namelist variables - base_mesh_nml => modeldb%configuration%get_namelist('base_mesh') - planet_nml => modeldb%configuration%get_namelist('planet') - extrusion_nml => modeldb%configuration%get_namelist('extrusion') - call base_mesh_nml%get_value( 'prime_mesh_name', prime_mesh_name ) - call base_mesh_nml%get_value( 'geometry', geometry ) - call extrusion_nml%get_value( 'method', method ) - call extrusion_nml%get_value( 'domain_height', domain_height ) - call extrusion_nml%get_value( 'number_of_layers', number_of_layers ) - call planet_nml%get_value( 'scaled_radius', scaled_radius ) - base_mesh_nml => null() - planet_nml => null() - extrusion_nml => null() + prime_mesh_name = modeldb%config%base_mesh%prime_mesh_name() + geometry = modeldb%config%base_mesh%geometry() + method = modeldb%config%extrusion%method() + domain_height = modeldb%config%extrusion%domain_height() + number_of_layers = modeldb%config%extrusion%number_of_layers() + scaled_radius = modeldb%config%planet%scaled_radius() ! Initialise mesh ! Determine the required meshes @@ -118,7 +108,7 @@ subroutine initialise( program_name, modeldb, calendar ) LOG_LEVEL_ERROR) end select allocate( extrusion, source=create_extrusion( method, & - domain_height, & + domain_height, & domain_bottom, & number_of_layers, & PRIME_EXTRUSION ) ) diff --git a/applications/coupled/source/driver/init_coupled_mod.X90 b/applications/coupled/source/driver/init_coupled_mod.X90 index 54402acf7..3028d5a06 100644 --- a/applications/coupled/source/driver/init_coupled_mod.X90 +++ b/applications/coupled/source/driver/init_coupled_mod.X90 @@ -21,8 +21,8 @@ module init_coupled_mod use field_collection_mod, only : field_collection_type use field_mod, only : field_type use field_parent_mod, only : write_interface - use finite_element_config_mod, only : element_order_h, element_order_v use function_space_collection_mod, only : function_space_collection + use function_space_mod, only : function_space_type use fs_continuity_mod, only : W3 use log_mod, only : log_event, & LOG_LEVEL_INFO, & @@ -40,11 +40,12 @@ module init_coupled_mod !> @param[in,out] chi The co-ordinate field !> @param[in,out] panel_id 2d field giving the id for cubed sphere panels !> @param[in,out] modeldb The structure that holds model state - subroutine init_coupled( mesh, chi, panel_id, modeldb) + subroutine init_coupled(mesh, chi, panel_id, modeldb) implicit none type(mesh_type), intent(in), pointer :: mesh + ! Coordinate field type( field_type ), intent(inout) :: chi(:) type( field_type ), intent(inout) :: panel_id @@ -74,19 +75,23 @@ module init_coupled_mod procedure(write_interface), pointer :: tmp_ptr + integer(i_def) :: order_h, order_v + type(function_space_type), pointer :: fs + call log_event( 'coupled: Initialising app ...', LOG_LEVEL_INFO ) ! Get the name of the coupling component call modeldb%values%get_value("cpl_name", cpl_component_name) + order_h = modeldb%config%finite_element%element_order_h() + order_v = modeldb%config%finite_element%element_order_v() + + fs => function_space_collection%get_fs(mesh, order_h, order_v, W3) + ! Create prognostic fields ! Creates a field in the W3 function space (fully discontinuous field) - call field_1%initialise( vector_space = & - function_space_collection%get_fs(mesh, element_order_h, element_order_v, W3), & - name="field_1") - call field_2%initialise( vector_space = & - function_space_collection%get_fs(mesh, element_order_h, element_order_v, W3), & - name="field_2") + call field_1%initialise(fs, name="field_1") + call field_2%initialise(fs, name="field_2") ! Add field to modeldb depository => modeldb%fields%get_field_collection("depository") diff --git a/applications/io_demo/rose-meta/lfric-io_demo/version30_31.py b/applications/io_demo/rose-meta/lfric-io_demo/version30_31.py new file mode 100644 index 000000000..5f57cc56d --- /dev/null +++ b/applications/io_demo/rose-meta/lfric-io_demo/version30_31.py @@ -0,0 +1,45 @@ +import re +import sys + +from metomi.rose.upgrade import MacroUpgrade + +from .version22_30 import * + + +class UpgradeError(Exception): + """Exception created when an upgrade fails.""" + + def __init__(self, msg): + self.msg = msg + + def __repr__(self): + sys.tracebacklimit = 0 + return self.msg + + __str__ = __repr__ + + +""" +Copy this template and complete to add your macro +class vnXX_txxx(MacroUpgrade): + # Upgrade macro for by + BEFORE_TAG = "vnX.X" + AFTER_TAG = "vnX.X_txxx" + def upgrade(self, config, meta_config=None): + # Add settings + return config, self.reports +""" + + +class vn30_t306(MacroUpgrade): + """Upgrade macro for ticket TTTT by Unknown.""" + + BEFORE_TAG = "vn3.0" + AFTER_TAG = "vn3.1" + + def upgrade(self, config, meta_config=None): + # Commands From: rose-meta/lfric-driver + # Blank Upgrade Macro + # Commands From: rose-meta/lfric-io_demo + # Blank Upgrade Macro + return config, self.reports diff --git a/applications/io_demo/rose-meta/lfric-io_demo/versions.py b/applications/io_demo/rose-meta/lfric-io_demo/versions.py index 152c043d0..01798ad2b 100644 --- a/applications/io_demo/rose-meta/lfric-io_demo/versions.py +++ b/applications/io_demo/rose-meta/lfric-io_demo/versions.py @@ -1,8 +1,8 @@ import sys -from metomi.rose.upgrade import MacroUpgrade +from metomi.rose.upgrade import MacroUpgrade # noqa: F401 -from .version22_30 import * +from .version30_31 import * class UpgradeError(Exception): diff --git a/applications/io_demo/rose-meta/lfric-io_demo/vn3.1/rose-meta.conf b/applications/io_demo/rose-meta/lfric-io_demo/vn3.1/rose-meta.conf new file mode 100644 index 000000000..bd3389f88 --- /dev/null +++ b/applications/io_demo/rose-meta/lfric-io_demo/vn3.1/rose-meta.conf @@ -0,0 +1,29 @@ +import=lfric-driver/vn3.1 + +[namelist:io=multifile_io] +compulsory=true +description=Use multifile_io functionality +help=This is used to turn the multifile_io functionality in the io_demo app + =on and off +!kind=default +type=logical + +[namelist:multifile_io] +compulsory=false +duplicate=true +!instance_key_member=filename + +[namelist:multifile_io=filename] +compulsory=true +!kind=default +type=character + +[namelist:multifile_io=start_timestep] +compulsory=true +!kind=default +type=integer + +[namelist:multifile_io=stop_timestep] +compulsory=true +!kind=default +type=integer diff --git a/applications/io_demo/source/algorithm/io_demo_alg_mod.x90 b/applications/io_demo/source/algorithm/io_demo_alg_mod.x90 index 009919d39..e42ccba00 100644 --- a/applications/io_demo/source/algorithm/io_demo_alg_mod.x90 +++ b/applications/io_demo/source/algorithm/io_demo_alg_mod.x90 @@ -6,16 +6,18 @@ !>@brief Module containing io_demo_alg module io_demo_alg_mod + use constants_mod, only: i_def,r_def + use driver_modeldb_mod, only: modeldb_type use log_mod, only: log_event, & LOG_LEVEL_INFO, & LOG_LEVEL_TRACE use mesh_mod, only: mesh_type + use field_mod, only: field_type - use finite_element_config_mod, only: element_order_h, & - element_order_v - use fs_continuity_mod, only: Wtheta, W2 + use fs_continuity_mod, only: Wtheta use function_space_collection_mod, only: function_space_collection + use function_space_mod, only: function_space_type use operator_mod, only: operator_type use matrix_vector_kernel_mod, only: matrix_vector_kernel_type use io_demo_constants_mod, only: get_dx_at_w2 @@ -31,11 +33,14 @@ module io_demo_alg_mod contains !> @details Calculates the diffusion increment for a field, and adds it to said field. + !> @param[in] modeldb Application state object !> @param[inout] field_in Input Wtheta field - subroutine io_demo_alg( field_in ) + subroutine io_demo_alg( modeldb, field_in ) implicit none + type(modeldb_type), intent(in) :: modeldb + ! Prognostic fields type( field_type ), intent( inout ) :: field_in @@ -44,20 +49,27 @@ contains type( field_type ) :: visc real(r_def), parameter :: visc_val = 100000.0_r_def - type(mesh_type), pointer :: mesh => null() integer(kind=i_def), parameter :: stencil_depth = 1_i_def - type( field_type ), pointer :: dx_at_w2 => null() + type(mesh_type), pointer :: mesh + type(field_type), pointer :: dx_at_w2 + type(function_space_type), pointer :: fs + + integer(i_def) :: order_h, order_v call log_event( "io_demo: Running algorithm", LOG_LEVEL_TRACE ) - mesh => field_in%get_mesh() + + order_h = modeldb%config%finite_element%element_order_h() + order_v = modeldb%config%finite_element%element_order_v() + + mesh => field_in%get_mesh() dx_at_w2 => get_dx_at_w2(mesh) - call dfield_in%initialise( & - function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, Wtheta)) - call visc%initialise( & - function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, Wtheta)) + + fs => function_space_collection%get_fs(mesh, order_h, order_v, Wtheta) + + call dfield_in%initialise(fs) + call visc%initialise(fs) + call invoke( name = "compute_diffusion", & setval_c(visc, visc_val), & setval_c(dfield_in, 0.0_r_def), & diff --git a/applications/io_demo/source/algorithm/io_demo_constants_mod.x90 b/applications/io_demo/source/algorithm/io_demo_constants_mod.x90 index 9bce8269f..52d3d640b 100644 --- a/applications/io_demo/source/algorithm/io_demo_constants_mod.x90 +++ b/applications/io_demo/source/algorithm/io_demo_constants_mod.x90 @@ -15,30 +15,31 @@ module io_demo_constants_mod ! Infrastructure - use constants_mod, only: i_def, r_def, & + use constants_mod, only: i_def, r_def, l_def, & str_def, str_short + use driver_modeldb_mod, only: modeldb_type use field_collection_mod, only: field_collection_type use field_mod, only: field_type use fs_continuity_mod, only: W2 use function_space_collection_mod, only: function_space_collection use function_space_mod, only: function_space_type - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, LOG_LEVEL_TRACE, & LOG_LEVEL_ERROR use mesh_mod, only: mesh_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Kernels - use sci_calc_dA_at_w2_kernel_mod, only: calc_dA_at_w2_kernel_type - use sci_calc_detj_at_w2_kernel_mod, only: calc_detj_at_w2_kernel_type - use sci_multiplicity_kernel_mod, only: multiplicity_kernel_type + use sci_calc_dA_at_w2_kernel_mod, only: calc_dA_at_w2_kernel_type + use sci_calc_detj_at_w2_kernel_mod, only: calc_detj_at_w2_kernel_type + use sci_multiplicity_kernel_mod, only: multiplicity_kernel_type implicit none private ! Objects for dx_at_w2 functionality - type(field_collection_type) :: dx_at_w2_collection + type(field_collection_type) :: dx_at_w2_collection private :: add_dx_at_w2 @@ -48,21 +49,24 @@ module io_demo_constants_mod contains !> @brief Subroutine to create the finite element constants + !> @param[in] modeldb Application state object !> @param[in] mesh The prime model mesh !> @param[in] chi Coordinate fields !> @param[in] panel_id Panel_id field - subroutine create_io_demo_constants(mesh, & - chi, & - panel_id ) + subroutine create_io_demo_constants(modeldb, mesh, chi, panel_id) implicit none ! Arguments - type(mesh_type), pointer, intent(in) :: mesh - type(field_type), target, intent(in) :: chi(:) - type(field_type), target, intent(in) :: panel_id + type(modeldb_type), intent(in) :: modeldb + type(mesh_type), pointer, intent(in) :: mesh + type(field_type), target, intent(in) :: chi(:) + type(field_type), target, intent(in) :: panel_id + + integer(tik) :: id + + if ( LPROF ) call start_timing( id, 'io_demo_constants_alg' ) - if ( subroutine_timers ) call timer('io_demo_constants_alg') call log_event( "io_demo: creating runtime constants", LOG_LEVEL_TRACE ) !============================= dx_at_w2 setup =============================! @@ -72,7 +76,7 @@ contains call log_event( "io_demo: runtime constants created", LOG_LEVEL_TRACE ) - if ( subroutine_timers ) call timer('io_demo_constants_alg') + if ( LPROF ) call stop_timing( id, 'io_demo_constants_alg' ) call log_event( "io_demo: created FEM constants", LOG_LEVEL_TRACE ) end subroutine create_io_demo_constants diff --git a/applications/io_demo/source/driver/init_io_demo_mod.F90 b/applications/io_demo/source/driver/init_io_demo_mod.F90 index 1ba932375..0be601260 100644 --- a/applications/io_demo/source/driver/init_io_demo_mod.F90 +++ b/applications/io_demo/source/driver/init_io_demo_mod.F90 @@ -12,22 +12,19 @@ module init_io_demo_mod use sci_assign_field_random_range_alg_mod, only: assign_field_random_range - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, l_def use driver_modeldb_mod, only : modeldb_type use field_collection_mod, only : field_collection_type use field_mod, only : field_type use field_parent_mod, only : write_interface - use finite_element_config_mod, only : element_order_h, & - element_order_v use function_space_collection_mod, only : function_space_collection + use function_space_mod, only : function_space_type use fs_continuity_mod, only : Wtheta use key_value_mod, only : abstract_value_type use log_mod, only : log_event, & LOG_LEVEL_TRACE, & LOG_LEVEL_ERROR use mesh_mod, only : mesh_type - use io_config_mod, only : write_diag, & - use_xios_io use lfric_xios_write_mod, only : write_field_generic use io_demo_constants_mod, only : create_io_demo_constants use random_number_generator_mod, only : random_number_generator_type @@ -37,20 +34,21 @@ module init_io_demo_mod contains !> @details Initialises everything needed to run the io_demo miniapp + !> @param[in,out] modeldb The structure that holds model state !> @param[in] mesh Representation of the mesh the code will run on !> @param[in,out] chi The co-ordinate field !> @param[in,out] panel_id 2d field giving the id for cubed sphere panels - !> @param[in,out] modeldb The structure that holds model state - subroutine init_io_demo( mesh, chi, panel_id, modeldb) + subroutine init_io_demo(modeldb, mesh, chi, panel_id) implicit none - type(mesh_type), intent(in), pointer :: mesh + type(modeldb_type), intent(inout) :: modeldb + type(mesh_type), intent(in), pointer :: mesh ! Coordinate field - type(field_type), intent(inout) :: chi(:) - type(field_type), intent(inout) :: panel_id - type(modeldb_type), intent(inout) :: modeldb + type(field_type), intent(inout) :: chi(:) + type(field_type), intent(inout) :: panel_id + class(abstract_value_type), pointer :: abstract_value type(random_number_generator_type), pointer :: rng type(field_type) :: diffusion_field @@ -59,8 +57,20 @@ subroutine init_io_demo( mesh, chi, panel_id, modeldb) real(kind=r_def), parameter :: min_val = 280.0_r_def real(kind=r_def), parameter :: max_val = 330.0_r_def + type(function_space_type), pointer :: fs + + integer(i_def) :: order_h, order_v + logical(l_def) :: write_diag + logical(l_def) :: use_xios_io + call log_event( 'io_demo: Initialising miniapp ...', LOG_LEVEL_TRACE ) + order_h = modeldb%config%finite_element%element_order_h() + order_v = modeldb%config%finite_element%element_order_v() + + write_diag = modeldb%config%io%write_diag() + use_xios_io = modeldb%config%io%use_xios_io() + ! seed the random number generator call modeldb%values%get_value("rng", abstract_value) select type(abstract_value) @@ -76,10 +86,8 @@ subroutine init_io_demo( mesh, chi, panel_id, modeldb) ! Create prognostic fields ! Creates a field in the Wtheta function space - call diffusion_field%initialise( vector_space = & - function_space_collection%get_fs(mesh, element_order_h, & - element_order_v, Wtheta), & - name="diffusion_field") + fs => function_space_collection%get_fs(mesh, order_h, order_v, Wtheta) + call diffusion_field%initialise(fs, name="diffusion_field") ! Set up field with an IO behaviour (XIOS only at present) if (write_diag .and. use_xios_io) then @@ -98,7 +106,7 @@ subroutine init_io_demo( mesh, chi, panel_id, modeldb) ! Create io_demo runtime constants. This creates various things ! needed by the fem algorithms such as mass matrix operators, mass ! matrix diagonal fields and the geopotential field - call create_io_demo_constants(mesh, chi, panel_id) + call create_io_demo_constants(modeldb, mesh, chi, panel_id) call log_event( 'io_demo: Miniapp initialised', LOG_LEVEL_TRACE ) diff --git a/applications/io_demo/source/driver/io_demo_driver_mod.f90 b/applications/io_demo/source/driver/io_demo_driver_mod.f90 index 6d8733d99..6daefdec6 100644 --- a/applications/io_demo/source/driver/io_demo_driver_mod.f90 +++ b/applications/io_demo/source/driver/io_demo_driver_mod.f90 @@ -36,10 +36,8 @@ module io_demo_driver_mod use model_clock_mod, only : model_clock_type use multifile_field_setup_mod, only : create_multifile_io_fields use multifile_io_mod, only : init_multifile_io, step_multifile_io - use namelist_mod, only : namelist_type - - use io_demo_alg_mod, only : io_demo_alg + use io_demo_alg_mod, only : io_demo_alg use sci_field_minmax_alg_mod, only : log_field_minmax !------------------------------------ @@ -47,14 +45,13 @@ module io_demo_driver_mod !------------------------------------ use base_mesh_config_mod, only: GEOMETRY_SPHERICAL, & GEOMETRY_PLANAR - use io_config_mod, only: write_diag implicit none private - type(inventory_by_mesh_type) :: chi_inventory - type(inventory_by_mesh_type) :: panel_id_inventory + type(inventory_by_mesh_type) :: chi_inventory + type(inventory_by_mesh_type) :: panel_id_inventory public initialise, step, finalise @@ -63,17 +60,17 @@ module io_demo_driver_mod !> Sets up required state in preparation for run. !> @param [in] program_name An identifier given to the model being run !> @param [in,out] modeldb The structure that holds model state - subroutine initialise( program_name, modeldb) + subroutine initialise(program_name, modeldb) implicit none - character(*), intent(in) :: program_name - type(modeldb_type), intent(inout) :: modeldb + character(*), intent(in) :: program_name + type(modeldb_type), intent(inout) :: modeldb ! Coordinate field - type(field_type), pointer :: chi(:) => null() - type(field_type), pointer :: panel_id => null() - type(mesh_type), pointer :: mesh => null() + type(field_type), pointer :: chi(:) + type(field_type), pointer :: panel_id + type(mesh_type), pointer :: mesh character(str_def), allocatable :: base_mesh_names(:) character(str_def), allocatable :: twod_names(:) @@ -81,14 +78,9 @@ subroutine initialise( program_name, modeldb) class(extrusion_type), allocatable :: extrusion type(uniform_extrusion_type), allocatable :: extrusion_2d - type(namelist_type), pointer :: base_mesh_nml => null() - type(namelist_type), pointer :: planet_nml => null() - type(namelist_type), pointer :: extrusion_nml => null() - type(namelist_type), pointer :: io_nml => null() - character(str_def) :: prime_mesh_name - integer(i_def) :: stencil_depth + integer(i_def) :: stencil_depth(1) integer(i_def) :: geometry integer(i_def) :: method integer(i_def) :: number_of_layers @@ -101,26 +93,20 @@ subroutine initialise( program_name, modeldb) integer(i_def), parameter :: one_layer = 1_i_def integer(i_def) :: i + nullify(chi) + nullify(panel_id) + nullify(mesh) + !======================================================================= ! Extract configuration variables !======================================================================= - base_mesh_nml => modeldb%configuration%get_namelist('base_mesh') - planet_nml => modeldb%configuration%get_namelist('planet') - extrusion_nml => modeldb%configuration%get_namelist('extrusion') - io_nml => modeldb%configuration%get_namelist('io') - - call base_mesh_nml%get_value( 'prime_mesh_name', prime_mesh_name ) - call base_mesh_nml%get_value( 'geometry', geometry ) - call extrusion_nml%get_value( 'method', method ) - call extrusion_nml%get_value( 'domain_height', domain_height ) - call extrusion_nml%get_value( 'number_of_layers', number_of_layers ) - call planet_nml%get_value( 'scaled_radius', scaled_radius ) - call io_nml%get_value( 'multifile_io', multifile_io) - - base_mesh_nml => null() - planet_nml => null() - extrusion_nml => null() - io_nml => null() + prime_mesh_name = modeldb%config%base_mesh%prime_mesh_name() + geometry = modeldb%config%base_mesh%geometry() + method = modeldb%config%extrusion%method() + domain_height = modeldb%config%extrusion%domain_height() + number_of_layers = modeldb%config%extrusion%number_of_layers() + scaled_radius = modeldb%config%planet%scaled_radius() + multifile_io = modeldb%config%io%multifile_io() !======================================================================= ! Mesh @@ -191,7 +177,7 @@ subroutine initialise( program_name, modeldb) !======================================================================= ! Setup multifile reading !======================================================================= - if(multifile_io) then + if (multifile_io) then call create_multifile_io_fields(modeldb) call init_multifile_io(modeldb) end if @@ -210,7 +196,7 @@ subroutine initialise( program_name, modeldb) mesh => mesh_collection%get_mesh(prime_mesh_name) call chi_inventory%get_field_array(mesh, chi) call panel_id_inventory%get_field(mesh, panel_id) - call init_io_demo( mesh, chi, panel_id, modeldb ) + call init_io_demo(modeldb, mesh, chi, panel_id) nullify(mesh, chi, panel_id) deallocate(base_mesh_names) @@ -227,16 +213,19 @@ subroutine step( program_name, modeldb ) character(*), intent(in) :: program_name type(modeldb_type), intent(inout) :: modeldb + type( field_collection_type ), pointer :: depository type( field_collection_type ), pointer :: multifile_col type( field_type ), pointer :: diffusion_field type( field_type ), pointer :: multifile_field - type(namelist_type), pointer :: io_nml => null() + logical :: multifile_io + logical :: write_diag + + multifile_io = modeldb%config%io%multifile_io() + write_diag = modeldb%config%io%write_diag() - io_nml => modeldb%configuration%get_namelist('io') - call io_nml%get_value( 'multifile_io', multifile_io) - if( multifile_io ) then + if (multifile_io) then call step_multifile_io(modeldb, chi_inventory, panel_id_inventory) multifile_col => modeldb%fields%get_field_collection("multifile_io_fields") call multifile_col%get_field("multifile_field", multifile_field) @@ -248,7 +237,7 @@ subroutine step( program_name, modeldb ) ! Call an algorithm call log_event(program_name//": Calculating diffusion", LOG_LEVEL_INFO) - call io_demo_alg(diffusion_field) + call io_demo_alg(modeldb, diffusion_field) if (write_diag) then ! Write out output file @@ -268,23 +257,23 @@ subroutine finalise( program_name, modeldb ) character(*), intent(in) :: program_name type(modeldb_type), intent(inout) :: modeldb + type( field_collection_type ), pointer :: depository type( field_type ), pointer :: diffusion_field type( field_collection_type ), pointer :: multifile_col type( field_type ), pointer :: multifile_field - type(namelist_type), pointer :: io_nml logical :: multifile_io + + multifile_io = modeldb%config%io%multifile_io() + !------------------------------------------------------------------------- ! Checksum output !------------------------------------------------------------------------- depository => modeldb%fields%get_field_collection("depository") call depository%get_field("diffusion_field", diffusion_field) - io_nml => modeldb%configuration%get_namelist('io') - call io_nml%get_value( 'multifile_io', multifile_io) - - if( multifile_io ) then + if (multifile_io) then multifile_col => modeldb%fields%get_field_collection("multifile_io_fields") call multifile_col%get_field("multifile_field", multifile_field) call checksum_alg(program_name, & diff --git a/applications/io_demo/source/driver/multifile_io/multifile_field_setup_mod.f90 b/applications/io_demo/source/driver/multifile_io/multifile_field_setup_mod.f90 index a4c2e7352..9d73c3f22 100644 --- a/applications/io_demo/source/driver/multifile_io/multifile_field_setup_mod.f90 +++ b/applications/io_demo/source/driver/multifile_io/multifile_field_setup_mod.f90 @@ -16,10 +16,10 @@ module multifile_field_setup_mod use field_parent_mod, only: read_interface use fs_continuity_mod, only: Wtheta use function_space_collection_mod, only: function_space_collection + use function_space_mod, only: function_space_type use lfric_xios_read_mod, only: read_field_generic use mesh_mod, only: mesh_type use mesh_collection_mod, only: mesh_collection - use namelist_mod, only: namelist_type implicit none @@ -30,41 +30,40 @@ module multifile_field_setup_mod !> @details Creates the fields needed for the multifile IO !> @param[in,out] modeldb The model database in which to store model data. subroutine create_multifile_io_fields(modeldb) + implicit none type(modeldb_type), intent(inout) :: modeldb - type(mesh_type), pointer :: mesh type(field_collection_type), pointer :: multifile_io_fields - type( field_type ) :: multifile_io_field - procedure(read_interface), pointer :: tmp_ptr + type(field_type) :: multifile_io_field + procedure(read_interface), pointer :: tmp_ptr + + type(function_space_type), pointer :: fs + type(mesh_type), pointer :: mesh - type(namelist_type), pointer :: base_mesh_nml - type(namelist_type), pointer :: finite_element_nml character(str_def) :: prime_mesh_name - integer(i_def) :: element_order_h - integer(i_def) :: element_order_v + integer(i_def) :: order_h + integer(i_def) :: order_v + + prime_mesh_name = modeldb%config%base_mesh%prime_mesh_name() - base_mesh_nml => modeldb%configuration%get_namelist('base_mesh') - finite_element_nml => modeldb%configuration%get_namelist('finite_element') - call base_mesh_nml%get_value( 'prime_mesh_name', prime_mesh_name ) - call finite_element_nml%get_value('element_order_h', element_order_h) - call finite_element_nml%get_value('element_order_v', element_order_v) + order_h = modeldb%config%finite_element%element_order_h() + order_v = modeldb%config%finite_element%element_order_v() mesh => mesh_collection%get_mesh(prime_mesh_name) + fs => function_space_collection%get_fs(mesh, order_h, order_v, Wtheta) call modeldb%fields%add_empty_field_collection("multifile_io_fields") multifile_io_fields => modeldb%fields%get_field_collection("multifile_io_fields") - call multifile_io_field%initialise( vector_space = & - function_space_collection%get_fs(mesh, element_order_h, & - element_order_v, Wtheta), & - name="multifile_field") + + call multifile_io_field%initialise(fs, name="multifile_field") + tmp_ptr => read_field_generic call multifile_io_field%set_read_behaviour(tmp_ptr) call multifile_io_fields%add_field(multifile_io_field) end subroutine create_multifile_io_fields - -end module multifile_field_setup_mod \ No newline at end of file +end module multifile_field_setup_mod diff --git a/applications/io_demo/source/driver/multifile_io/multifile_file_setup_mod.f90 b/applications/io_demo/source/driver/multifile_io/multifile_file_setup_mod.f90 index ac1ea68a2..6fb812c77 100644 --- a/applications/io_demo/source/driver/multifile_io/multifile_file_setup_mod.f90 +++ b/applications/io_demo/source/driver/multifile_io/multifile_file_setup_mod.f90 @@ -9,21 +9,13 @@ !> from them. module multifile_file_setup_mod - use constants_mod, only: i_def, & - str_def, str_max_filename + use constants_mod, only: i_def, str_def, l_def + use driver_modeldb_mod, only: modeldb_type use field_collection_mod, only: field_collection_type use file_mod, only: file_type, FILE_MODE_READ use lfric_xios_file_mod, only: lfric_xios_file_type, OPERATION_ONCE, & OPERATION_TIMESERIES use linked_list_mod, only: linked_list_type - use log_mod, only: log_event, log_level_error - use driver_modeldb_mod, only: modeldb_type - - ! Configuration modules - use io_config_mod, only: use_xios_io, & - diagnostic_frequency - use time_config_mod, only: timestep_start, & - timestep_end implicit none @@ -38,21 +30,29 @@ subroutine init_multifile_files(files_list, modeldb, filename) implicit none - type(linked_list_type), intent(out) :: files_list - type(modeldb_type), intent(inout) :: modeldb - character(str_def), intent(in) :: filename + type(linked_list_type), intent(out) :: files_list + type(modeldb_type), intent(inout) :: modeldb + character(str_def), intent(in) :: filename - integer(i_def) :: ts_start, ts_end - integer(i_def) :: rc + character(str_def) :: timestep_start, timestep_end + + integer(i_def) :: ts_start, ts_end + integer(i_def) :: rc + logical(l_def) :: use_xios_io type(field_collection_type), pointer :: multifile_fields - multifile_fields => modeldb%fields%get_field_collection("multifile_io_fields") + + use_xios_io = modeldb%config%io%use_xios_io() + timestep_start = modeldb%config%time%timestep_start() + timestep_end = modeldb%config%time%timestep_end() + + multifile_fields => modeldb%fields%get_field_collection("multifile_io_fields") ! Get time configuration in integer form - read(timestep_start,*,iostat=rc) ts_start - read(timestep_end,*,iostat=rc) ts_end + read(timestep_start,*,iostat=rc) ts_start + read(timestep_end, *,iostat=rc) ts_end - if ( use_xios_io) then + if (use_xios_io) then call files_list%insert_item( & lfric_xios_file_type( filename, & @@ -66,4 +66,4 @@ subroutine init_multifile_files(files_list, modeldb, filename) end subroutine init_multifile_files -end module multifile_file_setup_mod \ No newline at end of file +end module multifile_file_setup_mod diff --git a/applications/io_demo/source/driver/multifile_io/multifile_io_mod.F90 b/applications/io_demo/source/driver/multifile_io/multifile_io_mod.F90 index 85be25ac0..f15a5e764 100644 --- a/applications/io_demo/source/driver/multifile_io/multifile_io_mod.F90 +++ b/applications/io_demo/source/driver/multifile_io/multifile_io_mod.F90 @@ -8,11 +8,10 @@ !> the multifile IO. module multifile_io_mod - use base_mesh_config_mod, only: prime_mesh_name use calendar_mod, only: calendar_type use constants_mod, only: str_def, i_def - use driver_modeldb_mod, only: modeldb_type use driver_model_data_mod, only: model_data_type + use driver_modeldb_mod, only: modeldb_type use empty_io_context_mod, only: empty_io_context_type use event_mod, only: event_action use event_actor_mod, only: event_actor_type @@ -22,7 +21,6 @@ module multifile_io_mod use inventory_by_mesh_mod, only: inventory_by_mesh_type use io_context_collection_mod, only: io_context_collection_type use io_context_mod, only: io_context_type, callback_clock_arg - use io_config_mod, only: use_xios_io, subroutine_timers use log_mod, only: log_event, log_level_error, & log_level_trace, log_level_info, & log_scratch_space @@ -32,9 +30,11 @@ module multifile_io_mod use mesh_mod, only: mesh_type use mesh_collection_mod, only: mesh_collection use model_clock_mod, only: model_clock_type - use namelist_mod, only: namelist_type use step_calendar_mod, only: step_calendar_type + use multifile_io_nml_iterator_mod, only: multifile_io_nml_iterator_type + use multifile_io_nml_mod, only: multifile_io_nml_type + implicit none private @@ -48,35 +48,35 @@ module multifile_io_mod !> @brief Initialise the multifile IO !> @param[inout] modeldb Modeldb object subroutine init_multifile_io(modeldb) + implicit none type(modeldb_type), intent(inout) :: modeldb - type(lfric_xios_context_type), pointer :: io_context - type(namelist_type), pointer :: multifile_nml + type(lfric_xios_context_type), pointer :: io_context character(str_def) :: context_name - integer(i_def) :: multifile_start_timestep - integer(i_def) :: multifile_stop_timestep + integer(i_def) :: start_timestep + integer(i_def) :: stop_timestep character(str_def) :: filename - character(str_def), allocatable :: multifile_io_profiles(:) - integer(i_def) :: i type(linked_list_type), pointer :: file_list - allocate(multifile_io_profiles, source=modeldb%configuration%get_namelist_profiles("multifile_io")) + type(multifile_io_nml_iterator_type) :: iter + type(multifile_io_nml_type), pointer :: multifile_nml - do i=1, size(multifile_io_profiles) + call iter%initialise(modeldb%config%multifile_io) + do while (iter%has_next()) + + multifile_nml => iter%next() + + filename = multifile_nml%filename() + start_timestep = multifile_nml%start_timestep() + stop_timestep = multifile_nml%stop_timestep() - multifile_nml => modeldb%configuration%get_namelist('multifile_io', & - profile_name=trim(multifile_io_profiles(i))) - call multifile_nml%get_value('filename', filename) - call multifile_nml%get_value('start_timestep', multifile_start_timestep) - call multifile_nml%get_value('stop_timestep', multifile_stop_timestep) context_name = "multifile_context_" // trim(filename) - call context_init(modeldb, context_name, multifile_start_timestep, & - multifile_stop_timestep) + call context_init(modeldb, context_name, start_timestep, stop_timestep) call modeldb%io_contexts%get_io_context(context_name, io_context) @@ -85,8 +85,6 @@ subroutine init_multifile_io(modeldb) end do - deallocate(multifile_io_profiles) - end subroutine init_multifile_io !> @brief Step the multifile IO @@ -96,71 +94,76 @@ end subroutine init_multifile_io !> @param[in] panel_id_inventory Inventory object, containing all of !! the fields with the ID of mesh panels subroutine step_multifile_io(modeldb, chi_inventory, panel_id_inventory) + implicit none - type(modeldb_type), intent(inout) :: modeldb - type(inventory_by_mesh_type), intent(in) :: chi_inventory - type(inventory_by_mesh_type), intent(in) :: panel_id_inventory - type(lfric_xios_context_type), pointer :: io_context + type(modeldb_type), intent(inout) :: modeldb + type(inventory_by_mesh_type), intent(in) :: chi_inventory + type(inventory_by_mesh_type), intent(in) :: panel_id_inventory + + type(lfric_xios_context_type), pointer :: io_context + class(event_actor_type), pointer :: event_actor_ptr - type(mesh_type), pointer :: mesh => null() - type(field_type), pointer :: chi(:) => null() - type(field_type), pointer :: panel_id => null() + + type(mesh_type), pointer :: mesh + type(field_type), pointer :: chi(:) + type(field_type), pointer :: panel_id class(calendar_type), allocatable :: tmp_calendar - type(namelist_type), pointer :: multifile_nml - type(namelist_type), pointer :: time_nml + type(multifile_io_nml_iterator_type) :: iter + type(multifile_io_nml_type), pointer :: multifile_nml + character(str_def) :: context_name + character(str_def) :: prime_mesh_name character(str_def) :: filename - character(str_def) :: time_origin character(str_def) :: time_start - character(str_def), allocatable :: multifile_io_profiles(:) - integer(i_def) :: i - procedure(event_action), pointer :: context_advance procedure(callback_clock_arg), pointer :: before_close - + nullify(mesh) + nullify(chi) + nullify(panel_id) nullify(before_close) - allocate(multifile_io_profiles, source=modeldb%configuration%get_namelist_profiles("multifile_io")) - - do i=1, size(multifile_io_profiles) + call iter%initialise(modeldb%config%multifile_io) + do while (iter%has_next()) - multifile_nml => modeldb%configuration%get_namelist('multifile_io', & - profile_name=trim(multifile_io_profiles(i))) - call multifile_nml%get_value('filename', filename) + multifile_nml => iter%next() + filename = multifile_nml%filename() context_name = "multifile_context_" // trim(filename) + call modeldb%io_contexts%get_io_context(context_name, io_context) if (modeldb%clock%get_step() == io_context%get_stop_time()) then + ! Finalise XIOS context call io_context%set_current() call io_context%set_active(.false.) call modeldb%clock%remove_event(context_name) call io_context%finalise_xios_context() - elseif (modeldb%clock%get_step() == io_context%get_start_time()) then + else if (modeldb%clock%get_step() == io_context%get_start_time()) then + + prime_mesh_name = modeldb%config%base_mesh%prime_mesh_name() + time_origin = modeldb%config%time%calendar_origin() + time_start = modeldb%config%time%calendar_start() + ! Initialise XIOS context mesh => mesh_collection%get_mesh(prime_mesh_name) call chi_inventory%get_field_array(mesh, chi) call panel_id_inventory%get_field(mesh, panel_id) - time_nml => modeldb%configuration%get_namelist('time') - - call time_nml%get_value('calendar_origin', time_origin) - call time_nml%get_value('calendar_start', time_start) - allocate(tmp_calendar, source=step_calendar_type(time_origin, time_start)) call io_context%initialise_xios_context( modeldb%mpi%get_comm(), & chi, panel_id, & modeldb%clock, tmp_calendar, & - before_close, start_at_zero=.true. ) + before_close, & + start_at_zero=.true. ) ! Attach context advancement to the model's clock context_advance => advance_read_only @@ -173,8 +176,6 @@ subroutine step_multifile_io(modeldb, chi_inventory, panel_id_inventory) call modeldb%io_contexts%get_io_context("io_demo", io_context) call io_context%set_current() - deallocate(multifile_io_profiles) - end subroutine step_multifile_io !> @brief Helper function for initialising the lfric IO context and adding it @@ -188,8 +189,10 @@ subroutine context_init(modeldb, & multifile_start_timestep, & multifile_stop_timestep) implicit none + type(modeldb_type), intent(inout) :: modeldb - character(*), intent(in) :: context_name + + character(*), intent(in) :: context_name integer(i_def), intent(in) :: multifile_start_timestep integer(i_def), intent(in) :: multifile_stop_timestep diff --git a/applications/io_demo/source/io_demo.f90 b/applications/io_demo/source/io_demo.f90 index b83c5f3e8..7f5d7d5db 100644 --- a/applications/io_demo/source/io_demo.f90 +++ b/applications/io_demo/source/io_demo.f90 @@ -8,7 +8,7 @@ !> @details Calls init, run and finalise routines from io_demo driver module program io_demo - use cli_mod, only : get_initial_filename + use cli_mod, only : parse_command_line use driver_collections_mod, only : init_collections, final_collections use constants_mod, only : precision_real use driver_comm_mod, only : init_comm, final_comm @@ -21,20 +21,28 @@ program io_demo log_level_trace, & log_scratch_space use random_number_generator_mod, only : random_number_generator_type - use io_demo_mod, only : io_demo_required_namelists - use io_demo_driver_mod, only : initialise, step, finalise + + use io_demo_mod, only: io_demo_required_namelists + use io_demo_driver_mod, only: initialise, step, finalise + use timing_mod, only: init_timing, final_timing + use io_config_mod, only: timer_output_path + use namelist_mod, only: namelist_type implicit none ! The technical and scientific state - type(modeldb_type) :: modeldb - character(*), parameter :: program_name = "io_demo" - character(:), allocatable :: filename - integer, parameter :: default_seed = 123456789 + type(modeldb_type) :: modeldb + character(*), parameter :: program_name = "io_demo" + character(:), allocatable :: filename + type(namelist_type), pointer :: io_nml + logical :: lsubroutine_timers + integer, parameter :: default_seed = 123456789 type(random_number_generator_type), pointer :: rng + call parse_command_line( filename ) call modeldb%values%initialise() call modeldb%configuration%initialise( program_name, table_len=10 ) + call modeldb%config%initialise(program_name) write(log_scratch_space,& '("Application built with ", A, "-bit real numbers")') & @@ -42,13 +50,19 @@ program io_demo call log_event( log_scratch_space, log_level_trace ) modeldb%mpi => global_mpi call init_comm(program_name, modeldb) - call get_initial_filename( filename ) - call init_config( filename, & - io_demo_required_namelists, & - modeldb%configuration ) + + call init_config(filename, & + io_demo_required_namelists, & + configuration=modeldb%configuration, & + config=modeldb%config) + deallocate( filename ) call init_logger( modeldb%mpi%get_comm(), program_name ) + io_nml => modeldb%configuration%get_namelist('io') + call io_nml%get_value('subroutine_timers', lsubroutine_timers) + call init_timing( modeldb%mpi%get_comm(), lsubroutine_timers, program_name, timer_output_path ) + nullify( io_nml ) call init_collections() call init_time(modeldb) @@ -70,6 +84,7 @@ program io_demo call finalise( program_name, modeldb ) call final_time(modeldb) call final_collections() + call final_timing( program_name ) call final_logger( program_name ) call final_config() call final_comm( modeldb ) diff --git a/applications/lbc_demo/rose-meta/lfric-lbc_demo/version30_31.py b/applications/lbc_demo/rose-meta/lfric-lbc_demo/version30_31.py new file mode 100644 index 000000000..60f9da8c2 --- /dev/null +++ b/applications/lbc_demo/rose-meta/lfric-lbc_demo/version30_31.py @@ -0,0 +1,43 @@ +import sys + +from metomi.rose.upgrade import MacroUpgrade + +from .version22_30 import * + + +class UpgradeError(Exception): + """Exception created when an upgrade fails.""" + + def __init__(self, msg): + self.msg = msg + + def __repr__(self): + sys.tracebacklimit = 0 + return self.msg + + __str__ = __repr__ + + +""" +Copy this template and complete to add your macro + +class vnXX_txxx(MacroUpgrade): + # Upgrade macro for by + + BEFORE_TAG = "vnX.X" + AFTER_TAG = "vnX.X_txxx" + + def upgrade(self, config, meta_config=None): + # Add settings + return config, self.reports +""" + + +class vn30_t306(MacroUpgrade): + # Upgrade macro for 306 by erica neininger + + BEFORE_TAG = "vn3.0" + AFTER_TAG = "vn3.1" + + def upgrade(self, config, meta_config=None): + return config, self.reports diff --git a/applications/lbc_demo/rose-meta/lfric-lbc_demo/versions.py b/applications/lbc_demo/rose-meta/lfric-lbc_demo/versions.py index 152c043d0..01798ad2b 100644 --- a/applications/lbc_demo/rose-meta/lfric-lbc_demo/versions.py +++ b/applications/lbc_demo/rose-meta/lfric-lbc_demo/versions.py @@ -1,8 +1,8 @@ import sys -from metomi.rose.upgrade import MacroUpgrade +from metomi.rose.upgrade import MacroUpgrade # noqa: F401 -from .version22_30 import * +from .version30_31 import * class UpgradeError(Exception): diff --git a/applications/lbc_demo/rose-meta/lfric-lbc_demo/vn3.1/rose-meta.conf b/applications/lbc_demo/rose-meta/lfric-lbc_demo/vn3.1/rose-meta.conf new file mode 100644 index 000000000..0eade4a73 --- /dev/null +++ b/applications/lbc_demo/rose-meta/lfric-lbc_demo/vn3.1/rose-meta.conf @@ -0,0 +1,42 @@ +import=lfric-driver/vn3.1 + +[namelist:lbc_demo] +compulsory=true + +[namelist:lbc_demo=apply_lbc] +compulsory=true +!kind=default +type=logical + +[namelist:lbc_demo=enable_lbc] +compulsory=true +!kind=default +type=logical + +[namelist:lbc_demo=field_type] +compulsory=true +!enumeration=true +value-titles='Real','Integer' +values='real','integer' + +[namelist:lbc_demo=lbc_source] +compulsory=true +!enumeration=true +value-titles='File','Analytic' +values='file','analytic' + +[namelist:lbc_demo=read_lbc] +compulsory=true +!kind=default +type=logical + +[namelist:lbc_demo=set_lbc] +compulsory=true +!enumeration=true +value-titles='Constant','Quadrant' +values='constant','quadrant' + +[namelist:lbc_demo=write_lbc] +compulsory=true +!kind=default +type=logical diff --git a/applications/lbc_demo/source/algorithm/init_lam_fields_alg_mod.x90 b/applications/lbc_demo/source/algorithm/init_lam_fields_alg_mod.x90 index 4a0aebc6c..63dcab0a1 100644 --- a/applications/lbc_demo/source/algorithm/init_lam_fields_alg_mod.x90 +++ b/applications/lbc_demo/source/algorithm/init_lam_fields_alg_mod.x90 @@ -20,7 +20,6 @@ module init_lam_fields_alg_mod use field_parent_mod, only: field_parent_type use integer_field_mod, only: integer_field_type use mesh_mod, only: mesh_type - use namelist_mod, only: namelist_type ! Procedures use create_field_set_mod, only: create_field_set @@ -46,7 +45,6 @@ subroutine init_lam_fields( mesh, modeldb ) class(field_parent_type), pointer :: field type(field_type), pointer :: tmp_real_field type(integer_field_type), pointer :: tmp_int_field - type(namelist_type), pointer :: io_nml logical :: use_xios_io logical :: write_diag @@ -58,17 +56,15 @@ subroutine init_lam_fields( mesh, modeldb ) real(r_def), parameter :: lam_real_value = 9.0_r_def integer(i_def), parameter :: lam_int_value = 9_i_def - io_nml => modeldb%configuration%get_namelist('io') - - call io_nml%get_value('write_diag', write_diag) - call io_nml%get_value('use_xios_io', use_xios_io) + write_diag = modeldb%config%io%write_diag() + use_xios_io = modeldb%config%io%use_xios_io() fld_collection => modeldb%fields%get_field_collection( field_collection_name ) !===================================== ! Create LAM fields !===================================== - call create_field_set( fld_collection, mesh, modeldb%configuration ) + call create_field_set(modeldb, fld_collection, mesh) !===================================== ! Set up field with an IO behaviour diff --git a/applications/lbc_demo/source/algorithm/init_lbc_fields_alg_mod.x90 b/applications/lbc_demo/source/algorithm/init_lbc_fields_alg_mod.x90 index c536a35b4..7c43f89fa 100644 --- a/applications/lbc_demo/source/algorithm/init_lbc_fields_alg_mod.x90 +++ b/applications/lbc_demo/source/algorithm/init_lbc_fields_alg_mod.x90 @@ -25,7 +25,6 @@ module init_lbc_fields_alg_mod use integer_field_mod, only: integer_field_type use inventory_by_mesh_mod, only: inventory_by_mesh_type use mesh_mod, only: mesh_type - use namelist_mod, only: namelist_type ! Kernels use set_lbc_int_kernel_mod, only: set_lbc_int_kernel_type @@ -95,25 +94,14 @@ module init_lbc_fields_alg_mod type(function_space_type), pointer :: fs - type(namelist_type), pointer :: base_mesh_nml - type(namelist_type), pointer :: finite_element_nml - type(namelist_type), pointer :: lbc_demo_nml - type(namelist_type), pointer :: io_nml - - base_mesh_nml => modeldb%configuration%get_namelist('base_mesh') - finite_element_nml => modeldb%configuration%get_namelist('finite_element') - io_nml => modeldb%configuration%get_namelist('io') - lbc_demo_nml => modeldb%configuration%get_namelist('lbc_demo') - - call base_mesh_nml%get_value( 'geometry', geometry) - call io_nml%get_value( 'use_xios_io', use_xios_io) - call io_nml%get_value( 'write_diag', write_diag) - - call lbc_demo_nml%get_value( 'enable_lbc', enable_lbc ) - call lbc_demo_nml%get_value( 'lbc_source', lbc_source ) - call lbc_demo_nml%get_value( 'set_lbc', set_lbc ) - call lbc_demo_nml%get_value( 'write_lbc', write_lbc ) - call lbc_demo_nml%get_value( 'read_lbc', read_lbc ) + geometry = modeldb%config%base_mesh%geometry() + use_xios_io = modeldb%config%io%use_xios_io() + write_diag = modeldb%config%io%write_diag() + enable_lbc = modeldb%config%lbc_demo%enable_lbc() + lbc_source = modeldb%config%lbc_demo%lbc_source() + set_lbc = modeldb%config%lbc_demo%set_lbc() + write_lbc = modeldb%config%lbc_demo%write_lbc() + read_lbc = modeldb%config%lbc_demo%read_lbc() lbc_mesh_name = trim(mesh%get_mesh_name())//'-lbc' @@ -132,7 +120,7 @@ module init_lbc_fields_alg_mod !===================================== ! Create an LBC field !===================================== - call create_field_set( fld_collection, lbc_mesh, modeldb%configuration ) + call create_field_set(modeldb, fld_collection, lbc_mesh) !===================================== ! Set up field with an IO behaviour diff --git a/applications/lbc_demo/source/driver/create_field_set_mod.F90 b/applications/lbc_demo/source/driver/create_field_set_mod.F90 index 8ffc409e9..9fc99328a 100644 --- a/applications/lbc_demo/source/driver/create_field_set_mod.F90 +++ b/applications/lbc_demo/source/driver/create_field_set_mod.F90 @@ -6,11 +6,10 @@ module create_field_set_mod use constants_mod, only: i_def + use driver_modeldb_mod, only: modeldb_type use field_collection_mod, only: field_collection_type use field_mod, only: field_type use integer_field_mod, only: integer_field_type - use namelist_collection_mod, only: namelist_collection_type - use namelist_mod, only: namelist_type use mesh_collection_mod, only: mesh_collection use mesh_mod, only: mesh_type use fs_continuity_mod, only: W0, W2H, W2V, W3, Wtheta @@ -29,20 +28,18 @@ module create_field_set_mod contains !> @brief Instantiates field set for lbc_demo application +!! @param[in, out] modeldb Application state object !! @param[in, out] fld_collection Field collection to add field set !! @param[in] mesh Mesh to use for field set -!! @param[in] configuration Configuration namelist -subroutine create_field_set( fld_collection, mesh, configuration ) +subroutine create_field_set(modeldb, fld_collection, mesh) implicit none + type(modeldb_type), intent(in) :: modeldb - type(field_collection_type), pointer, intent(inout) :: fld_collection - type(mesh_type), pointer, intent(in) :: mesh - type(namelist_collection_type), intent(in) :: configuration + type(field_collection_type), pointer, intent(inout) :: fld_collection + type(mesh_type), pointer, intent(in) :: mesh - type(namelist_type), pointer :: finite_element_nml - type(namelist_type), pointer :: lbc_demo_nml type(field_type) :: fld type(integer_field_type) :: int_fld @@ -57,12 +54,9 @@ subroutine create_field_set( fld_collection, mesh, configuration ) ! Enumerations integer :: test_field_type - lbc_demo_nml => configuration%get_namelist('lbc_demo') - finite_element_nml => configuration%get_namelist('finite_element') - - call lbc_demo_nml%get_value( 'field_type', test_field_type ) - call finite_element_nml%get_value( 'element_order_h', order_h ) - call finite_element_nml%get_value( 'element_order_v', order_v ) + test_field_type = modeldb%config%lbc_demo%field_type() + order_h = modeldb%config%finite_element%element_order_h() + order_v = modeldb%config%finite_element%element_order_v() mesh_2d => mesh_collection%get_mesh(mesh, twod) diff --git a/applications/lbc_demo/source/driver/lbc_demo_driver_mod.f90 b/applications/lbc_demo/source/driver/lbc_demo_driver_mod.f90 index 02b814d53..7e626f0b4 100644 --- a/applications/lbc_demo/source/driver/lbc_demo_driver_mod.f90 +++ b/applications/lbc_demo/source/driver/lbc_demo_driver_mod.f90 @@ -32,7 +32,6 @@ module lbc_demo_driver_mod log_level_trace use mesh_mod, only: mesh_type use mesh_collection_mod, only: mesh_collection - use namelist_mod, only: namelist_type !------------------------------------ ! Configuration modules @@ -40,8 +39,8 @@ module lbc_demo_driver_mod use base_mesh_config_mod, only: geometry_spherical, & geometry_planar, & topology_non_periodic - use lbc_demo_config_mod, only: lbc_source_file, & - field_type_real + use lbc_demo_config_mod, only: field_type_real + implicit none private @@ -78,18 +77,12 @@ subroutine initialise( program_name, modeldb) class(extrusion_type), allocatable :: extrusion type(uniform_extrusion_type), allocatable :: extrusion_2d - type(namelist_type), pointer :: base_mesh_nml - type(namelist_type), pointer :: planet_nml - type(namelist_type), pointer :: extrusion_nml - type(namelist_type), pointer :: io_nml - type(namelist_type), pointer :: lbc_demo_nml - character(str_def) :: prime_mesh_name character(str_def) :: lbc_mesh_name character(str_def) :: output_mesh_name character(str_def) :: context_name - integer(i_def) :: stencil_depth + integer(i_def) :: stencil_depth(1) integer(i_def) :: geometry integer(i_def) :: method integer(i_def) :: number_of_layers @@ -103,7 +96,6 @@ subroutine initialise( program_name, modeldb) logical :: enable_lbc logical :: apply_lbc logical :: write_lbc - integer :: lbc_source integer :: topology integer :: i @@ -113,26 +105,20 @@ subroutine initialise( program_name, modeldb) !======================================================================= ! Extract configuration variables !======================================================================= - base_mesh_nml => modeldb%configuration%get_namelist('base_mesh') - planet_nml => modeldb%configuration%get_namelist('planet') - extrusion_nml => modeldb%configuration%get_namelist('extrusion') - io_nml => modeldb%configuration%get_namelist('io') - lbc_demo_nml => modeldb%configuration%get_namelist('lbc_demo') - - call base_mesh_nml%get_value( 'prime_mesh_name', prime_mesh_name ) - call base_mesh_nml%get_value( 'geometry', geometry ) - call base_mesh_nml%get_value( 'topology', topology ) - - call extrusion_nml%get_value( 'method', method ) - call extrusion_nml%get_value( 'domain_height', domain_height ) - call extrusion_nml%get_value( 'number_of_layers', number_of_layers ) - call planet_nml%get_value( 'scaled_radius', scaled_radius ) - call io_nml%get_value( 'write_diag', write_diag) - - call lbc_demo_nml%get_value( 'enable_lbc', enable_lbc ) - call lbc_demo_nml%get_value( 'apply_lbc', apply_lbc ) - call lbc_demo_nml%get_value( 'write_lbc', write_lbc ) - call lbc_demo_nml%get_value( 'lbc_source', lbc_source ) + prime_mesh_name = modeldb%config%base_mesh%prime_mesh_name() + geometry = modeldb%config%base_mesh%geometry() + topology = modeldb%config%base_mesh%topology() + + method = modeldb%config%extrusion%method() + domain_height = modeldb%config%extrusion%domain_height() + number_of_layers = modeldb%config%extrusion%number_of_layers() + + scaled_radius = modeldb%config%planet%scaled_radius() + write_diag = modeldb%config%io%write_diag() + + enable_lbc = modeldb%config%lbc_demo%enable_lbc() + apply_lbc = modeldb%config%lbc_demo%apply_lbc() + write_lbc = modeldb%config%lbc_demo%write_lbc() !======================================================================= ! Mesh setup @@ -278,21 +264,17 @@ subroutine step( program_name, modeldb ) character(*), intent(in) :: program_name type(modeldb_type), intent(inout) :: modeldb - type( field_collection_type ), pointer :: output_diags - type(namelist_type), pointer :: io_nml - type(namelist_type), pointer :: lbc_demo_nml + type(field_collection_type), pointer :: output_diags logical :: apply_lbc, write_diag, write_lbc, enable_lbc character(str_def) :: suffix - io_nml => modeldb%configuration%get_namelist('io') - lbc_demo_nml => modeldb%configuration%get_namelist('lbc_demo') - - call io_nml%get_value( 'write_diag', write_diag) + nullify(output_diags) - call lbc_demo_nml%get_value( 'apply_lbc', apply_lbc ) - call lbc_demo_nml%get_value( 'enable_lbc', enable_lbc ) - call lbc_demo_nml%get_value( 'write_lbc', write_lbc ) + write_diag = modeldb%config%io%write_diag() + enable_lbc = modeldb%config%lbc_demo%enable_lbc() + apply_lbc = modeldb%config%lbc_demo%apply_lbc() + write_lbc = modeldb%config%lbc_demo%write_lbc() if (apply_lbc) then ! Update prognostic with LBC fields @@ -301,7 +283,6 @@ subroutine step( program_name, modeldb ) if (write_diag) then ! Write out output file - if (enable_lbc .and. write_lbc) then output_diags => modeldb%fields%get_field_collection('lbc') suffix=':lbc' @@ -311,7 +292,6 @@ subroutine step( program_name, modeldb ) end if call write_field_set(output_diags, suffix) - end if end subroutine step @@ -329,12 +309,10 @@ subroutine finalise( program_name, modeldb ) type(modeldb_type), intent(inout) :: modeldb type(field_collection_type), pointer :: depository - type(namelist_type), pointer :: lbc_demo_nml integer(i_def) :: lbc_field_type - lbc_demo_nml => modeldb%configuration%get_namelist('lbc_demo') - call lbc_demo_nml%get_value( 'field_type', lbc_field_type ) + lbc_field_type = modeldb%config%lbc_demo%field_type() !------------------------------------------------------------------------- ! Checksum output - Only for real fields diff --git a/applications/lbc_demo/source/lbc_demo.f90 b/applications/lbc_demo/source/lbc_demo.f90 index e6005b095..50612d273 100644 --- a/applications/lbc_demo/source/lbc_demo.f90 +++ b/applications/lbc_demo/source/lbc_demo.f90 @@ -8,7 +8,7 @@ !> @details Calls init, run and finalise routines from lbc_demo driver module program lbc_demo - use cli_mod, only: get_initial_filename + use cli_mod, only: parse_command_line use driver_collections_mod, only: init_collections, final_collections use constants_mod, only: precision_real @@ -24,7 +24,6 @@ program lbc_demo use lfric_mpi_mod, only: global_mpi use lbc_demo_mod, only: required_namelists use lbc_demo_driver_mod, only: initialise, step, finalise - use namelist_mod, only: namelist_type use base_mesh_config_mod, only: geometry_spherical, & topology_fully_periodic @@ -35,9 +34,10 @@ program lbc_demo character(*), parameter :: program_name = "lbc_demo" character(:), allocatable :: filename - type(namelist_type), pointer :: base_mesh_nml integer :: geometry, topology + call parse_command_line( filename ) + write(log_scratch_space, '(A)') & 'Application built with ' // trim(precision_real) // '-bit real numbers' call log_event( log_scratch_space, log_level_trace ) @@ -45,18 +45,18 @@ program lbc_demo ! The technical and scientific state modeldb%mpi => global_mpi call modeldb%configuration%initialise( program_name, table_len=10 ) + call modeldb%config%initialise( program_name ) call init_comm(program_name, modeldb) - call get_initial_filename( filename ) - call init_config( filename, required_namelists, & - modeldb%configuration ) + + call init_config(filename, required_namelists, & + configuration=modeldb%configuration, & + config=modeldb%config) ! Before anything else, test that the mesh provided was a regional domain. ! This application is not intended for cubed-sphere meshes. - - base_mesh_nml => modeldb%configuration%get_namelist('base_mesh') - call base_mesh_nml%get_value( 'geometry', geometry ) - call base_mesh_nml%get_value( 'topology', topology ) + geometry = modeldb%config%base_mesh%geometry() + topology = modeldb%config%base_mesh%topology() if ( geometry == geometry_spherical .and. & topology == topology_fully_periodic ) then diff --git a/applications/simple_diffusion/rose-meta/lfric-simple_diffusion/version30_31.py b/applications/simple_diffusion/rose-meta/lfric-simple_diffusion/version30_31.py new file mode 100644 index 000000000..21a76158b --- /dev/null +++ b/applications/simple_diffusion/rose-meta/lfric-simple_diffusion/version30_31.py @@ -0,0 +1,45 @@ +import re +import sys + +from metomi.rose.upgrade import MacroUpgrade + +from .version22_30 import * + + +class UpgradeError(Exception): + """Exception created when an upgrade fails.""" + + def __init__(self, msg): + self.msg = msg + + def __repr__(self): + sys.tracebacklimit = 0 + return self.msg + + __str__ = __repr__ + + +""" +Copy this template and complete to add your macro +class vnXX_txxx(MacroUpgrade): + # Upgrade macro for by + BEFORE_TAG = "vnX.X" + AFTER_TAG = "vnX.X_txxx" + def upgrade(self, config, meta_config=None): + # Add settings + return config, self.reports +""" + + +class vn30_t306(MacroUpgrade): + """Upgrade macro for ticket TTTT by Unknown.""" + + BEFORE_TAG = "vn3.0" + AFTER_TAG = "vn3.1" + + def upgrade(self, config, meta_config=None): + # Commands From: rose-meta/lfric-driver + # Blank Upgrade Macro + # Commands From: rose-meta/lfric-simple_diffusion + # Blank Upgrade Macro + return config, self.reports diff --git a/applications/simple_diffusion/rose-meta/lfric-simple_diffusion/versions.py b/applications/simple_diffusion/rose-meta/lfric-simple_diffusion/versions.py index 152c043d0..01798ad2b 100644 --- a/applications/simple_diffusion/rose-meta/lfric-simple_diffusion/versions.py +++ b/applications/simple_diffusion/rose-meta/lfric-simple_diffusion/versions.py @@ -1,8 +1,8 @@ import sys -from metomi.rose.upgrade import MacroUpgrade +from metomi.rose.upgrade import MacroUpgrade # noqa: F401 -from .version22_30 import * +from .version30_31 import * class UpgradeError(Exception): diff --git a/applications/simple_diffusion/rose-meta/lfric-simple_diffusion/vn3.1/rose-meta.conf b/applications/simple_diffusion/rose-meta/lfric-simple_diffusion/vn3.1/rose-meta.conf new file mode 100644 index 000000000..b9730e75e --- /dev/null +++ b/applications/simple_diffusion/rose-meta/lfric-simple_diffusion/vn3.1/rose-meta.conf @@ -0,0 +1 @@ +import=lfric-driver/vn3.1 diff --git a/applications/simple_diffusion/source/algorithm/simple_diffusion_alg_mod.x90 b/applications/simple_diffusion/source/algorithm/simple_diffusion_alg_mod.x90 index 9f99a355f..4e1121503 100644 --- a/applications/simple_diffusion/source/algorithm/simple_diffusion_alg_mod.x90 +++ b/applications/simple_diffusion/source/algorithm/simple_diffusion_alg_mod.x90 @@ -6,15 +6,17 @@ !>@brief Module containing simple_diffusion_alg module simple_diffusion_alg_mod - use constants_mod, only: i_def,r_def + + use constants_mod, only: i_def, r_def + use driver_modeldb_mod, only: modeldb_type use log_mod, only: log_event, & LOG_LEVEL_INFO, & LOG_LEVEL_TRACE use mesh_mod, only: mesh_type use field_mod, only: field_type - use finite_element_config_mod, only: element_order_h, element_order_v use fs_continuity_mod, only: Wtheta, W2 use function_space_collection_mod, only: function_space_collection + use function_space_mod, only: function_space_type use operator_mod, only: operator_type use matrix_vector_kernel_mod, only: matrix_vector_kernel_type use simple_diffusion_constants_mod, only: get_dx_at_w2 @@ -30,11 +32,14 @@ module simple_diffusion_alg_mod contains !> @details Calculates the diffusion increment for a field, and adds it to said field. + !> @param[in] modeldb Application state object !> @param[inout] field_in Input Wtheta field - subroutine simple_diffusion_alg( field_in ) + subroutine simple_diffusion_alg( modeldb, field_in ) implicit none + type(modeldb_type), intent( in ) :: modeldb + ! Prognostic fields type( field_type ), intent( inout ) :: field_in @@ -43,18 +48,30 @@ contains type( field_type ) :: visc real(r_def), parameter :: visc_val = 100000.0_r_def - type(mesh_type), pointer :: mesh => null() + type(mesh_type), pointer :: mesh integer(kind=i_def), parameter :: stencil_depth = 1_i_def - type( field_type ), pointer :: dx_at_w2 => null() + type( field_type ), pointer :: dx_at_w2 + + type(function_space_type), pointer :: fs + integer(i_def) :: order_h, order_v call log_event( "simple_diffusion: Running algorithm", LOG_LEVEL_TRACE ) - mesh => field_in%get_mesh() + + nullify(dx_at_w2) + nullify(mesh) + + order_h = modeldb%config%finite_element%element_order_h() + order_v = modeldb%config%finite_element%element_order_v() + + mesh => field_in%get_mesh() dx_at_w2 => get_dx_at_w2(mesh) - call dfield_in%initialise( function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, Wtheta)) - call visc%initialise( function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, Wtheta)) + + fs => function_space_collection%get_fs(mesh, order_h, order_v, Wtheta) + + call dfield_in%initialise(fs) + call visc%initialise(fs) + call invoke( name = "compute_diffusion", & setval_c(visc, visc_val), & setval_c(dfield_in, 0.0_r_def), & diff --git a/applications/simple_diffusion/source/algorithm/simple_diffusion_constants_mod.x90 b/applications/simple_diffusion/source/algorithm/simple_diffusion_constants_mod.x90 index d9f6cef64..eba4754c6 100644 --- a/applications/simple_diffusion/source/algorithm/simple_diffusion_constants_mod.x90 +++ b/applications/simple_diffusion/source/algorithm/simple_diffusion_constants_mod.x90 @@ -15,18 +15,19 @@ module simple_diffusion_constants_mod ! Infrastructure - use constants_mod, only: i_def, r_def, & + use constants_mod, only: i_def, r_def, l_def, & str_def, str_short + use driver_modeldb_mod, only: modeldb_type use field_collection_mod, only: field_collection_type use field_mod, only: field_type use fs_continuity_mod, only: W2 use function_space_collection_mod, only: function_space_collection use function_space_mod, only: function_space_type - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, LOG_LEVEL_TRACE, & LOG_LEVEL_ERROR use mesh_mod, only: mesh_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Kernels use sci_calc_da_at_w2_kernel_mod, only: calc_dA_at_w2_kernel_type @@ -48,21 +49,26 @@ module simple_diffusion_constants_mod contains !> @brief Subroutine to create the finite element constants + !> @param[in] modeldb Application state object !> @param[in] mesh The prime model mesh !> @param[in] chi Coordinate fields !> @param[in] panel_id Panel_id field - subroutine create_simple_diffusion_constants(mesh, & - chi, & - panel_id ) + subroutine create_simple_diffusion_constants( modeldb, & + mesh, & + chi, & + panel_id ) implicit none ! Arguments - type(mesh_type), pointer, intent(in) :: mesh - type(field_type), target, intent(in) :: chi(:) - type(field_type), target, intent(in) :: panel_id + type(modeldb_type), intent(in) :: modeldb + type(mesh_type), pointer, intent(in) :: mesh + type(field_type), target, intent(in) :: chi(:) + type(field_type), target, intent(in) :: panel_id + + integer(tik) :: id - if ( subroutine_timers ) call timer('simple_diffusion_constants_alg') + if ( LPROF ) call start_timing( id, 'simple_diffusion_constants_alg' ) call log_event( "simple_diffusion: creating runtime constants", LOG_LEVEL_TRACE ) !============================= dx_at_w2 setup =============================! @@ -72,7 +78,7 @@ contains call log_event( "simple_diffusion: runtime constants created", LOG_LEVEL_TRACE ) - if ( subroutine_timers ) call timer('simple_diffusion_constants_alg') + if ( LPROF ) call stop_timing( id, 'simple_diffusion_constants_alg' ) call log_event( "simple_diffusion: created FEM constants", LOG_LEVEL_TRACE ) end subroutine create_simple_diffusion_constants diff --git a/applications/simple_diffusion/source/driver/init_simple_diffusion_mod.F90 b/applications/simple_diffusion/source/driver/init_simple_diffusion_mod.F90 index 6a3f8ac19..1dc960087 100644 --- a/applications/simple_diffusion/source/driver/init_simple_diffusion_mod.F90 +++ b/applications/simple_diffusion/source/driver/init_simple_diffusion_mod.F90 @@ -13,19 +13,17 @@ module init_simple_diffusion_mod use sci_assign_field_random_range_alg_mod, & only: assign_field_random_range - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, l_def use driver_modeldb_mod, only : modeldb_type use field_collection_mod, only : field_collection_type use field_mod, only : field_type use field_parent_mod, only : write_interface - use finite_element_config_mod, only : element_order_h, element_order_v use function_space_collection_mod, only : function_space_collection + use function_space_mod, only : function_space_type use fs_continuity_mod, only : Wtheta use log_mod, only : log_event, & LOG_LEVEL_TRACE use mesh_mod, only : mesh_type - use io_config_mod, only : write_diag, & - use_xios_io use lfric_xios_write_mod, only : write_field_generic use simple_diffusion_constants_mod, only : create_simple_diffusion_constants @@ -37,7 +35,7 @@ module init_simple_diffusion_mod !> @param[in,out] chi The co-ordinate field !> @param[in,out] panel_id 2d field giving the id for cubed sphere panels !> @param[in,out] modeldb The structure that holds model state - subroutine init_simple_diffusion( mesh, chi, panel_id, modeldb) + subroutine init_simple_diffusion(mesh, chi, panel_id, modeldb) implicit none @@ -53,13 +51,24 @@ subroutine init_simple_diffusion( mesh, chi, panel_id, modeldb) real(kind=r_def), parameter :: min_val = 280.0_r_def real(kind=r_def), parameter :: max_val = 330.0_r_def + type(function_space_type), pointer :: fs + + logical(l_def) :: write_diag, use_xios_io + integer(i_def) :: order_h, order_v + + order_h = modeldb%config%finite_element%element_order_h() + order_v = modeldb%config%finite_element%element_order_v() + + write_diag = modeldb%config%io%write_diag() + use_xios_io = modeldb%config%io%use_xios_io() + + fs => function_space_collection%get_fs(mesh, order_h, order_v, Wtheta) + call log_event( 'simple_diffusion: Initialising miniapp ...', LOG_LEVEL_TRACE ) + ! Create prognostic fields ! Creates a field in the Wtheta function space - call diffusion_field%initialise( vector_space = & - function_space_collection%get_fs(mesh, element_order_h, & - element_order_v, Wtheta), & - name="diffusion_field") + call diffusion_field%initialise(fs, name="diffusion_field") ! Set up field with an IO behaviour (XIOS only at present) if (write_diag .and. use_xios_io) then @@ -78,7 +87,7 @@ subroutine init_simple_diffusion( mesh, chi, panel_id, modeldb) ! Create simple_diffusion runtime constants. This creates various things ! needed by the fem algorithms such as mass matrix operators, mass ! matrix diagonal fields and the geopotential field - call create_simple_diffusion_constants(mesh, chi, panel_id) + call create_simple_diffusion_constants(modeldb, mesh, chi, panel_id) call log_event( 'simple_diffusion: Miniapp initialised', LOG_LEVEL_TRACE ) diff --git a/applications/simple_diffusion/source/driver/simple_diffusion_driver_mod.f90 b/applications/simple_diffusion/source/driver/simple_diffusion_driver_mod.f90 index 3710e98d4..13f1b9461 100644 --- a/applications/simple_diffusion/source/driver/simple_diffusion_driver_mod.f90 +++ b/applications/simple_diffusion/source/driver/simple_diffusion_driver_mod.f90 @@ -11,7 +11,7 @@ module simple_diffusion_driver_mod use add_mesh_map_mod, only : assign_mesh_maps use sci_checksum_alg_mod, only : checksum_alg - use constants_mod, only : i_def, str_def, & + use constants_mod, only : i_def, str_def, l_def, & r_def, r_second use convert_to_upper_mod, only : convert_to_upper use create_mesh_mod, only : create_mesh, create_extrusion @@ -35,7 +35,6 @@ module simple_diffusion_driver_mod LOG_LEVEL_TRACE use mesh_mod, only : mesh_type use mesh_collection_mod, only : mesh_collection - use namelist_mod, only : namelist_type use random_number_generator_mod, only : random_number_generator_type use simple_diffusion_alg_mod, only : simple_diffusion_alg @@ -44,7 +43,6 @@ module simple_diffusion_driver_mod !------------------------------------ use base_mesh_config_mod, only: GEOMETRY_SPHERICAL, & GEOMETRY_PLANAR - use io_config_mod, only: write_diag implicit none @@ -80,13 +78,9 @@ subroutine initialise( program_name, modeldb) class(abstract_value_type), pointer :: abstract_value type(random_number_generator_type), pointer :: rng - type(namelist_type), pointer :: base_mesh_nml => null() - type(namelist_type), pointer :: planet_nml => null() - type(namelist_type), pointer :: extrusion_nml => null() - character(str_def) :: prime_mesh_name - integer(i_def) :: stencil_depth + integer(i_def) :: stencil_depth(1) integer(i_def) :: geometry integer(i_def) :: method integer(i_def) :: number_of_layers @@ -101,20 +95,12 @@ subroutine initialise( program_name, modeldb) !======================================================================= ! 0.0 Extract configuration variables !======================================================================= - base_mesh_nml => modeldb%configuration%get_namelist('base_mesh') - planet_nml => modeldb%configuration%get_namelist('planet') - extrusion_nml => modeldb%configuration%get_namelist('extrusion') - - call base_mesh_nml%get_value( 'prime_mesh_name', prime_mesh_name ) - call base_mesh_nml%get_value( 'geometry', geometry ) - call extrusion_nml%get_value( 'method', method ) - call extrusion_nml%get_value( 'domain_height', domain_height ) - call extrusion_nml%get_value( 'number_of_layers', number_of_layers ) - call planet_nml%get_value( 'scaled_radius', scaled_radius ) - - base_mesh_nml => null() - planet_nml => null() - extrusion_nml => null() + prime_mesh_name = modeldb%config%base_mesh%prime_mesh_name() + geometry = modeldb%config%base_mesh%geometry() + method = modeldb%config%extrusion%method() + domain_height = modeldb%config%extrusion%domain_height() + number_of_layers = modeldb%config%extrusion%number_of_layers() + scaled_radius = modeldb%config%planet%scaled_radius() !======================================================================= ! 1.0 Mesh @@ -146,7 +132,7 @@ subroutine initialise( program_name, modeldb) end select allocate( extrusion, source=create_extrusion( method, & - domain_height, & + domain_height, & domain_bottom, & number_of_layers, & PRIME_EXTRUSION ) ) @@ -229,15 +215,20 @@ subroutine step( program_name, modeldb ) character(*), intent(in) :: program_name type(modeldb_type), intent(inout) :: modeldb + type( field_collection_type ), pointer :: depository type( field_type ), pointer :: diffusion_field + logical(l_def) :: write_diag + + write_diag = modeldb%config%io%write_diag() + depository => modeldb%fields%get_field_collection("depository") call depository%get_field("diffusion_field", diffusion_field) ! Call an algorithm call log_event(program_name//": Calculating diffusion", LOG_LEVEL_INFO) - call simple_diffusion_alg(diffusion_field) + call simple_diffusion_alg(modeldb, diffusion_field) if (write_diag) then ! Write out output file diff --git a/applications/simple_diffusion/source/simple_diffusion.f90 b/applications/simple_diffusion/source/simple_diffusion.f90 index 2db193c77..e2b09fce6 100644 --- a/applications/simple_diffusion/source/simple_diffusion.f90 +++ b/applications/simple_diffusion/source/simple_diffusion.f90 @@ -8,7 +8,7 @@ !> @details Calls init, run and finalise routines from simple_diffusion driver module program simple_diffusion - use cli_mod, only : get_initial_filename + use cli_mod, only : parse_command_line use driver_collections_mod, only : init_collections, final_collections use constants_mod, only : precision_real use driver_comm_mod, only : init_comm, final_comm @@ -34,8 +34,10 @@ program simple_diffusion integer, parameter :: default_seed = 123456789 type(random_number_generator_type), pointer :: rng + call parse_command_line( filename ) call modeldb%values%initialise() call modeldb%configuration%initialise( program_name, table_len=10 ) + call modeldb%config%initialise( program_name ) write(log_scratch_space,& '("Application built with ", A, "-bit real numbers")') & @@ -43,10 +45,11 @@ program simple_diffusion call log_event( log_scratch_space, log_level_trace ) modeldb%mpi => global_mpi call init_comm(program_name, modeldb) - call get_initial_filename( filename ) - call init_config( filename, & - simple_diffusion_required_namelists, & - modeldb%configuration ) + + call init_config( filename, simple_diffusion_required_namelists, & + configuration=modeldb%configuration, & + config=modeldb%config ) + deallocate( filename ) call init_logger( modeldb%mpi%get_comm(), program_name ) diff --git a/applications/skeleton/rose-meta/lfric-skeleton/version30_31.py b/applications/skeleton/rose-meta/lfric-skeleton/version30_31.py new file mode 100644 index 000000000..3dc5528dc --- /dev/null +++ b/applications/skeleton/rose-meta/lfric-skeleton/version30_31.py @@ -0,0 +1,45 @@ +import re +import sys + +from metomi.rose.upgrade import MacroUpgrade + +from .version22_30 import * + + +class UpgradeError(Exception): + """Exception created when an upgrade fails.""" + + def __init__(self, msg): + self.msg = msg + + def __repr__(self): + sys.tracebacklimit = 0 + return self.msg + + __str__ = __repr__ + + +""" +Copy this template and complete to add your macro +class vnXX_txxx(MacroUpgrade): + # Upgrade macro for by + BEFORE_TAG = "vnX.X" + AFTER_TAG = "vnX.X_txxx" + def upgrade(self, config, meta_config=None): + # Add settings + return config, self.reports +""" + + +class vn30_t306(MacroUpgrade): + """Upgrade macro for ticket TTTT by Unknown.""" + + BEFORE_TAG = "vn3.0" + AFTER_TAG = "vn3.1" + + def upgrade(self, config, meta_config=None): + # Commands From: rose-meta/lfric-driver + # Blank Upgrade Macro + # Commands From: rose-meta/lfric-skeleton + # Blank Upgrade Macro + return config, self.reports diff --git a/applications/skeleton/rose-meta/lfric-skeleton/versions.py b/applications/skeleton/rose-meta/lfric-skeleton/versions.py index 152c043d0..01798ad2b 100644 --- a/applications/skeleton/rose-meta/lfric-skeleton/versions.py +++ b/applications/skeleton/rose-meta/lfric-skeleton/versions.py @@ -1,8 +1,8 @@ import sys -from metomi.rose.upgrade import MacroUpgrade +from metomi.rose.upgrade import MacroUpgrade # noqa: F401 -from .version22_30 import * +from .version30_31 import * class UpgradeError(Exception): diff --git a/applications/skeleton/rose-meta/lfric-skeleton/vn3.1/rose-meta.conf b/applications/skeleton/rose-meta/lfric-skeleton/vn3.1/rose-meta.conf new file mode 100644 index 000000000..b9730e75e --- /dev/null +++ b/applications/skeleton/rose-meta/lfric-skeleton/vn3.1/rose-meta.conf @@ -0,0 +1 @@ +import=lfric-driver/vn3.1 diff --git a/applications/skeleton/source/algorithm/skeleton_alg_mod.x90 b/applications/skeleton/source/algorithm/skeleton_alg_mod.x90 index 6bcb680b2..dcd6dda1a 100644 --- a/applications/skeleton/source/algorithm/skeleton_alg_mod.x90 +++ b/applications/skeleton/source/algorithm/skeleton_alg_mod.x90 @@ -7,14 +7,14 @@ !>@brief Barebones algorithm to help the development of applications module skeleton_alg_mod - use constants_mod, only: i_def,r_def - use log_mod, only: log_event, & - LOG_LEVEL_INFO + use constants_mod, only: r_def, i_def + use log_mod, only: log_event, log_level_info use mesh_mod, only: mesh_type + use driver_modeldb_mod, only: modeldb_type use field_mod, only: field_type - use finite_element_config_mod, only: element_order_h, element_order_v use fs_continuity_mod, only: W2 use function_space_collection_mod, only: function_space_collection + use function_space_mod, only: function_space_type use operator_mod, only: operator_type use matrix_vector_kernel_mod, only: matrix_vector_kernel_type use skeleton_constants_mod, only: get_div @@ -29,30 +29,42 @@ module skeleton_alg_mod contains !> @details An algorithm for developing applications + !> @param[in] modeldb Application state object !> @param[inout] field_1 A prognostic field object - subroutine skeleton_alg(field_1) + subroutine skeleton_alg(modeldb, field_1) implicit none + type(modeldb_type), intent(in) :: modeldb + ! Prognostic fields - type( field_type ), intent( inout ) :: field_1 + type(field_type), intent(inout) :: field_1 ! Diagnostic fields - type( field_type ) :: field_2 + type(field_type) :: field_2 + + type(mesh_type), pointer :: mesh + type(operator_type), pointer :: divergence + type(function_space_type), pointer :: fs + + real(r_def) :: s + + integer(i_def) :: order_h + integer(i_def) :: order_v - real(r_def) :: s - type(mesh_type), pointer :: mesh => null() - type( operator_type ), pointer :: divergence => null() + call log_event( "skeleton: Running algorithm", log_level_info ) - call log_event( "skeleton: Running algorithm", LOG_LEVEL_INFO ) + order_h = modeldb%config%finite_element%element_order_h() + order_v = modeldb%config%finite_element%element_order_v() ! Create a new field on the W2 function space - mesh => field_1%get_mesh() - call field_2%initialise( function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, W2 ) ) + mesh => field_1%get_mesh() + divergence => get_div(mesh) + + fs => function_space_collection%get_fs(mesh, order_h, order_v, W2) + call field_2%initialise(fs) ! Set the new field to a constant value and compute the divergence of it - divergence => get_div(mesh) s = 2.0_r_def call invoke( name = "compute_divergence", & setval_c(field_2, s ), & @@ -63,9 +75,7 @@ contains ! printing the min/max values in field_1 call log_field_minmax( LOG_LEVEL_INFO, 'field_1', field_1 ) - nullify(mesh) - - call log_event( "skeleton: finished algorithm", LOG_LEVEL_INFO ) + call log_event( "skeleton: finished algorithm", log_level_info ) end subroutine skeleton_alg diff --git a/applications/skeleton/source/algorithm/skeleton_constants_mod.x90 b/applications/skeleton/source/algorithm/skeleton_constants_mod.x90 index 3017c4bb8..0cc5cada1 100644 --- a/applications/skeleton/source/algorithm/skeleton_constants_mod.x90 +++ b/applications/skeleton/source/algorithm/skeleton_constants_mod.x90 @@ -15,27 +15,22 @@ module skeleton_constants_mod ! Infrastructure - use constants_mod, only: str_def + use constants_mod, only: str_def, i_def, l_def + use driver_modeldb_mod, only: modeldb_type use field_mod, only: field_type use fs_continuity_mod, only: W0, W1, W2, W2broken, & W2H, W2V, W3, Wtheta use function_space_collection_mod, only: function_space_collection use function_space_mod, only: function_space_type use inventory_by_mesh_mod, only: inventory_by_mesh_type - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, LOG_LEVEL_INFO, & LOG_LEVEL_ERROR use mesh_mod, only: mesh_type use operator_mod, only: operator_type use quadrature_xyoz_mod, only: quadrature_xyoz_type use quadrature_rule_gaussian_mod, only: quadrature_rule_gaussian_type - use timer_mod, only: timer - - ! Configuration - use finite_element_config_mod, only: element_order_h, & - element_order_v, & - nqp_h_exact, & - nqp_v_exact + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Kernels use sci_compute_derham_matrices_kernel_mod, only: compute_derham_matrices_kernel_type @@ -74,49 +69,75 @@ module skeleton_constants_mod contains !> @brief Subroutine to create the finite element constants + !> @param[in] modeldb Application state object !> @param[in] mesh The prime model mesh !> @param[in] chi Coordinate fields !> @param[in] panel_id Panel_id field - subroutine create_skeleton_constants(mesh, & - chi, & - panel_id ) + subroutine create_skeleton_constants( modeldb, mesh, & + chi, panel_id ) implicit none ! Arguments - type(mesh_type), pointer, intent(in) :: mesh - type(field_type), target, intent(in) :: chi(:) - type(field_type), target, intent(in) :: panel_id + type(modeldb_type), intent(in) :: modeldb + + type(mesh_type), pointer, intent(in) :: mesh + type(field_type), target, intent(in) :: chi(:) + type(field_type), target, intent(in) :: panel_id - type(operator_type), pointer :: mm_w0 => null() - type(operator_type), pointer :: mm_w1 => null() - type(operator_type), pointer :: mm_w2 => null() - type(operator_type), pointer :: mm_w2b => null() - type(operator_type), pointer :: mm_w3 => null() - type(operator_type), pointer :: mm_wtheta => null() + type(operator_type), pointer :: mm_w0 + type(operator_type), pointer :: mm_w1 + type(operator_type), pointer :: mm_w2 + type(operator_type), pointer :: mm_w2b + type(operator_type), pointer :: mm_w3 + type(operator_type), pointer :: mm_wtheta ! Differential operators - type(operator_type), pointer :: div => null() - type(operator_type), pointer :: grad => null() - type(operator_type), pointer :: curl => null() - type(operator_type), pointer :: broken_div => null() + type(operator_type), pointer :: div + type(operator_type), pointer :: grad + type(operator_type), pointer :: curl + type(operator_type), pointer :: broken_div ! Internal variables - type(function_space_type), pointer :: w0_fs => null() - type(function_space_type), pointer :: w1_fs => null() - type(function_space_type), pointer :: w2_fs => null() - type(function_space_type), pointer :: w2b_fs => null() - type(function_space_type), pointer :: w2h_fs => null() - type(function_space_type), pointer :: w2v_fs => null() - type(function_space_type), pointer :: w3_fs => null() - type(function_space_type), pointer :: wtheta_fs => null() - - if ( subroutine_timers ) call timer('skeleton_constants_alg') + type(function_space_type), pointer :: w0_fs + type(function_space_type), pointer :: w1_fs + type(function_space_type), pointer :: w2_fs + type(function_space_type), pointer :: w2b_fs + type(function_space_type), pointer :: w2h_fs + type(function_space_type), pointer :: w2v_fs + type(function_space_type), pointer :: w3_fs + type(function_space_type), pointer :: wtheta_fs + + integer(i_def) :: order_h, order_v + integer(i_def) :: nqp_h_exact, nqp_v_exact + + integer(tik) :: id + + if ( LPROF ) call start_timing( id, 'skeleton_constants_alg' ) call log_event( "Skeleton: creating runtime constants", LOG_LEVEL_INFO ) + order_h = modeldb%config%finite_element%element_order_h() + order_v = modeldb%config%finite_element%element_order_v() + nqp_h_exact = modeldb%config%finite_element%nqp_h_exact() + nqp_v_exact = modeldb%config%finite_element%nqp_v_exact() + + !=========== Create function spaces required for setup ==================! + + w0_fs => function_space_collection%get_fs( mesh, order_h, order_v, W0 ) + w1_fs => function_space_collection%get_fs( mesh, order_h, order_v, W1 ) + w2_fs => function_space_collection%get_fs( mesh, order_h, order_v, W2 ) + w2v_fs => function_space_collection%get_fs( mesh, order_h, order_v, W2V ) + w2h_fs => function_space_collection%get_fs( mesh, order_h, order_v, W2H ) + w3_fs => function_space_collection%get_fs( mesh, order_h, order_v, W3 ) + + w2b_fs => function_space_collection%get_fs( mesh, order_h, order_v, & + W2broken ) + wtheta_fs => function_space_collection%get_fs( mesh, order_h, order_v, & + Wtheta ) + !======================== Create quadrature object ========================! - qr = quadrature_xyoz_type(nqp_h_exact, nqp_h_exact, nqp_v_exact, & - quadrature_rule) + qr = quadrature_xyoz_type( nqp_h_exact, nqp_h_exact, nqp_v_exact, & + quadrature_rule ) !======================== Initialise inventories ==========================! @@ -131,25 +152,6 @@ contains call curl_inventory%initialise(name="curl", table_len=5) call broken_div_inventory%initialise(name="broken_div", table_len=5) - !=========== Create function spaces required for setup ==================! - - w0_fs => function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, W0 ) - w1_fs => function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, W1 ) - w2_fs => function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, W2 ) - w2b_fs => function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, W2broken ) - w2v_fs => function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, W2V ) - w2h_fs => function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, W2H ) - w3_fs => function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, W3 ) - wtheta_fs => function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, Wtheta ) - !=================== Create de Rham cochain operators ===================! ! Set up all mass matrices and operators @@ -178,7 +180,7 @@ contains mm_w0, mm_w1, mm_w2, mm_w2b, mm_w3, mm_wtheta, grad, curl, div, & broken_div ) - if ( subroutine_timers ) call timer('skeleton_constants_alg') + if ( LPROF ) call stop_timing( id, 'skeleton_constants_alg' ) call log_event( "Skeleton: created FEM constants", LOG_LEVEL_INFO ) end subroutine create_skeleton_constants diff --git a/applications/skeleton/source/driver/init_skeleton_mod.F90 b/applications/skeleton/source/driver/init_skeleton_mod.F90 index e6f642c82..a33990f10 100644 --- a/applications/skeleton/source/driver/init_skeleton_mod.F90 +++ b/applications/skeleton/source/driver/init_skeleton_mod.F90 @@ -11,63 +11,67 @@ module init_skeleton_mod - use constants_mod, only : i_def, r_def - use driver_modeldb_mod, only : modeldb_type - use field_collection_mod, only : field_collection_type - use field_mod, only : field_type - use field_parent_mod, only : write_interface - use finite_element_config_mod, only : element_order_h, element_order_v - use function_space_collection_mod, only : function_space_collection - use fs_continuity_mod, only : W3 - use log_mod, only : log_event, & - LOG_LEVEL_INFO, & - LOG_LEVEL_ERROR - use mesh_mod, only : mesh_type - use skeleton_constants_mod, only : create_skeleton_constants + use constants_mod, only: i_def + use driver_modeldb_mod, only: modeldb_type + use field_collection_mod, only: field_collection_type + use field_mod, only: field_type + use function_space_collection_mod, only: function_space_collection + use function_space_mod, only: function_space_type + use fs_continuity_mod, only: W3 + use log_mod, only: log_event, log_level_info + use mesh_mod, only: mesh_type + use skeleton_constants_mod, only: create_skeleton_constants implicit none contains !> @details Initialises everything needed to run the skeleton miniapp - !> @param[in] mesh Representation of the mesh the code will run on - !> @param[in,out] chi The co-ordinate field + !> @param[in,out] modeldb The structure that holds model state + !> @param[in] mesh Representation of the mesh the code will run on + !> @param[in,out] chi The co-ordinate field !> @param[in,out] panel_id 2d field giving the id for cubed sphere panels - !> @param[in,out] modeldb The structure that holds model state - subroutine init_skeleton( mesh, chi, panel_id, modeldb) + + subroutine init_skeleton(modeldb, mesh, chi, panel_id) implicit none - type(mesh_type), intent(in), pointer :: mesh + type(modeldb_type), target, intent(inout) :: modeldb + type(mesh_type), pointer, intent(in) :: mesh + ! Coordinate field - type( field_type ), intent(inout) :: chi(:) - type( field_type ), intent(inout) :: panel_id - type(modeldb_type), intent(inout) :: modeldb + type(field_type), intent(inout) :: chi(:) + type(field_type), intent(inout) :: panel_id + + type(field_type) :: field_1 + + type(field_collection_type), pointer :: depository + type(function_space_type), pointer :: fs - type( field_type ) :: field_1 - type( field_collection_type ), pointer :: depository => null() + integer(i_def) :: order_h, order_v - procedure(write_interface), pointer :: tmp_ptr + call log_event('skeleton: Initialising miniapp ...', log_level_info) - call log_event( 'skeleton: Initialising miniapp ...', LOG_LEVEL_INFO ) + depository => modeldb%fields%get_field_collection("depository") + + order_h = modeldb%config%finite_element%element_order_h() + order_v = modeldb%config%finite_element%element_order_v() + + fs => function_space_collection%get_fs(mesh, order_h, order_v, W3) ! Create prognostic fields ! Creates a field in the W3 function space (fully discontinuous field) - call field_1%initialise( vector_space = & - function_space_collection%get_fs(mesh, element_order_h, & - element_order_v, W3), & - name="field_1") + call field_1%initialise(fs, name="field_1") ! Add field to modeldb - depository => modeldb%fields%get_field_collection("depository") call depository%add_field(field_1) ! Create skeleton runtime constants. This creates various things ! needed by the fem algorithms such as mass matrix operators, mass ! matrix diagonal fields and the geopotential field - call create_skeleton_constants(mesh, chi, panel_id) + call create_skeleton_constants(modeldb, mesh, chi, panel_id) - call log_event( 'skeleton: Miniapp initialised', LOG_LEVEL_INFO ) + call log_event('skeleton: Miniapp initialised', log_level_info) end subroutine init_skeleton diff --git a/applications/skeleton/source/driver/skeleton_driver_mod.f90 b/applications/skeleton/source/driver/skeleton_driver_mod.f90 index 42a9597a2..607a48568 100644 --- a/applications/skeleton/source/driver/skeleton_driver_mod.f90 +++ b/applications/skeleton/source/driver/skeleton_driver_mod.f90 @@ -10,11 +10,11 @@ module skeleton_driver_mod use add_mesh_map_mod, only : assign_mesh_maps - use calendar_mod, only : calendar_type use sci_checksum_alg_mod, only : checksum_alg use constants_mod, only : i_def, str_def, & r_def, r_second use convert_to_upper_mod, only : convert_to_upper + use config_mod, only : config_type use create_mesh_mod, only : create_extrusion, create_mesh use driver_mesh_mod, only : init_mesh use driver_modeldb_mod, only : modeldb_type @@ -33,8 +33,6 @@ module skeleton_driver_mod LOG_LEVEL_INFO use mesh_mod, only : mesh_type use mesh_collection_mod, only : mesh_collection - use namelist_mod, only : namelist_type - use skeleton_alg_mod, only : skeleton_alg !------------------------------------ @@ -42,7 +40,6 @@ module skeleton_driver_mod !------------------------------------ use base_mesh_config_mod, only: GEOMETRY_SPHERICAL, & GEOMETRY_PLANAR - use io_config_mod, only: write_diag implicit none @@ -55,35 +52,30 @@ module skeleton_driver_mod !> Sets up required state in preparation for run. !> @param [in] program_name Identifier given to the model being run !> @param [in,out] modeldb The structure that holds model state - !> @param [in] calendar The model calendar - subroutine initialise( program_name, modeldb, calendar ) + subroutine initialise(program_name, modeldb) implicit none - character(*), intent(in) :: program_name - type(modeldb_type), intent(inout) :: modeldb - class(calendar_type), intent(in) :: calendar + character(*), intent(in) :: program_name + type(modeldb_type), intent(inout) :: modeldb ! Coordinate field - type(field_type), pointer :: chi(:) => null() - type(field_type), pointer :: panel_id => null() - type(mesh_type), pointer :: mesh => null() - type(inventory_by_mesh_type) :: chi_inventory - type(inventory_by_mesh_type) :: panel_id_inventory + type(field_type), pointer :: chi(:) + type(field_type), pointer :: panel_id + type(mesh_type), pointer :: mesh - character(str_def), allocatable :: base_mesh_names(:) - character(str_def), allocatable :: twod_names(:) + type(inventory_by_mesh_type) :: chi_inventory + type(inventory_by_mesh_type) :: panel_id_inventory + + character(str_def), allocatable :: base_mesh_names(:) + character(str_def), allocatable :: twod_names(:) class(extrusion_type), allocatable :: extrusion type(uniform_extrusion_type), allocatable :: extrusion_2d - type(namelist_type), pointer :: base_mesh_nml => null() - type(namelist_type), pointer :: planet_nml => null() - type(namelist_type), pointer :: extrusion_nml => null() - character(str_def) :: prime_mesh_name - integer(i_def) :: stencil_depth + integer(i_def) :: stencil_depth(1) integer(i_def) :: geometry integer(i_def) :: method integer(i_def) :: number_of_layers @@ -95,21 +87,21 @@ subroutine initialise( program_name, modeldb, calendar ) integer(i_def) :: i integer(i_def), parameter :: one_layer = 1_i_def + nullify(chi) + nullify(panel_id) + nullify(mesh) + + call log_event( program_name//': Initialising.', log_level_info ) + ! ------------------------------- ! Extract namelist variables ! ------------------------------- - base_mesh_nml => modeldb%configuration%get_namelist('base_mesh') - planet_nml => modeldb%configuration%get_namelist('planet') - extrusion_nml => modeldb%configuration%get_namelist('extrusion') - call base_mesh_nml%get_value( 'prime_mesh_name', prime_mesh_name ) - call base_mesh_nml%get_value( 'geometry', geometry ) - call extrusion_nml%get_value( 'method', method ) - call extrusion_nml%get_value( 'domain_height', domain_height ) - call extrusion_nml%get_value( 'number_of_layers', number_of_layers ) - call planet_nml%get_value( 'scaled_radius', scaled_radius ) - base_mesh_nml => null() - planet_nml => null() - extrusion_nml => null() + prime_mesh_name = modeldb%config%base_mesh%prime_mesh_name() + geometry = modeldb%config%base_mesh%geometry() + method = modeldb%config%extrusion%method() + domain_height = modeldb%config%extrusion%domain_height() + number_of_layers = modeldb%config%extrusion%number_of_layers() + scaled_radius = modeldb%config%planet%scaled_radius() !======================================================================= ! Mesh @@ -133,8 +125,9 @@ subroutine initialise( program_name, modeldb, calendar ) call log_event("Invalid geometry for mesh initialisation", & LOG_LEVEL_ERROR) end select + allocate( extrusion, source=create_extrusion( method, & - domain_height, & + domain_height, & domain_bottom, & number_of_layers, & PRIME_EXTRUSION ) ) @@ -167,7 +160,7 @@ subroutine initialise( program_name, modeldb, calendar ) ! Build the FEM function spaces and coordinate fields !======================================================================= ! Create FEM specifics (function spaces and chi field) - call init_fem( mesh_collection, chi_inventory, panel_id_inventory ) + call init_fem(mesh_collection, chi_inventory, panel_id_inventory) !======================================================================= ! Create and initialise prognostic fields @@ -175,7 +168,7 @@ subroutine initialise( program_name, modeldb, calendar ) mesh => mesh_collection%get_mesh(prime_mesh_name) call chi_inventory%get_field_array(mesh, chi) call panel_id_inventory%get_field(mesh, panel_id) - call init_skeleton( mesh, chi, panel_id, modeldb ) + call init_skeleton(modeldb, mesh, chi, panel_id) nullify(mesh, chi, panel_id) deallocate(base_mesh_names) @@ -186,21 +179,22 @@ end subroutine initialise !> Performs a time step. !> @param [in] program_name An identifier given to the model being run !> @param [in,out] modeldb The structure that holds model state - subroutine step( program_name, modeldb ) + subroutine step(program_name, modeldb) implicit none - character(*), intent(in) :: program_name + character(*), intent(in) :: program_name + type(modeldb_type), intent(inout) :: modeldb - type( field_collection_type ), pointer :: depository - type( field_type ), pointer :: field_1 + type(field_collection_type), pointer :: depository + type(field_type), pointer :: field_1 depository => modeldb%fields%get_field_collection("depository") call depository%get_field("field_1", field_1) ! Call an algorithm - call skeleton_alg(field_1) + call skeleton_alg(modeldb, field_1) ! Write out output file call log_event(program_name//": Writing diagnostic output", LOG_LEVEL_INFO) diff --git a/applications/skeleton/source/skeleton.f90 b/applications/skeleton/source/skeleton.f90 index 6f11ea85e..687fe9fc9 100644 --- a/applications/skeleton/source/skeleton.f90 +++ b/applications/skeleton/source/skeleton.f90 @@ -12,7 +12,7 @@ program skeleton - use cli_mod, only: get_initial_filename + use cli_mod, only: parse_command_line use constants_mod, only: precision_real use driver_collections_mod, only: init_collections, final_collections use driver_comm_mod, only: init_comm, final_comm @@ -36,7 +36,9 @@ program skeleton character(*), parameter :: program_name = "skeleton" character(:), allocatable :: filename + call parse_command_line( filename ) call modeldb%configuration%initialise( program_name, table_len=10 ) + call modeldb%config%initialise(program_name) write(log_scratch_space,'(A)') & 'Application built with '// trim(precision_real) // & @@ -46,9 +48,10 @@ program skeleton modeldb%mpi => global_mpi call init_comm( "skeleton", modeldb ) - call get_initial_filename( filename ) call init_config( filename, skeleton_required_namelists, & - modeldb%configuration ) + configuration=modeldb%configuration, & + config=modeldb%config ) + call init_logger( modeldb%mpi%get_comm(), program_name ) call init_collections() call init_time( modeldb ) @@ -60,7 +63,7 @@ program skeleton call modeldb%io_contexts%initialise(program_name, 100) call log_event( 'Initialising ' // program_name // ' ...', log_level_trace ) - call initialise( program_name, modeldb, modeldb%calendar ) + call initialise( program_name, modeldb ) do while (modeldb%clock%tick()) call step( program_name, modeldb ) diff --git a/bin/tweak_iodef b/bin/tweak_iodef index 43e41367e..aa846d67f 100755 --- a/bin/tweak_iodef +++ b/bin/tweak_iodef @@ -25,9 +25,11 @@ trap 'rm -f $temp_file; exit 1' INT TERM EXIT if sed 's@\.\./\(\.\./\)*lfric_atm/metadata@$METADATA@' $iodef |\ sed 's@\.\./\(\.\./\)*metadata@$METADATA@' |\ rose env-cat - >$temp_file + echo "tweak_iodef: editing sucessful in $temp_file" then trap '' INT TERM EXIT cp $temp_file $iodef + echo "tweak_iodef: $iodef saved with changes" else echo "tweak_iodef: editing failed, $iodef unchanged" 1>&2 rm -f $temp_file diff --git a/components/coupling/rose-meta/lfric-coupling/version30_31.py b/components/coupling/rose-meta/lfric-coupling/version30_31.py new file mode 100644 index 000000000..215327534 --- /dev/null +++ b/components/coupling/rose-meta/lfric-coupling/version30_31.py @@ -0,0 +1,45 @@ +import re +import sys + +from metomi.rose.upgrade import MacroUpgrade + +from .version22_30 import * + + +class UpgradeError(Exception): + """Exception created when an upgrade fails.""" + + def __init__(self, msg): + self.msg = msg + + def __repr__(self): + sys.tracebacklimit = 0 + return self.msg + + __str__ = __repr__ + + +""" +Copy this template and complete to add your macro +class vnXX_txxx(MacroUpgrade): + # Upgrade macro for by + BEFORE_TAG = "vnX.X" + AFTER_TAG = "vnX.X_txxx" + def upgrade(self, config, meta_config=None): + # Add settings + return config, self.reports +""" + + +class vn30_t306(MacroUpgrade): + """Upgrade macro for ticket TTTT by Unknown.""" + + BEFORE_TAG = "vn3.0" + AFTER_TAG = "vn3.1" + + def upgrade(self, config, meta_config=None): + # Commands From: rose-meta/lfric-driver + # Blank Upgrade Macro + # Commands From: rose-meta/lfric-coupling + # Blank Upgrade Macro + return config, self.reports diff --git a/components/coupling/rose-meta/lfric-coupling/versions.py b/components/coupling/rose-meta/lfric-coupling/versions.py index 152c043d0..01798ad2b 100644 --- a/components/coupling/rose-meta/lfric-coupling/versions.py +++ b/components/coupling/rose-meta/lfric-coupling/versions.py @@ -1,8 +1,8 @@ import sys -from metomi.rose.upgrade import MacroUpgrade +from metomi.rose.upgrade import MacroUpgrade # noqa: F401 -from .version22_30 import * +from .version30_31 import * class UpgradeError(Exception): diff --git a/components/coupling/rose-meta/lfric-coupling/vn3.1/rose-meta.conf b/components/coupling/rose-meta/lfric-coupling/vn3.1/rose-meta.conf new file mode 100644 index 000000000..b9730e75e --- /dev/null +++ b/components/coupling/rose-meta/lfric-coupling/vn3.1/rose-meta.conf @@ -0,0 +1 @@ +import=lfric-driver/vn3.1 diff --git a/components/driver/rose-meta/lfric-driver/version30_31.py b/components/driver/rose-meta/lfric-driver/version30_31.py new file mode 100644 index 000000000..4979e1876 --- /dev/null +++ b/components/driver/rose-meta/lfric-driver/version30_31.py @@ -0,0 +1,43 @@ +import re +import sys + +from metomi.rose.upgrade import MacroUpgrade + +from .version22_30 import * + + +class UpgradeError(Exception): + """Exception created when an upgrade fails.""" + + def __init__(self, msg): + self.msg = msg + + def __repr__(self): + sys.tracebacklimit = 0 + return self.msg + + __str__ = __repr__ + + +""" +Copy this template and complete to add your macro +class vnXX_txxx(MacroUpgrade): + # Upgrade macro for by + BEFORE_TAG = "vnX.X" + AFTER_TAG = "vnX.X_txxx" + def upgrade(self, config, meta_config=None): + # Add settings + return config, self.reports +""" + + +class vn30_t306(MacroUpgrade): + """Upgrade macro for ticket TTTT by Unknown.""" + + BEFORE_TAG = "vn3.0" + AFTER_TAG = "vn3.1" + + def upgrade(self, config, meta_config=None): + # Commands From: rose-meta/lfric-driver + # Blank Upgrade Macro + return config, self.reports diff --git a/components/driver/rose-meta/lfric-driver/versions.py b/components/driver/rose-meta/lfric-driver/versions.py index 152c043d0..01798ad2b 100644 --- a/components/driver/rose-meta/lfric-driver/versions.py +++ b/components/driver/rose-meta/lfric-driver/versions.py @@ -1,8 +1,8 @@ import sys -from metomi.rose.upgrade import MacroUpgrade +from metomi.rose.upgrade import MacroUpgrade # noqa: F401 -from .version22_30 import * +from .version30_31 import * class UpgradeError(Exception): diff --git a/components/driver/rose-meta/lfric-driver/vn3.1/rose-meta.conf b/components/driver/rose-meta/lfric-driver/vn3.1/rose-meta.conf new file mode 100644 index 000000000..980ecd18b --- /dev/null +++ b/components/driver/rose-meta/lfric-driver/vn3.1/rose-meta.conf @@ -0,0 +1,904 @@ +#============================================================================== +# SYSTEM SETTINGS +#============================================================================== + +[Submission] +ns=namelist/Job/Submission +sort-key=Section-001 + +#============================================================================== +# ENVIRONMENT VARIABLES AVAILABLE TO ROSE TASK +#============================================================================== +[env] +compulsory=true + +[env=EXEC_NAME] +compulsory=true +description=Program executable name +sort-key=Panel-A01 +type=raw + +[env=OMP_NUM_THREADS] +compulsory=true +description=Number of threads for OpenMP +fail-if=this < 1 ; +range=1: +sort-key=Panel-A03 +type=integer + +[env=TOTAL_RANKS] +compulsory=true +description=Number of process ranks for a parallel run job +fail-if=this < 1 ; +range=1: +sort-key=Panel-A02 +type=integer + +[env=XIOS_SERVER_MODE] +compulsory=true +description=Run with XIOS in server mode +sort-key=Panel-A04 +type=python_boolean + +[env=XIOS_SERVER_RANKS] +compulsory=true +description=XIOS server process ranks +fail-if=this < 1 ; +range=1: +sort-key=Panel-A05 +type=integer + +#============================================================================== +# PRIMARY GLOBAL MESH +#============================================================================== +[namelist:base_mesh] +compulsory=true +description=Provides information to define the LFRic infrastructure principle mesh. +help=Lfric must use at least one mesh (prime) to run. + =This panel specifies details of the mesh and its + =configuration. +ns=namelist/Model/Mesh +sort-key=Section-A02 +title=Mesh + +[!namelist:base_mesh=f_lat] +compulsory=false +description=Latitude for F-plane + =approximation [rad]. +expression=namelist:base_mesh=f_lat_deg * source:constants_mod=PI / 180.0_r_def +help=Pre-set latitude for F-plane approximation [Radians]. The F-plane approximation + =is use to calculate the Coriolis operator, where the Coriolis parameter, f, is + =assumed to be invariant with latitude. + = +!kind=default +type=real + +[namelist:base_mesh=f_lat_deg] +compulsory=true +description=?????? +fail-if=this < -90.0 ; + =this > 90.0 ; +help=?????? + =?????? +!kind=default +range=-90.0:90.0 +sort-key=Panel-A06 +type=real + +[namelist:base_mesh=file_prefix] +compulsory=true +description=Location of 2D mesh input file(s) (prefix). +help=Input files for 2D meshes are in NetCDF file format. The mesh topologies in the file should + =be conformant to UGRID convention and must contain at least one mesh topology, the prime mesh. + = + =This variable is the file name (or path) prefix the mesh input file(s). If the meshes have + =been prepartitioned (namelist:base_mesh=prepartitioned = .true.) to match the intended + =distributed memory deployment of the application, each process rank of the run will load + =the mesh file given by: + = + = __.nc + = + =which will contain data to directly populate the required . Otherwise, a + = will be partitioned at runtime and the model will attempt to load: + = + = .nc + = + =Note: Should prepartitioned meshes be employed, the mesh input file(s) should have + = been created specifying the same number of partitions as ranks in the intended + = run. + = +sort-key=Panel-A01 +!string_length=filename +type=character +url=http://ugrid-conventions.github.io/ugrid-conventions + +[namelist:base_mesh=fplane] +compulsory=true +description=?????? +fail-if=this == true and namelist:base_mesh=geometry == "'spherical'" +help=Plane has constant f (omega) + =fplane can not be true when geometry = spherical +!kind=default +sort-key=Panel-A05 +type=logical + +[namelist:base_mesh=geometry] +compulsory=true +description=The geometry on which the domain is embedded +!enumeration=true +fail-if=this == "'spherical'" and namelist:base_mesh=topology == "'fully_periodic'" and namelist:partitioning=partitioner != "'cubedsphere'" and namelist:base_mesh=prepartitioned == ".false." ; + =this == "'planar'" and namelist:partitioning=partitioner != "'planar'" and namelist:base_mesh=prepartitioned == ".false." ; +help=Along with topology this describes the domain. The geometry is the shape + =on which the domain is embedded. This is currently either 'spherical' or + ='planar'. +sort-key=Panel-A03 +value-titles=Planar, Spherical +values='planar', 'spherical' + +[namelist:base_mesh=prepartitioned] +compulsory=true +description=Load pre-partitioned local meshes +help=Input mesh files may contain global meshes whose extents are intended to cover + =the entire model domain. These may require partitioning in to a number of local + =meshes (1 per processor rank) at runtime depending on the number of ranks + =requested to run the model. + = + =Prepartitioned meshes would be beneficial in cases were the number of ranks for + =the model run seldom change. + = + =If prepartitioned meshes are not used the model will expect global meshes + =in the mesh input file to be partitioned at model runtime. + = + =Note: With increasing mesh size, at some point prepartitioned meshes may become + = necessary. + = +sort-key=Panel-A04a +trigger=namelist:partitioning: .false. ; +type=logical + +[namelist:base_mesh=prime_mesh_name] +compulsory=true +description=Tag-name for prime-mesh +help=Mesh topologies are held in UGRID conformant NetCDF files. It is + =possible that the mesh files in this format may contain more than + =one mesh topology. This tag-name identifies the mesh topology to + =use from the mesh file namelist:base_mesh=filename. +sort-key=Panel-A02 +!string_length=default +type=character + +[namelist:base_mesh=topology] +compulsory=true +description=Describes the periodicity of the domain. +!enumeration=true +fail-if=this != "'fully_periodic'" and namelist:partitioning=partitioner == "'cubedsphere'" ; +help=Together with the geometry this describes the domain. The topology is the + =periodicity of the base mesh. A mesh over the whole globe would have + =spherical geometry and fully_periodic topology, while a regional model + =on the sphere would have spherical geometry and non_periodic topology. + =Note that to run a regional model in limited-area mode with lateral boundary + =conditions, namelist:boundaries=limited_area also needs to be set to "true". +sort-key=Panel-A07 +value-titles=Fully-periodic, Non-periodic +values='fully_periodic', 'non_periodic' + +#============================================================================== +# 2D MESH EXTRUSION +#============================================================================== +[namelist:extrusion] +compulsory=true +description=Settings for the selected vertical mesh extrusion method. +help=Settings for the uniform, quadratic, geometric and DCMIP mesh extrusion + =profiles to extrude 2D to 3D mesh using non-dimensional vertical coordinate. +ns=namelist/Model/Mesh/Extrusion +sort-key=Section-A03 + +[namelist:extrusion=domain_height] +compulsory=true +description=Height of domain above the surface [m] +fail-if=this < 0.0 ; +help=Height of the model domain above the surface. + =Surface is 0m for planar domains and planet_radius for spherical. +!kind=default +range=this > 0.0: +sort-key=Panel-A02 +type=real + +[namelist:extrusion=eta_values] +!bounds=namelist:extrusion=number_of_layers-1 +compulsory=true +description=Eta values, excluding 0 and 1 +help=Non-dimensional height values defining the model vertical levels. + =The length should be smaller by number_of_layers by one. + = + =The values must strictly be between 0 and 1: + =0 < eta_values < 1 + =because 0 and 1 are appended to the list automatically. +!kind=default +length=: +range=0.0:1.0 +sort-key=Panel-A04 +type=real + +[namelist:extrusion=method] +compulsory=true +description=Method for generating eta coordinate +!enumeration=true +fail-if=this == 'um_L38_29t_9s_40km' and namelist:extrusion=number_of_layers != 38 ; + =this == 'um_L70_50t_20s_80km' and namelist:extrusion=number_of_layers != 70 ; + =this == 'um_L85_50t_35s_85km' and namelist:extrusion=number_of_layers != 85 ; + =this == 'um_L70_61t_9s_40km' and namelist:extrusion=number_of_layers != 70 ; + =this == 'um_L120_99t_21s_40km' and namelist:extrusion=number_of_layers != 120 ; + =this == 'um_L140_122t_18s_40km' and namelist:extrusion=number_of_layers != 140 ; +help=Available extrusion methods are (\f$n$ is number of layers): + =0) Specified by user; + =1) Uniform eta spacing (\f$\frac{k}{n}\f$); + =2) Quadratic eta spacing (\f$\frac{k}{n}^2\f$); + =3) Geometric eta spacing (\f$d\eta = \frac{(s - 1)}{(s^{n} - 1)}$) + = with stretching factor prescribed (\f$s=1.03$); + =4) DCMIP eta spacing (Ullrich et al. (2012) DCMIP documentation, Appendix F.2.) + = with flattening parameter prescribed. + =5) L38 40km UM specific eta spacing; + =6) L70 80km UM specific eta spacing; + =7) L85 85km UM specific eta spacing; + =8) L70 40km UM specific eta spacing + =9) L120 40km UM specific eta spacing + =10) L140 40km UM specific eta spacing +sort-key=Panel-A01 +trigger=namelist:extrusion=eta_values: 'specified_values'; +value-titles=Specified by user, Uniform, Quadratic, Geometric, DCMIP, + = um_L38_29t_9s_40km, um_L70_50t_20s_80km, um_L85_50t_35s_85km, um_L70_61t_9s_40km, + = um_L120_99t_21s_40km, um_L140_122t_18s_40km +values='specified_values', 'uniform', 'quadratic', 'geometric', 'dcmip', + ='um_L38_29t_9s_40km', 'um_L70_50t_20s_80km', 'um_L85_50t_35s_85km', 'um_L70_61t_9s_40km', + ='um_L120_99t_21s_40km', 'um_L140_122t_18s_40km' + +[namelist:extrusion=number_of_layers] +compulsory=true +description=Number of layers in the vertical +fail-if=this < 1 ; +help=Setting for number of layers of 3D-mesh in vertical. +!kind=default +range=1: +sort-key=Panel-A03 +type=integer + +[namelist:extrusion=planet_radius] +compulsory=true +description=Radius of the planet surface [m] +fail-if=this <= 0.0 ; +help=Radius of domain bottom. Note: Orography not included. +!kind=default +range=this > 0.0: +sort-key=Panel-A02 +type=real + +[namelist:extrusion=stretching_height] +compulsory=false +description=Physical height above which surface altitude does not + = influence layer height +fail-if=this < 0.0 ; +help=Physical height above which surface altitude does not + =influence layer height. + =Note that in order to reproduce the vertical stretching used in + =the UM 'smooth' extrusion, this value should be set to + =the value of eta_rho corresponding to the UM level + =first_constant_r_rho_level and multiplied by domain_height. +!kind=default +range=0: +sort-key=Panel-A02 ;1 +type=real + +[namelist:extrusion=stretching_method] +compulsory=false +description=Method of generating stretching +!enumeration=true +help=Available stretching methods are: + =1) Linear (linear multiple of physical depth) + =2) Smooth (quadratic below stretching_height, linear above) +sort-key=Panel-A01 +trigger=namelist:extrusion=stretching_height: 'smooth' ; +value-titles=Linear, Smooth +values='linear', 'smooth' + +#============================================================================== +# FINITE ELEMENT +#============================================================================== +[namelist:finite_element] +compulsory=true +description=Settings to define the choice of finite elements used +help=Settings to define which finite elements create the function spaces used + =in the model +ns=namelist/Model/Finite element +sort-key=Section-A01 +title=Finite element + +[namelist:finite_element=cellshape] +compulsory=true +description=The base shape of the elements forming the 2d mesh before extrusion + =into prisms in 3d +!enumeration=true +fail-if=this != "'quadrilateral'" ; +help=Current infrastructure requires that the cellshape is 'quadrilateral' +sort-key=Panel-A01 +value-titles=Triangluar, Quadrilateral +values='triangle', 'quadrilateral' + +[namelist:finite_element=coord_order] +compulsory=true +description=Order of the coordinate space. +fail-if=this < 0 ; +help=Order of the coordinate space. If 0 is chosen, this will be the continuous + =W0 space, with the order set by the element order. This option is only + =possible for certain geometries and topologies. Otherwise, this will be + =a discontinuous space. +!kind=default +range=0: +sort-key=Panel-A03 +type=integer + +[namelist:finite_element=coord_system] +compulsory=true +description=The coordinate system that will be stored in the chi coordinate + =fields used for computations throughout the model. +!enumeration=true +fail-if= +help=Select 'xyz' to run the model in global Cartesian coordinates. + =Otherwise use 'native' to run with the coordinate system native to the + =mesh being used. For instance, this will use the (alpha,beta,height) + =system with cubed-sphere meshes and the (longitude,latitude,height) system + =with spherical limited-area models. For the (alpha,beta,height) and + =(longitude,latitude,height) systems, the third coordinate field is given by + =height = radius - planet radius +sort-key=Panel-A04 +value-titles='(X,Y,Z)', 'Native' +values='xyz', 'native' + +[namelist:finite_element=element_order_h] +compulsory=true +description=The polynomial order of the set of compatible finite element in the + =horizontal +fail-if=this < 0 ; +help=This is the polynomial order of the L2 (W3) space in the horizontal + =direction, and is used to set the polynomial order for other finite element + =spaces. In most cases is equal to element_order_v. +!kind=default +range=0:9 +sort-key=Panel-A02 +type=integer + +[namelist:finite_element=element_order_v] +compulsory=true +description=The polynomial order of the set of compatible finite element in the + =vertical +fail-if=this < 0 ; +help=This is the polynomial order of the L2 (W3) space in the vertical + =direction, and is used to set the polynomial order for other finite element + =spaces. In most cases is equal to element_order_h. +!kind=default +range=0:9 +sort-key=Panel-A02 +type=integer + +[!namelist:finite_element=nqp_h_exact] +compulsory=false +expression=namelist:finite_element=element_order_h+3 +help=Number of quadrature points needed to exactly integrate a product of test & + = trial functions with a linear Jacobian in the horizontal direction +!kind=default +sort-key=Panel-A05 +type=integer + +[!namelist:finite_element=nqp_v_exact] +compulsory=false +expression=namelist:finite_element=element_order_v+3 +help=Number of quadrature points needed to exactly integrate a product of test & + = trial functions with a linear Jacobian in the vertical direction +!kind=default +sort-key=Panel-A05 +type=integer + +[namelist:finite_element=rehabilitate] +compulsory=true +description=Option to switch on rehabilitation to modify the mapping for the W3 + =space. +help=Rehabilitation is the modification of mapping for + =the W3 space and the divergence mapping so that + =the correct order of accuracy is maintained on + =non-affine elements. For affine elements it is not + =required. This is included here as in the future + =we wish to move to not rehabilitating +!kind=default +sort-key=Panel-A06 +type=logical + +#============================================================================== +# IO +#============================================================================== +[namelist:io] +compulsory=true +description=Sets I/O options for diagnostic output, checkpointing and dumps +help=?????? +ns=namelist/Job/IO +sort-key=Section-A02 +title=I/O + +[namelist:io=checkpoint_read] +compulsory=true +description=Enable read of a checkpoint file +help=Read the checkpoint file specified by the checkpoint + =stem name (namelist:files=checkpoint_stem_name) + =and start timestep (namelist:time=timestep_start). +!kind=default +ns=namelist/Job/IO/Checkpointing & Restart +sort-key=Panel-A02 +type=logical + +[namelist:io=checkpoint_times] +compulsory=false +description=List of times to output a checkpoint file in seconds +fail-if=this < 1 ; +help=Checkpoint file write times in seconds, must be greater than zero. + =These must also be values corresponding to an integer number of timesteps. +!kind=second +length=: +ns=namelist/Job/IO/Checkpointing & Restart +sort-key=Panel-A04 +type=real + +[namelist:io=checkpoint_write] +compulsory=true +description=Enable write of a checkpoint file +help=Write checkpoint files specified by checkpoint + =stem name (namelist:files=checkpoint_stem_name) +!kind=default +ns=namelist/Job/IO/Checkpointing & Restart +sort-key=Panel-A03 +trigger=namelist:io=checkpoint_times: .true. ; + =namelist:io=end_of_run_checkpoint: .true. ; +type=logical + +[namelist:io=counter_output_suffix] +compulsory=true +description=Suffix appended to the file containing subroutine counter output for a subroutine +help=The output of the subroutine counters will be written to a file with this suffix. + =The default value is "counter.txt". +ns=namelist/Job/IO/System +sort-key=Panel-A04 +!string_length=filename +type=character + +[namelist:io=diagnostic_frequency] +compulsory=true +description=Frequency of diagnostic output [timesteps] +fail-if=this < 1 ; +help=Frequency of diagnostic output [timesteps] +!kind=medium +ns=namelist/Job/IO/Diagnostics +range=1: +sort-key=Panel-A03 +type=integer + +[namelist:io=end_of_run_checkpoint] +compulsory=true +description=Enable checkpointing on the last timestep of the run. +help=This will create a checkpoint file at the end of the run regardless of + =the values in the namelist:io=checkpoint_times list. If a value for the + =final step is also in the namelist:io=checkpoint_times list only a single + =checkpoint file will be created. +!kind=default +ns=namelist/Job/IO/Checkpointing & Restart +sort-key=Panel-A05 +type=logical + +[namelist:io=file_convention] +compulsory=true +description=Enumeration describing the convention of file to be output, either CF or UGRID. +!enumeration=true +help=UGRID: UGRID conventions should be used as default, but are larger files. + =CF: CF option allows for more lightweight output files but with no mesh information. +ns=namelist/Job/IO/File Format +sort-key=Panel-A00 +value-titles=UGRID, CF +values='UGRID','CF' + +[namelist:io=nodal_output_on_w3] +compulsory=true +description=Enable projection of fields to + =W3 for nodal diagnostic output +help=This option creates diagnostic output of fields on W3 in addition to their native function spaces. + =It only applies to the old nodal style ouput. i.e. if write_diag is .true. and use_xios_io is .false. +!kind=default +ns=namelist/Job/IO/Diagnostics +sort-key=Panel-A04 +type=logical + +[namelist:io=subroutine_counters] +compulsory=true +description=Enable output of subroutine counters +help=Writes out subroutine counters to test file +!kind=default +ns=namelist/Job/IO/System +sort-key=Panel-A03 +type=logical + +[namelist:io=subroutine_timers] +compulsory=true +description=Enable output of subroutine runtimes +help=Writes out subroutine run times to text file +!kind=default +ns=namelist/Job/IO/System +sort-key=Panel-A02 +type=logical + +[namelist:io=timer_output_path] +compulsory=true +description=Relative to the file containing the subroutine timer output +help=The output of the subroutine timers will be written to this file path (relative to the model + = working directory). The default value is "timer.txt" +ns=namelist/Job/IO/System +sort-key=Panel-A02 +!string_length=filename +type=character + +[namelist:io=use_xios_io] +compulsory=true +description=Use XIOS for all I/O + =(where there is a choice of methods) +help=Currently we still have some legacy I/O methods for diagnostic output + =and checkpointing. This option forces use of XIOS. +!kind=default +ns=namelist/Job/IO/Diagnostics +sort-key=Panel-A06 +trigger=namelist:io=nodal_output_on_w3: .false. ; + =env=XIOS_SERVER_MODE: .true. ; + =env=XIOS_SERVER_RANKS: .true. ; +type=logical + +[namelist:io=write_diag] +compulsory=true +description=Enable diagnostic output +help=Writes diagnostic output to file at the specified diagnostic frequency +!kind=default +ns=namelist/Job/IO/Diagnostics +sort-key=Panel-A01 +type=logical + +#============================================================================== +# SYSTEM LOGGING +#============================================================================== +[namelist:logging] +compulsory=true +ns=namelist/Job/IO/System + +[namelist:logging=log_to_rank_zero_only] +compulsory=true +description=Only log to a single rank, defined as rank zero +ns=namelist/Job/IO/System +sort-key=Panel-A02 +type=logical + +[namelist:logging=run_log_level] +compulsory=true +description=Logging level for run +!enumeration=true +help=Determines the severity of logging messages which are sent to standard + =output. Error levels are cumulative in severity: + = + = * Trace + = * Debugging + = * Information + = * Warning + = * Error + = + =e.g. Setting the log level to "Information" will mean log messages + =related to information,warnings and errors will be reported to + =standard output at runtime. + = +ns=namelist/Job/IO/System +sort-key=Panel-A01 +value-titles=Error, Warning, Information, Debugging, Trace +values='error','warning','info','debug','trace' + +#================= +# Multigrid Mesh = +#================= +#============================================================================== +# MULTIGRID +#============================================================================== +[namelist:multigrid] +compulsory=true +description=?????? +help=?????? + =?????? +ns=namelist/Science/Dynamics/multigrid +sort-key=Section-A06 +title=Multi-grid + +[namelist:multigrid=chain_mesh_tags] +!bounds=namelist:multigrid=multigrid_chain_nitems +compulsory=true +description=Meshes for function space chain. +fail-if=len(this) != namelist:multigrid=multigrid_chain_nitems ; +help=This is an ordered list of mesh names as loaded from the mesh + =input file. It is expected that the mesh input file will contain + =the correct intergrid maps betwen subsequent meshes in the chain. + = +length=: +sort-key=Panel-A04 +!string_length=default +type=character + +[namelist:multigrid=multigrid_chain_nitems] +compulsory=true +description=Number of items in multigrid function space chain +fail-if=this < 1 ; +help=?????? + =?????? +!kind=default +range=1: +sort-key=Panel-A02 +type=integer + +[namelist:multigrid=n_coarsesmooth] +compulsory=false +type=integer + +[namelist:multigrid=n_postsmooth] +compulsory=false +type=integer + +[namelist:multigrid=n_presmooth] +compulsory=false +type=integer + +[namelist:multigrid=smooth_relaxation] +compulsory=false +type=real + +#============================================================================== +# GLOBAL MESH PARTITIONING +#============================================================================== +[namelist:partitioning] +compulsory=true +description=Global mesh panel partitioning. +help=For parallel computing, the 2D global mesh is divided up into partitions. + =Each process rank runs an instance of the model on one partition. The + =partition decompostion is specified on a `per panel` basis. + =i.e. The cubedsphere has six panels; the planar mesh has one panel. +ns=namelist/Model/Mesh/Partitioning +sort-key=Section-A02 + +[namelist:partitioning=coarsen_multigrid_tiles] +compulsory=false +description=Reduce x and y tile sizes by a factor of 2 in each multigrid level +help=Enables using larger tiles at higher resolution levels by automatically + =reducing tile sizes in coarser levels, which can improve performance. +sort-key=Panel-A10 +type=logical + +[namelist:partitioning=generate_inner_halos] +compulsory=true +description=Generate inner halo regions +help=In order to overlap comms & compute, the owned cells are reordered + =so that they consist of a number of layers of inner halos. These owned + =cells correspond to the halo cells on neighbouring MPI regions. +sort-key=Panel-A05 +type=logical + +[namelist:partitioning=inner_halo_tiles] +compulsory=false +description=Tile inner halos separately from partition interior. +help=Tiling inner halos separately from the partition interior guarantees + =that tiles never cross the boundary between interior and inner halo, + =which can be useful when overlapping communication and computation. +sort-key=Panel-A08 +type=logical + +[namelist:partitioning=max_tiled_multigrid_level] +compulsory=false +description=Coarsest multigrid level to be tiled +help=Revert to 1x1 tiling (equivalent to colouring) for multigrid levels + =above this threshold (level 1 has highest resolution); tiling is + =typically more beneficial for higher resolutions. +range=1: +sort-key=Panel-A09 +type=integer + +[namelist:partitioning=panel_decomposition] +compulsory=true +description=Panel partition decomposition +!enumeration=true +help=Partitioner will attempt to generate partitioned panels based + =on the given enumeration choices: + = + = * auto: Decompose domain as close to square decompositions. + = * row: Single row of partitions. + = * column: Single column of partitions. + = * custom: x/y decompositions explicitly requested using + = namelist:partitioning=panel_xproc, + = namelist:partitioning=panel_yproc. + = * auto_nonuniform: As auto but allow columns of partitions + = of differing heights. + = * guided_nonuniform: Partition into columns according to + = namelist:partitioning=panel_xproc but of different heights + = +!kind=default +sort-key=Panel-A01 +trigger=namelist:partitioning=panel_xproc: this == "'custom'" or this == "'guided_nonuniform'" ; + =namelist:partitioning=panel_yproc: this == "'custom'" ; +value-titles=Auto, Single row, Single column, Custom, Auto nonuniform, Guided nonuniform +values='auto', 'row', 'column', 'custom', 'auto_nonuniform', 'guided_nonuniform' + +[namelist:partitioning=panel_xproc] +compulsory=true +description=Panel partitions in x-direction +fail-if=this < 1 ; + =(env=TOTAL_RANKS == 1) and (this != 1) ; + =(env=TOTAL_RANKS != 1) and (namelist:base_mesh=geometry=="'spherical'") and ( this*namelist:partitioning=panel_yproc != env=TOTAL_RANKS/6 ) ; + =(env=TOTAL_RANKS != 1) and (namelist:base_mesh=geometry=="'planar'") and ( this*namelist:partitioning=panel_yproc != env=TOTAL_RANKS ) ; +help=Number of partitions to generate across the x-direction of a panel of the mesh +!kind=default +range=1: +sort-key=Panel-A02 +type=integer + +[namelist:partitioning=panel_yproc] +compulsory=true +description=Panel partitions in y-direction +fail-if=this < 1 ; + =(env=TOTAL_RANKS == 1) and (this != 1) ; + =(env=TOTAL_RANKS != 1) and (namelist:base_mesh=geometry=="'spherical'") and ( this*namelist:partitioning=panel_xproc != env=TOTAL_RANKS/6 ) ; + =(env=TOTAL_RANKS != 1) and (namelist:base_mesh=geometry=="'planar'") and ( this*namelist:partitioning=panel_xproc != env=TOTAL_RANKS ) ; +help=Number of partitions to generate across the y-direction of a panel of the mesh +!kind=default +range=1: +sort-key=Panel-A03 +type=integer + +[namelist:partitioning=partitioner] +compulsory=true +description=?????? +!enumeration=true +fail-if=this == "'cubedsphere'" and not ( namelist:base_mesh=geometry == "'spherical'" and namelist:base_mesh=topology == "'fully_periodic'" ); + =this == "'cubedsphere'" and not ( env=TOTAL_RANKS % 6 == 0 or env=TOTAL_RANKS == 1 ) ; +help=This should match the mesh being used. For planar domains or LAMs on the + =sphere the partitioner should be set to "'planar'". +sort-key=Panel-A04 +value-titles=Planar, Cubedsphere +values='planar', 'cubedsphere' + +[namelist:partitioning=tile_size_x] +compulsory=false +description=Tile size (number of cells) in x-direction +help=Tiling reorders computation of cells in the horizontal mesh to maximise + =processor cache reuse. It is currently only available for partitioned + =meshes and where mesh partitions have a rectangular shape. Tiles sizes + =along partition borders are automatically adjusted to fit, but sizes that + =are larger than partition dimensions are not accepted. +range=1: +sort-key=Panel-A06 +type=integer + +[namelist:partitioning=tile_size_y] +compulsory=false +description=Tile size (number of cells) in y-direction +help=Tiling reorders computation of cells in the horizontal mesh to maximise + =processor cache reuse. It is currently only available for partitioned + =meshes and where mesh partitions have a rectangular shape. Tiles sizes + =along partition borders are automatically adjusted to fit, but sizes that + =are larger than partition dimensions are not accepted. +range=1: +sort-key=Panel-A07 +type=integer + +#============================================================================== +# PLANET +#============================================================================== +[namelist:planet] +compulsory=true +description=?????? +help=?????? + =?????? +ns=namelist/Model/Planet +sort-key=Section-A03 + +[!namelist:planet=scaled_radius] +compulsory=false +expression=namelist:extrusion=planet_radius / namelist:planet=scaling_factor +help=?????? + =?????? +!kind=default +type=real + +[namelist:planet=scaling_factor] +compulsory=true +description=?????? +help=?????? + =?????? +!kind=default +sort-key=Panel-A07 +type=real + +#============================================================================== +# TIME CONTROL +#============================================================================== +[namelist:time] +compulsory=true +description=Time options +help=At the moment, this just sets the start and end timestep for the run +ns=namelist/Job/Time +sort-key=Section-A01 +title=Time Control + +[namelist:time=calendar] +compulsory=true +description=How to interpret date/time provided by humans +!enumeration=true +sort-key=Panel-A00 +values='timestep' + +[namelist:time=calendar_origin] +compulsory=true +description=Calendar date of time origin +help=Format yyyy-mm-dd hh:mm:ss +sort-key=Panel-A01 +type=character + +[namelist:time=calendar_start] +compulsory=true +description=Calendar date of first timestep +help=Format yyyy-mm-dd hh:mm:ss +sort-key=Panel-A02 +type=character + +[namelist:time=calendar_type] +compulsory=true +description=Type of calendar to use +!enumeration=true +help=gregorian: Gregorian calendar + =d360: 360 day calendar with 12 30-day months +sort-key=Panel-A03 +value-titles=Gregorian, D360 +values='gregorian', 'd360' + +[namelist:time=timestep_end] +compulsory=true +description=Last timestep in run +sort-key=Panel-A04 +type=character + +[namelist:time=timestep_start] +compulsory=true +description=First timestep in run +sort-key=Panel-A05 +type=character + +#============================================================================== +# TIMESTEPPING +#============================================================================== +[namelist:timestepping] +compulsory=true +description=?????? +help=?????? + =?????? +ns=namelist/Job/Timestepping +sort-key=Section-A03 + +[namelist:timestepping=dt] +compulsory=true +description=?????? +fail-if=this < 0.0 ; +help=Timestep in seconds +!kind=second +range=0.0: +sort-key=Panel-A02 +type=real + +[namelist:timestepping=spinup_period] +compulsory=true +description=?????? +help=>=0 time in seconds for the spin up period +!kind=second +sort-key=Panel-A10 +type=real diff --git a/components/driver/source/driver_config_mod.f90 b/components/driver/source/driver_config_mod.f90 index e66683954..2a15bd28a 100644 --- a/components/driver/source/driver_config_mod.f90 +++ b/components/driver/source/driver_config_mod.f90 @@ -5,9 +5,11 @@ !----------------------------------------------------------------------------- module driver_config_mod - use configuration_mod, only: ensure_configuration, & - final_configuration, & - read_configuration + use config_mod, only: config_type + use config_loader_mod, only: ensure_configuration, & + final_configuration, & + read_configuration + use namelist_collection_mod, only: namelist_collection_type use log_mod, only: log_event, & log_level_debug, & @@ -22,14 +24,15 @@ module driver_config_mod contains subroutine init_config( filename, required_namelists, & - configuration ) + configuration, config ) implicit none character(*), intent(in) :: filename character(*), intent(in) :: required_namelists(:) - type(namelist_collection_type), intent(inout) :: configuration + type(namelist_collection_type), optional, intent(inout) :: configuration + type(config_type), optional, intent(inout) :: config logical, allocatable :: success_map(:) logical :: success @@ -40,9 +43,27 @@ subroutine init_config( filename, required_namelists, & call log_event( 'Loading configuration ...', & log_level_debug ) - call read_configuration( filename, configuration ) + if (present(config) .and. present(configuration)) then + ! TODO Transistion, remove once old configuration access removed + call read_configuration( filename, & + configuration=configuration, & + config=config ) + else if (.not. present(config) .and. present(configuration)) then + ! TODO Deprecated, remove once old configuration access removed + call read_configuration( filename, & + configuration=configuration ) + else if (present(config) .and. .not. present(configuration)) then + call read_configuration( filename, & + config=config ) + else + write(log_scratch_space,'(A)') & + 'At least one optional argument must be provided for '//& + 'init_config.' + call log_event(log_scratch_space, log_level_error) + end if success = ensure_configuration( required_namelists, success_map ) + if (.not. success) then write( log_scratch_space, & '("The following required namelists were not loaded:")' ) diff --git a/components/driver/source/driver_fem_mod.f90 b/components/driver/source/driver_fem_mod.f90 index 715786011..7ba02690e 100644 --- a/components/driver/source/driver_fem_mod.f90 +++ b/components/driver/source/driver_fem_mod.f90 @@ -37,6 +37,8 @@ module driver_fem_mod use mesh_mod, only: mesh_type use mesh_collection_mod, only: mesh_collection_type + use base_mesh_config_mod, only: geometry, topology + implicit none private @@ -78,7 +80,8 @@ subroutine init_fem( mesh_collection, chi_inventory, panel_id_inventory ) ! ======================================================================== ! ! Initialise coordinate transformations - call init_chi_transforms(mesh_collection) + call init_chi_transforms( geometry, topology, & + mesh_collection=mesh_collection ) ! To loop through mesh collection, get all mesh names ! Then get mesh from collection using these names diff --git a/components/driver/source/driver_io_mod.F90 b/components/driver/source/driver_io_mod.F90 index aa28de1b3..294cac940 100644 --- a/components/driver/source/driver_io_mod.F90 +++ b/components/driver/source/driver_io_mod.F90 @@ -202,12 +202,8 @@ subroutine init_xios_io_context( context_name, & integer(i_def) :: num_meshes, i, j type(namelist_type), pointer :: io_nml - logical :: subroutine_timers io_nml => modeldb%configuration%get_namelist('io') - call io_nml%get_value( 'subroutine_timers', subroutine_timers ) - - subroutine_timers = .false. mesh => null() chi => null() @@ -230,7 +226,6 @@ subroutine init_xios_io_context( context_name, & file_list => io_context%get_filelist() call populate_filelist(file_list, modeldb) end if - call io_context%set_timer_flag(subroutine_timers) ! =============================== ! Check that a mesh exists diff --git a/components/driver/source/driver_mesh_mod.f90 b/components/driver/source/driver_mesh_mod.f90 index 37452a28a..74d2d2af0 100644 --- a/components/driver/source/driver_mesh_mod.f90 +++ b/components/driver/source/driver_mesh_mod.f90 @@ -80,7 +80,12 @@ module driver_mesh_mod !> @param[in] total_ranks Total number of MPI ranks in this job. !> @param[in] mesh_names Mesh names to load from the mesh input file(s). !> @param[in] extrusion Extrusion object to be applied to meshes. -!> @param[in] stencil_depth Required stencil depth for the application. +!> @param[in] stencil_depths_in Required stencil depth for each mesh for +!! the application. If this array is of size 1 then +!! the single value is applied to all meshes. +!! Otherwise the array size must match the size +!! the mesh name array, allowing different depths +!! to be specified for different meshes. !> @param[in] check_partitions Apply check for even partitions with the !> configured partition stratedy. !> (unpartitioned mesh input only) @@ -90,7 +95,7 @@ module driver_mesh_mod subroutine init_mesh( configuration, & local_rank, total_ranks, & mesh_names, extrusion, & - stencil_depth, & + stencil_depths_in, & check_partitions, & alt_names ) @@ -104,7 +109,7 @@ subroutine init_mesh( configuration, & character(str_def), intent(in) :: mesh_names(:) class(extrusion_type), intent(in) :: extrusion - integer(i_def), intent(in) :: stencil_depth + integer(i_def), intent(in) :: stencil_depths_in(:) logical(l_def), intent(in) :: check_partitions character(str_def), optional, intent(in) :: alt_names(:) @@ -132,12 +137,13 @@ subroutine init_mesh( configuration, & character(str_def), allocatable :: names(:) character(str_def), allocatable :: tmp_mesh_names(:) character(str_max_filename) :: input_mesh_file + integer(i_def), allocatable :: stencil_depths(:) procedure(partitioner_interface), pointer :: partitioner_ptr class(panel_decomposition_type), allocatable :: decomposition - integer(i_def) :: n_digit + integer(i_def) :: i, n_digit character(str_def) :: fmt_str, number_str !============================================================================ @@ -160,13 +166,33 @@ subroutine init_mesh( configuration, & !============================================================================ ! 0.1 Some basic checks !============================================================================ - ! Set up stencil depth - if (stencil_depth < 0_i_def) then - write(log_scratch_space,'(A)') & - 'Standard partitioned meshes must support a not -ve stencil_depth' + + if ( size(stencil_depths_in) == 1 ) then + ! Single stencil depth specified, apply to all meshes + allocate( stencil_depths( size(mesh_names) ) ) + do i = 1, size(mesh_names) + stencil_depths(i) = stencil_depths_in(1) + end do + else if ( size(stencil_depths_in) == size(mesh_names) ) then + ! Stencil depths specified per mesh + allocate( stencil_depths( size(mesh_names) ) ) + stencil_depths = stencil_depths_in + else + write(log_scratch_space, '(A)') & + 'Number of stencil depths specified does not '// & + 'match number of requested meshes.' call log_event(log_scratch_space, LOG_LEVEL_ERROR) end if + ! Check stencil depths are valid + do i = 1, size(stencil_depths) + if (stencil_depths(i) < 0_i_def) then + write(log_scratch_space,'(A)') & + 'Standard partitioned meshes must support a not -ve stencil_depth' + call log_event(log_scratch_space, LOG_LEVEL_ERROR) + end if + end do + ! Currently only quad elements are fully functional if (cellshape /= CELLSHAPE_QUADRILATERAL) then call log_event( "Reference_element must be QUAD for now...", & @@ -240,8 +266,8 @@ subroutine init_mesh( configuration, & ! meshes are suitable for the supplied application ! configuration. !=========================================================== - call check_local_mesh( configuration, & - stencil_depth, & + call check_local_mesh( configuration, & + stencil_depths, & mesh_names ) ! 2.1c Load and assign mesh maps. @@ -300,7 +326,7 @@ subroutine init_mesh( configuration, & call create_local_mesh( mesh_names, & local_rank, total_ranks, & decomposition, & - stencil_depth, & + stencil_depths, & generate_inner_halos, & partitioner_ptr ) @@ -328,6 +354,8 @@ subroutine init_mesh( configuration, & !============================================================================ call assign_mesh_maps(mesh_names) + deallocate(stencil_depths) + end subroutine init_mesh end module driver_mesh_mod diff --git a/components/driver/source/driver_modeldb_mod.f90 b/components/driver/source/driver_modeldb_mod.f90 index 793ed4cbc..d26db8254 100644 --- a/components/driver/source/driver_modeldb_mod.f90 +++ b/components/driver/source/driver_modeldb_mod.f90 @@ -18,6 +18,7 @@ module driver_modeldb_mod use lfric_mpi_mod, only: lfric_mpi_type use model_clock_mod, only: model_clock_type use namelist_collection_mod, only: namelist_collection_type + use config_mod, only: config_type use io_context_collection_mod, only: io_context_collection_type implicit none @@ -33,6 +34,8 @@ module driver_modeldb_mod !> Configuration namelist collection type(namelist_collection_type), public :: configuration + type(config_type), public :: config + !> Stores all the fields used by the model type( model_data_type ), public :: fields diff --git a/components/driver/source/driver_timer_mod.f90 b/components/driver/source/driver_timer_mod.f90 deleted file mode 100644 index a78498117..000000000 --- a/components/driver/source/driver_timer_mod.f90 +++ /dev/null @@ -1,66 +0,0 @@ -!----------------------------------------------------------------------------- -! (c) Crown copyright 2023 Met Office. All rights reserved. -! The file LICENCE, distributed with this code, contains details of the terms -! under which the code may be used. -!----------------------------------------------------------------------------- -!> Lifecycle management of the simple timer profiling system. -!> -module driver_timer_mod - - use io_config_mod, only : subroutine_timers, & - timer_output_path - use timer_mod, only : timer, output_timer, init_timer - - implicit none - - private - public :: init_timers, final_timers - -contains - - !> Initialises timers from namelists. - !> - !> As well as initialising the system a "top level" timer is started - !> which will give the time between initialisation and finalisation of - !> the timer system. - !> - !> @param[in] identifier Top level timer name. - !> - subroutine init_timers( identifier ) - - implicit none - - character(*), intent(in) :: identifier - - if (subroutine_timers) then - call init_timer( timer_output_path ) - call timer( identifier ) - end if - - end subroutine init_timers - - !> Shuts down timers. - !> - !> The identifier specified when shutting down should be the same as the one - !> given on initialisation. There is a chance to mismatch the identifiers - !> which will cause problems but it avoids the use of a global variable. - !> - !> @todo Reconsider the existance of the simple timer system once the - !> profiler is integrated. - !> - !> @param[in] identifier Top level timer name. - !> - subroutine final_timers( identifier ) - - implicit none - - character(*), intent(in) :: identifier - - if (subroutine_timers) then - call timer( identifier ) - call output_timer() - end if - - end subroutine final_timers - -end module driver_timer_mod diff --git a/components/driver/source/mesh/check_local_mesh_mod.f90 b/components/driver/source/mesh/check_local_mesh_mod.f90 index fc9bd8ed3..72cede6a5 100644 --- a/components/driver/source/mesh/check_local_mesh_mod.f90 +++ b/components/driver/source/mesh/check_local_mesh_mod.f90 @@ -31,19 +31,19 @@ module check_local_mesh_mod !> @brief Basic validation that local meshes are suitable !! for the specified configuration. -!> @param[in] configuration Configuration object. -!> @param[in] stencil_depth Stencil depth that local meshes -!> need to support. -!> @param[in] mesh_names Local meshes held in application -!! local mesh collection object. -subroutine check_local_mesh( configuration, & - stencil_depth, & +!> @param[in] configuration Configuration object. +!> @param[in] stencil_depths Stencil depths that each local mesh +!> needs to support. +!> @param[in] mesh_names Local meshes held in application +!! local mesh collection object. +subroutine check_local_mesh( configuration, & + stencil_depths, & mesh_names ) implicit none type(namelist_collection_type), intent(in) :: configuration - integer(i_def), intent(in) :: stencil_depth + integer(i_def), intent(in) :: stencil_depths(:) character(str_def), intent(in) :: mesh_names(:) integer(i_def) :: topology @@ -120,10 +120,10 @@ subroutine check_local_mesh( configuration, & !===================================== max_stencil_depth = local_mesh%get_max_stencil_depth() - if ( max_stencil_depth < stencil_depth ) then + if ( max_stencil_depth < stencil_depths(i) ) then write(log_scratch_space,'(2(A,I0),A)') & 'Insufficient stencil depth, configuration requires ', & - stencil_depth, '. Mesh "'//trim(mesh_names(i))// & + stencil_depths(i), '. Mesh "'//trim(mesh_names(i))// & '" supports a maximum stencil depth of ', & max_stencil_depth, '.' call log_event(log_scratch_space, log_level_error) diff --git a/components/driver/source/mesh/create_mesh_mod.f90 b/components/driver/source/mesh/create_mesh_mod.f90 index acc22822e..a91e6d5fb 100644 --- a/components/driver/source/mesh/create_mesh_mod.f90 +++ b/components/driver/source/mesh/create_mesh_mod.f90 @@ -58,7 +58,7 @@ module create_mesh_mod !> @brief Creates vertical mesh extrusion. !> @return Resulting extrusion object function create_extrusion( extrusion_method, & - domain_height, & + domain_height, & domain_bottom, & n_layers, & extrusion_id ) result(new) diff --git a/components/driver/source/mesh/runtime_partition_mod.f90 b/components/driver/source/mesh/runtime_partition_mod.f90 index 34cd14101..eec3ae86e 100644 --- a/components/driver/source/mesh/runtime_partition_mod.f90 +++ b/components/driver/source/mesh/runtime_partition_mod.f90 @@ -15,8 +15,6 @@ module runtime_partition_mod log_level_error, & log_level_debug use local_mesh_mod, only: local_mesh_type - use namelist_collection_mod, only: namelist_collection_type - use namelist_mod, only: namelist_type use ncdf_quad_mod, only: ncdf_quad_type use partition_mod, only: partition_type, & partitioner_interface, & @@ -78,15 +76,15 @@ subroutine get_partition_strategy( mesh_selection, total_ranks, partitioner_ptr call log_event( "Using serial cubed sphere partitioner", & log_level_debug ) - else if (mod(total_ranks,6) == 0) then + else if (mod(total_ranks,3) == 0 .or. mod(total_ranks,2) == 0) then ! Paralled run job partitioner_ptr => partitioner_cubedsphere call log_event( "Using parallel cubed sphere partitioner", & log_level_debug ) else - call log_event( "Total number of processors must be 1 (serial) "// & - "or a multiple of 6 for a cubed-sphere domain.", & + call log_event( "Total number of processors must be 1 (serial) "// & + "or a multiple of 2 or 3 for a cubed-sphere domain.", & log_level_error ) end if @@ -113,13 +111,13 @@ end subroutine get_partition_strategy !> and method !> @param[in] generate_inner_halos Generate inner halo regions !! to overlap comms & compute -!> @param[in] stencil_depth Depth of cells outside the base cell -!! of stencil. +!> @param[in] stencil_depths Depth of cells outside the base cell +!! of stencil for each mesh. !> @param[in] partitioner_ptr Mesh partitioning strategy subroutine create_local_mesh( mesh_names, & local_rank, total_ranks, & decomposition, & - stencil_depth, & + stencil_depths, & generate_inner_halos, & partitioner_ptr ) @@ -131,7 +129,7 @@ subroutine create_local_mesh( mesh_names, & integer(i_def), intent(in) :: local_rank integer(i_def), intent(in) :: total_ranks - integer(i_def), intent(in) :: stencil_depth + integer(i_def), intent(in) :: stencil_depths(:) logical(l_def), intent(in) :: generate_inner_halos @@ -154,7 +152,7 @@ subroutine create_local_mesh( mesh_names, & partition = partition_type( global_mesh_ptr, & partitioner_ptr, & decomposition, & - stencil_depth, & + stencil_depths(i), & generate_inner_halos, & local_rank, & total_ranks, & diff --git a/components/driver/unit-test/assign_coordinate_alphabetaz_mod_test.pf b/components/driver/unit-test/assign_coordinate_alphabetaz_mod_test.pf index afa3ffb42..2928f43ca 100644 --- a/components/driver/unit-test/assign_coordinate_alphabetaz_mod_test.pf +++ b/components/driver/unit-test/assign_coordinate_alphabetaz_mod_test.pf @@ -47,7 +47,7 @@ contains @after subroutine tear_down() - use configuration_mod, only : final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/driver/unit-test/assign_coordinate_lonlatz_mod_test.pf b/components/driver/unit-test/assign_coordinate_lonlatz_mod_test.pf index ac835f039..175ba7ce2 100644 --- a/components/driver/unit-test/assign_coordinate_lonlatz_mod_test.pf +++ b/components/driver/unit-test/assign_coordinate_lonlatz_mod_test.pf @@ -46,7 +46,7 @@ contains @after subroutine tear_down() - use configuration_mod, only : final_configuration + use config_loader_mod, only : final_configuration implicit none diff --git a/components/driver/unit-test/assign_coordinate_xyz_mod_test.pf b/components/driver/unit-test/assign_coordinate_xyz_mod_test.pf index 8cf102568..8ad3613f9 100644 --- a/components/driver/unit-test/assign_coordinate_xyz_mod_test.pf +++ b/components/driver/unit-test/assign_coordinate_xyz_mod_test.pf @@ -59,7 +59,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only : final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/inventory/rose-meta/lfric-inventory/version30_31.py b/components/inventory/rose-meta/lfric-inventory/version30_31.py new file mode 100644 index 000000000..e4e7ef5e6 --- /dev/null +++ b/components/inventory/rose-meta/lfric-inventory/version30_31.py @@ -0,0 +1,45 @@ +import re +import sys + +from metomi.rose.upgrade import MacroUpgrade + +from .version22_30 import * + + +class UpgradeError(Exception): + """Exception created when an upgrade fails.""" + + def __init__(self, msg): + self.msg = msg + + def __repr__(self): + sys.tracebacklimit = 0 + return self.msg + + __str__ = __repr__ + + +""" +Copy this template and complete to add your macro +class vnXX_txxx(MacroUpgrade): + # Upgrade macro for by + BEFORE_TAG = "vnX.X" + AFTER_TAG = "vnX.X_txxx" + def upgrade(self, config, meta_config=None): + # Add settings + return config, self.reports +""" + + +class vn30_t306(MacroUpgrade): + """Upgrade macro for ticket TTTT by Unknown.""" + + BEFORE_TAG = "vn3.0" + AFTER_TAG = "vn3.1" + + def upgrade(self, config, meta_config=None): + # Commands From: rose-meta/lfric-driver + # Blank Upgrade Macro + # Commands From: rose-meta/lfric-inventory + # Blank Upgrade Macro + return config, self.reports diff --git a/components/inventory/rose-meta/lfric-inventory/versions.py b/components/inventory/rose-meta/lfric-inventory/versions.py index 152c043d0..01798ad2b 100644 --- a/components/inventory/rose-meta/lfric-inventory/versions.py +++ b/components/inventory/rose-meta/lfric-inventory/versions.py @@ -1,8 +1,8 @@ import sys -from metomi.rose.upgrade import MacroUpgrade +from metomi.rose.upgrade import MacroUpgrade # noqa: F401 -from .version22_30 import * +from .version30_31 import * class UpgradeError(Exception): diff --git a/components/inventory/rose-meta/lfric-inventory/vn3.1/rose-meta.conf b/components/inventory/rose-meta/lfric-inventory/vn3.1/rose-meta.conf new file mode 100644 index 000000000..b9730e75e --- /dev/null +++ b/components/inventory/rose-meta/lfric-inventory/vn3.1/rose-meta.conf @@ -0,0 +1 @@ +import=lfric-driver/vn3.1 diff --git a/components/lfric-xios/build/testframework/xiostest.py b/components/lfric-xios/build/testframework/xiostest.py index fddbc1791..575a4afbc 100644 --- a/components/lfric-xios/build/testframework/xiostest.py +++ b/components/lfric-xios/build/testframework/xiostest.py @@ -4,11 +4,12 @@ # The file LICENCE, distributed with this code, contains details of the terms # under which the code may be used. ############################################################################## +from pathlib import Path import os import subprocess -from pathlib import Path import sys -from typing import List +import shutil +from typing import List, Optional from testframework import MpiTest import xarray as xr @@ -20,53 +21,90 @@ class LFRicXiosTest(MpiTest): Base for LFRic-XIOS integration tests. """ - def __init__(self, command=sys.argv[1], processes=1): + def __init__(self, command=sys.argv[1], processes:int=1, iodef_file: Optional[Path]="iodef.xml"): + + self.iodef_file = Path(iodef_file) + super().__init__(command, processes) + self.xios_out: List[XiosOutput] = [] self.xios_err: List[XiosOutput] = [] + # Setup test working directory + self.test_top_level = Path(os.getcwd()) + self.resources_dir = self.test_top_level / "resources" + self.test_working_dir = self.test_top_level / "working" / type(self).__name__ + self.test_working_dir.mkdir(parents=True, exist_ok=True) + + # Create symlink to test executable in working directory + executable = self.test_working_dir / command[0].split('/')[-1] + if not executable.exists(): + command_path = Path(command[0]) + executable.symlink_to(command_path) + + # Change to test working directory + os.chdir(self.test_working_dir) + + def gen_data(self, source: Path, dest: Path): """ - Create input data files from CDL formatted text. + Create input data files from CDL formatted text. Looks for source file + in resources/data directory and generates dest file in test working directory. """ - proc = subprocess.Popen( - ['ncgen', '-k', 'nc4', '-o', f'{dest}', f'{source}'], + dest_path = Path(self.test_working_dir) / dest + source_path = Path(self.resources_dir, 'data') / source + dest_path.unlink(missing_ok=True) + + proc = subprocess.run( + ['ncgen', '-k', 'nc4', '-o', f'{dest_path}', f'{source_path }'], stdout=subprocess.PIPE, stderr=subprocess.PIPE, ) - _, err = proc.communicate() if proc.returncode != 0: - raise Exception("Test data generation failed:\n" + f"{err}") - + raise Exception("Test data generation failed:\n" + f"{proc.stderr}") + + def gen_config(self, config_source: Path, config_out: Path, new_config: dict): """ - Create an LFRic configuration namelist. + Create an LFRic configuration namelist. Looks for source file + in resources/configs directory and generates dest file in test working directory. """ - config_in = open(config_source, 'r') - config = config_in.readlines() + filename = Path(self.resources_dir, 'configs', config_source) + config = filename.read_text().splitlines() for key in new_config.keys(): for i in range(len(config)): if key in config[i]: - config[i] = f" {key}={new_config[key]}\n" - config_in.close() + if type(new_config[key]) == str: + config[i] = f" {key}='{new_config[key]}'\n" + else: + config[i] = f" {key}={new_config[key]}\n" + + Path(self.test_working_dir, config_out).write_text('\n'.join(config) + '\n') + + + def performTest(self): + """ + Removes any old log files and runs the executable. + """ + + # Handle iodef file + self.iodef_file.unlink(missing_ok=True) + shutil.copy(self.resources_dir / self.iodef_file, self.test_working_dir / "iodef.xml") + + return super().performTest() - f = open(config_out, "w") - for line in config: - f.write(line) - f.close() def nc_kgo_check(self, output: Path, kgo: Path): """ Compare output files with nccmp. """ - proc = subprocess.Popen( + proc = subprocess.run( ['nccmp', '-Fdm', '--exclude=Mesh2d', '--tolerance=0.000001', f'{output}', f'{kgo}'], stdout=subprocess.PIPE, stderr=subprocess.PIPE, ) - _, err = proc.communicate() - return proc.returncode, err + return proc.returncode, proc.stderr def nc_data_match(self, in_file: Path, out_file: Path, varname: str): """ @@ -92,8 +130,11 @@ def post_execution(self, return_code): """ for proc in range(self._processes): - self.xios_out.append(XiosOutput(f"xios_client_{proc}.out")) - self.xios_err.append(XiosOutput(f"xios_client_{proc}.err")) + self.xios_out.append(XiosOutput(self.test_working_dir / f"xios_client_{proc}.out")) + self.xios_err.append(XiosOutput(self.test_working_dir / f"xios_client_{proc}.err")) + + # Return to top level directory + os.chdir(self.test_top_level) class XiosOutput: @@ -102,7 +143,7 @@ class XiosOutput: """ def __init__(self, filename): - self.path: Path = Path(os.getcwd()) / Path(filename) + self.path: Path = Path(filename) with open(self.path, "rt") as handle: self.contents = handle.read() diff --git a/components/lfric-xios/integration-test/lfric_xios_context_test.py b/components/lfric-xios/integration-test/lfric_xios_context_test.py index 32a504db0..a7424d577 100755 --- a/components/lfric-xios/integration-test/lfric_xios_context_test.py +++ b/components/lfric-xios/integration-test/lfric_xios_context_test.py @@ -20,7 +20,8 @@ class LfricXiosContextTest(LFRicXiosTest): """ def __init__(self): - super().__init__(command=[sys.argv[1], "resources/configs/context.nml"], processes=1) + super().__init__(command=[sys.argv[1], "context.nml"], processes=1) + self.gen_config( "context.nml", "context.nml", {} ) def test(self, returncode: int, out: str, err: str): """ diff --git a/components/lfric-xios/integration-test/lfric_xios_temporal_iodef_test.f90 b/components/lfric-xios/integration-test/lfric_xios_temporal_iodef_test.f90 new file mode 100644 index 000000000..a2b8cac79 --- /dev/null +++ b/components/lfric-xios/integration-test/lfric_xios_temporal_iodef_test.f90 @@ -0,0 +1,86 @@ +!----------------------------------------------------------------------------- +! (C) Crown copyright 2025 Met Office. All rights reserved. +! The file LICENCE, distributed with this code, contains details of the terms +! under which the code may be used. +!----------------------------------------------------------------------------- + +! Tests the LFRic-XIOS temporal reading functionality using iodef file configuration. +! Correct behaviour is to read only the minimal required time-entries from +! input file at the correct times. The validity of the data written from this +! test is checked against the input data in the python part of the test. +program lfric_xios_temporal_iodef_test + + use constants_mod, only: r_def + use event_mod, only: event_action + use event_actor_mod, only: event_actor_type + use field_mod, only: field_type, field_proxy_type + use file_mod, only: FILE_MODE_READ, FILE_MODE_WRITE + use io_context_mod, only: callback_clock_arg + use lfric_xios_action_mod, only: advance + use lfric_xios_context_mod, only: lfric_xios_context_type + use lfric_xios_driver_mod, only: lfric_xios_initialise, lfric_xios_finalise + use lfric_xios_file_mod, only: lfric_xios_file_type, OPERATION_TIMESERIES + use linked_list_mod, only: linked_list_type + use log_mod, only: log_event, log_level_info + use test_db_mod, only: test_db_type + + implicit none + + type(test_db_type) :: test_db + type(lfric_xios_context_type), target, allocatable :: io_context + + procedure(callback_clock_arg), pointer :: before_close + type(linked_list_type), pointer :: file_list + class(event_actor_type), pointer :: context_actor + procedure(event_action), pointer :: context_advance + type(field_type), pointer :: rfield + type(field_proxy_type) :: rproxy + + call test_db%initialise() + call lfric_xios_initialise( "test", test_db%comm, .false. ) + + ! =============================== Start test ================================ + + allocate(io_context) + call io_context%initialise( "test_io_context", 1, 10 ) + + file_list => io_context%get_filelist() + call file_list%insert_item( lfric_xios_file_type( "lfric_xios_temporal_input", & + xios_id="lfric_xios_temporal_input", & + io_mode=FILE_MODE_READ, & + operation=OPERATION_TIMESERIES, & + fields_in_file=test_db%temporal_fields ) ) + call file_list%insert_item( lfric_xios_file_type( "lfric_xios_temporal_output", & + xios_id="lfric_xios_temporal_output", & + io_mode=FILE_MODE_WRITE, & + operation=OPERATION_TIMESERIES, & + freq=1, & + fields_in_file=test_db%temporal_fields ) ) + + before_close => null() + call io_context%initialise_xios_context( test_db%comm, & + test_db%chi, test_db%panel_id, & + test_db%clock, test_db%calendar, & + before_close ) + + + context_advance => advance + context_actor => io_context + call test_db%clock%add_event( context_advance, context_actor ) + call io_context%set_active(.true.) + + do while (test_db%clock%tick()) + call test_db%temporal_fields%get_field("temporal_field", rfield) + rproxy = rfield%get_proxy() + call log_event("Valid data for this TS:", log_level_info) + print*,rproxy%data(1) + end do + + deallocate(io_context) + + ! ============================== Finish test ================================= + + call lfric_xios_finalise() + call test_db%finalise() + +end program lfric_xios_temporal_iodef_test diff --git a/components/lfric-xios/integration-test/lfric_xios_temporal_iodef_test.py b/components/lfric-xios/integration-test/lfric_xios_temporal_iodef_test.py new file mode 100755 index 000000000..2b6eaa737 --- /dev/null +++ b/components/lfric-xios/integration-test/lfric_xios_temporal_iodef_test.py @@ -0,0 +1,113 @@ +#!/usr/bin/env python3 +############################################################################## +# (C) Crown copyright 2025 Met Office. All rights reserved. +# The file LICENCE, distributed with this code, contains details of the terms +# under which the code may be used. +############################################################################## +""" +A set of tests which exercise the temporal reading functionality provided by +the LFRic-XIOS component. For these tests the file is configured mainly via +the iodef.xml file, rather than the fortran API. +The tests cover the reading of a piece of non-cyclic temporal data with data +points ranging from 15:01 to 15:10 in 10 1-minute intervals. The model start +time is changed to change how the model interacts with the data. +""" +from testframework import TestEngine, TestFailed +from xiostest import LFRicXiosTest +from pathlib import Path +import sys + +############################################################################### +class LfricXiosFullNonCyclicIodefTest(LFRicXiosTest): # pylint: disable=too-few-public-methods + """ + Tests the LFRic-XIOS temporal reading functionality for a full set of non-cyclic data + """ + + def __init__(self): + super().__init__(command=[sys.argv[1], "non_cyclic_full.nml"], processes=1, iodef_file="iodef_temporal.xml") + self.gen_data('temporal_data.cdl', 'lfric_xios_temporal_input.nc') + self.gen_config( "non_cyclic_base.nml", "non_cyclic_full.nml", {} ) + + def test(self, returncode: int, out: str, err: str): + """ + Test the output of the context test + """ + + if returncode != 0: + print(out) + raise TestFailed(f"Unexpected failure of test executable: {returncode}\n" + + f"stderr:\n" + + f"{err}") + if not self.nc_data_match(Path(self.test_working_dir, 'lfric_xios_temporal_input.nc'), + Path(self.test_working_dir, 'lfric_xios_temporal_output.nc'), + 'temporal_field'): + raise TestFailed("Output data does not match input data for same time values") + + return "Reading full set of non-cylic data okay..." + + +class LfricXiosFullNonCyclicIodefHighFreqTest(LFRicXiosTest): # pylint: disable=too-few-public-methods + """ + Tests the LFRic-XIOS temporal reading functionality for a full set of + non-cyclic data at higher model frequency + """ + + def __init__(self): + super().__init__(command=[sys.argv[1], "non_cyclic_full.nml"], processes=1, iodef_file="iodef_temporal.xml") + self.gen_data('temporal_data.cdl', 'lfric_xios_temporal_input.nc') + self.gen_config( "non_cyclic_base.nml", "non_cyclic_full.nml", {"dt": 10.0, + "timestep_end": '60'} ) + + def test(self, returncode: int, out: str, err: str): + """ + Test the output of the context test + """ + + if returncode != 0: + print(out) + raise TestFailed(f"Unexpected failure of test executable: {returncode}\n" + + f"stderr:\n" + + f"{err}") + if not self.nc_data_match(Path(self.test_working_dir, 'lfric_xios_temporal_input.nc'), + Path(self.test_working_dir, 'lfric_xios_temporal_output.nc'), + 'temporal_field'): + raise TestFailed("Output data does not match input data for same time values") + + return "Reading full set of non-cylic data okay..." + + +class LfricXiosFullNonCyclicIodefNoFreqTest(LFRicXiosTest): # pylint: disable=too-few-public-methods + """ + Tests the error handling for the case where there is no frequency set in either + the iodef or the fortran configuration. + """ + + def __init__(self): + super().__init__(command=[sys.argv[1], "non_cyclic_full.nml"], processes=1) + self.gen_data('temporal_data.cdl', 'lfric_xios_temporal_input.nc') + self.gen_config( "non_cyclic_base.nml", "non_cyclic_full.nml", {} ) + + def test(self, returncode: int, out: str, err: str): + """ + Test the output of the context test + """ + + expected_xios_errs = ['In file "type_impl.hpp", function "void xios::CType::_checkEmpty() const [with T = xios::CDuration]", line 210 -> Data is not initialized', + 'In file "type_impl.hpp", function "void xios::CType::_checkEmpty() const [T = xios::CDuration]", line 210 -> Data is not initialized'] + + if returncode == 134: + if self.xios_err[0].contents.strip() in expected_xios_errs: + return "Expected failure of test executable due to missing frequency setting." + else: + raise TestFailed("Test executable failed, but with unexpected error message.") + elif returncode == 0: + raise TestFailed("Test executable succeeded unexpectedly despite missing frequency setting.") + else: + raise TestFailed("Test executable failed with unexpected return code.") + + +############################################################################## +if __name__ == "__main__": + TestEngine.run(LfricXiosFullNonCyclicIodefTest()) + TestEngine.run(LfricXiosFullNonCyclicIodefHighFreqTest()) + TestEngine.run(LfricXiosFullNonCyclicIodefNoFreqTest()) \ No newline at end of file diff --git a/components/lfric-xios/integration-test/lfric_xios_temporal_test.py b/components/lfric-xios/integration-test/lfric_xios_temporal_test.py index 21bb48e1d..361913de4 100755 --- a/components/lfric-xios/integration-test/lfric_xios_temporal_test.py +++ b/components/lfric-xios/integration-test/lfric_xios_temporal_test.py @@ -23,12 +23,9 @@ class LfricXiosFullNonCyclicTest(LFRicXiosTest): # pylint: disable=too-few-publ """ def __init__(self): - super().__init__(command=[sys.argv[1], "resources/configs/non_cyclic_full.nml"], processes=1) - test_data_dir = Path(Path.cwd(), 'resources/data') - Path('lfric_xios_temporal_input.nc').unlink(missing_ok=True) - self.gen_data(Path(test_data_dir, 'temporal_data.cdl'), Path('lfric_xios_temporal_input.nc')) - self.gen_config( Path("resources/configs/non_cyclic_base.nml"), - Path("resources/configs/non_cyclic_full.nml"), {} ) + super().__init__(command=[sys.argv[1], "non_cyclic_full.nml"], processes=1) + self.gen_data('temporal_data.cdl', 'lfric_xios_temporal_input.nc') + self.gen_config( "non_cyclic_base.nml", "non_cyclic_full.nml", {} ) def test(self, returncode: int, out: str, err: str): """ @@ -37,11 +34,11 @@ def test(self, returncode: int, out: str, err: str): if returncode != 0: print(out) - raise TestFailed(f"Unexpected failure of test executable: {returncode}\n" + + raise TestFailed(f"Unexpected failure of test executable: {returncode}\n" + f"stderr:\n" + f"{err}") - if not self.nc_data_match(Path('lfric_xios_temporal_input.nc'), - Path('lfric_xios_temporal_output.nc'), + if not self.nc_data_match(Path(self.test_working_dir, 'lfric_xios_temporal_input.nc'), + Path(self.test_working_dir, 'lfric_xios_temporal_output.nc'), 'temporal_field'): raise TestFailed("Output data does not match input data for same time values") @@ -55,13 +52,9 @@ class LfricXiosNonCyclicHighFreqTest(LFRicXiosTest): # pylint: disable=too-few- """ def __init__(self): - super().__init__(command=[sys.argv[1], "resources/configs/non_cyclic_high_freq.nml"], processes=1) - test_data_dir = Path(Path.cwd(), 'resources/data') - Path('lfric_xios_temporal_input.nc').unlink(missing_ok=True) - self.gen_data(Path(test_data_dir, 'temporal_data.cdl'), Path('lfric_xios_temporal_input.nc')) - self.gen_config( Path("resources/configs/non_cyclic_base.nml"), - Path("resources/configs/non_cyclic_high_freq.nml"), - {"dt":"10.0"} ) + super().__init__(command=[sys.argv[1], "non_cyclic_high_freq.nml"], processes=1) + self.gen_data('temporal_data.cdl', 'lfric_xios_temporal_input.nc') + self.gen_config( "non_cyclic_base.nml", "non_cyclic_high_freq.nml", {"dt":10.0} ) def test(self, returncode: int, out: str, err: str): """ @@ -70,11 +63,11 @@ def test(self, returncode: int, out: str, err: str): if returncode != 0: print(out) - raise TestFailed(f"Unexpected failure of test executable: {returncode}\n" + + raise TestFailed(f"Unexpected failure of test executable: {returncode}\n" + f"stderr:\n" + f"{err}") - if not self.nc_data_match(Path('lfric_xios_temporal_input.nc'), - Path('lfric_xios_temporal_output.nc'), + if not self.nc_data_match(Path(self.test_working_dir, 'lfric_xios_temporal_input.nc'), + Path(self.test_working_dir, 'lfric_xios_temporal_output.nc'), 'temporal_field'): raise TestFailed("Output data does not match input data for same time values") @@ -88,13 +81,9 @@ class LfricXiosPartialNonCyclicTest(LFRicXiosTest): # pylint: disable=too-few-p """ def __init__(self): - super().__init__(command=[sys.argv[1], "resources/configs/non_cyclic_mid.nml"], processes=1) - test_data_dir = Path(Path.cwd(), 'resources/data') - Path('lfric_xios_temporal_input.nc').unlink(missing_ok=True) - self.gen_data(Path(test_data_dir, 'temporal_data.cdl'), Path('lfric_xios_temporal_input.nc')) - self.gen_config( Path("resources/configs/non_cyclic_base.nml"), - Path("resources/configs/non_cyclic_mid.nml"), - {'calendar_start':"'2024-01-01 15:01:00'"} ) + super().__init__(command=[sys.argv[1], "non_cyclic_mid.nml"], processes=1) + self.gen_data('temporal_data.cdl', 'lfric_xios_temporal_input.nc') + self.gen_config( "non_cyclic_base.nml", "non_cyclic_mid.nml", {'calendar_start':'2024-01-01 15:01:00'} ) def test(self, returncode: int, out: str, err: str): """ @@ -102,12 +91,12 @@ def test(self, returncode: int, out: str, err: str): """ if returncode != 0: - raise TestFailed(f"Unexpected failure of test executable: {returncode}\n" + + raise TestFailed(f"Unexpected failure of test executable: {returncode}\n" + f"stderr:\n" + f"{err}") - if not self.nc_data_match(Path('lfric_xios_temporal_input.nc'), - Path('lfric_xios_temporal_output.nc'), + if not self.nc_data_match(Path(self.test_working_dir, 'lfric_xios_temporal_input.nc'), + Path(self.test_working_dir, 'lfric_xios_temporal_output.nc'), 'temporal_field'): raise TestFailed("Output data does not match input data for same time values") @@ -120,14 +109,10 @@ class LfricXiosNonCyclicFutureTest(LFRicXiosTest): # pylint: disable=too-few-pu """ def __init__(self): - super().__init__(command=[sys.argv[1], "resources/configs/non_cyclic_future.nml"], processes=1) - test_data_dir = Path(Path.cwd(), 'resources/data') - Path('lfric_xios_temporal_input.nc').unlink(missing_ok=True) - self.gen_data(Path(test_data_dir, 'temporal_data.cdl'), Path('lfric_xios_temporal_input.nc')) - self.gen_config( Path("resources/configs/non_cyclic_base.nml"), - Path("resources/configs/non_cyclic_future.nml"), - {'calendar_start':"'2024-01-01 10:00:00'", - 'calendar_origin':"'2024-01-01 10:00:00'"} ) + super().__init__(command=[sys.argv[1], "non_cyclic_future.nml"], processes=1) + self.gen_data('temporal_data.cdl', 'lfric_xios_temporal_input.nc') + self.gen_config( "non_cyclic_base.nml", "non_cyclic_future.nml", {'calendar_start':'2024-01-01 10:00:00', + 'calendar_origin':'2024-01-01 10:00:00'} ) def test(self, returncode: int, out: str, err: str): """ @@ -153,14 +138,10 @@ class LfricXiosNonCyclicPastTest(LFRicXiosTest): # pylint: disable=too-few-publ """ def __init__(self): - super().__init__(command=[sys.argv[1], "resources/configs/non_cyclic_past.nml"], processes=1) - test_data_dir = Path(Path.cwd(), 'resources/data') - Path('lfric_xios_temporal_input.nc').unlink(missing_ok=True) - self.gen_data(Path(test_data_dir, 'temporal_data.cdl'), Path('lfric_xios_temporal_input.nc')) - self.gen_config( Path("resources/configs/non_cyclic_base.nml"), - Path("resources/configs/non_cyclic_past.nml"), - {'calendar_start':"'2024-02-01 10:00:00'", - 'calendar_origin':"'2024-02-01 10:00:00'"} ) + super().__init__(command=[sys.argv[1], "non_cyclic_past.nml"], processes=1) + self.gen_data('temporal_data.cdl', 'lfric_xios_temporal_input.nc') + self.gen_config( "non_cyclic_base.nml", "non_cyclic_past.nml", {'calendar_start':'2024-02-01 10:00:00', + 'calendar_origin':'2024-02-01 10:00:00'} ) def test(self, returncode: int, out: str, err: str): """ @@ -180,12 +161,10 @@ def test(self, returncode: int, out: str, err: str): return "Expected error for past non-cyclic data reading..." - - ############################################################################## if __name__ == "__main__": TestEngine.run(LfricXiosFullNonCyclicTest()) TestEngine.run(LfricXiosNonCyclicHighFreqTest()) TestEngine.run(LfricXiosPartialNonCyclicTest()) TestEngine.run(LfricXiosNonCyclicFutureTest()) - TestEngine.run(LfricXiosNonCyclicPastTest()) + TestEngine.run(LfricXiosNonCyclicPastTest()) \ No newline at end of file diff --git a/components/lfric-xios/integration-test/lfric_xios_time_read_test.f90 b/components/lfric-xios/integration-test/lfric_xios_time_read_test.f90 index 0e500544a..c26d1c577 100755 --- a/components/lfric-xios/integration-test/lfric_xios_time_read_test.f90 +++ b/components/lfric-xios/integration-test/lfric_xios_time_read_test.f90 @@ -47,7 +47,7 @@ program lfric_xios_time_read_test xios_date(2024, 1, 1, 15, 8, 0), & xios_date(2024, 1, 1, 15, 9, 0), & xios_date(2024, 1, 1, 15, 10, 0) ] - result = read_time_data("lfric_xios_temporal_input") + result = read_time_data("lfric_xios_time_read_data") do t = 1, size(result) if (result(t) /= check(t)) then diff --git a/components/lfric-xios/integration-test/lfric_xios_time_read_test.py b/components/lfric-xios/integration-test/lfric_xios_time_read_test.py index d8b963f9b..a20a90b73 100755 --- a/components/lfric-xios/integration-test/lfric_xios_time_read_test.py +++ b/components/lfric-xios/integration-test/lfric_xios_time_read_test.py @@ -10,7 +10,6 @@ """ from testframework import TestEngine, TestFailed from xiostest import LFRicXiosTest -import subprocess import sys from pathlib import Path @@ -22,10 +21,9 @@ class LfricXiosTimeReadTest(LFRicXiosTest): # pylint: disable=too-few-public-me """ def __init__(self, nprocs: int): - super().__init__(command=[sys.argv[1], "resources/configs/context.nml"], processes=nprocs) - test_data_dir = Path(Path.cwd(), 'resources/data') - Path('lfric_xios_time_read_data.nc').unlink(missing_ok=True) - self.gen_data(Path(test_data_dir, 'temporal_data.cdl'), Path('lfric_xios_time_read_data.nc')) + super().__init__(command=[sys.argv[1], "context.nml"], processes=nprocs) + self.gen_data('temporal_data.cdl', 'lfric_xios_time_read_data.nc') + self.gen_config( "context.nml", "context.nml", {} ) self.nprocs = nprocs def test(self, returncode: int, out: str, err: str): diff --git a/components/lfric-xios/integration-test/iodef.xml b/components/lfric-xios/integration-test/resources/iodef.xml similarity index 100% rename from components/lfric-xios/integration-test/iodef.xml rename to components/lfric-xios/integration-test/resources/iodef.xml diff --git a/components/lfric-xios/integration-test/resources/iodef_temporal.xml b/components/lfric-xios/integration-test/resources/iodef_temporal.xml new file mode 100644 index 000000000..d2e310a29 --- /dev/null +++ b/components/lfric-xios/integration-test/resources/iodef_temporal.xml @@ -0,0 +1,30 @@ + + + + + + + + + + + + + + + + + performance + 1.0 + + + + true + 50 + true + + + + + diff --git a/components/lfric-xios/integration-test/test_db_mod.f90 b/components/lfric-xios/integration-test/test_db_mod.f90 index c5682f810..028dc97cb 100644 --- a/components/lfric-xios/integration-test/test_db_mod.f90 +++ b/components/lfric-xios/integration-test/test_db_mod.f90 @@ -8,9 +8,10 @@ module test_db_mod use calendar_mod, only: calendar_type - use cli_mod, only: get_initial_filename - use configuration_mod, only: read_configuration - use constants_mod, only: i_def, r_def, str_def, imdi, r_second, i_timestep + use cli_mod, only: parse_command_line + use config_loader_mod, only: read_configuration + use constants_mod, only: i_def, r_def, str_def, imdi, & + r_second, i_timestep use extrusion_mod, only: TWOD use field_collection_mod, only: field_collection_type use field_parent_mod, only: read_interface, write_interface @@ -30,8 +31,7 @@ module test_db_mod finalise_logging, & log_set_level, log_event, & LOG_LEVEL_TRACE, LOG_LEVEL_ERROR - use namelist_collection_mod, only: namelist_collection_type - use namelist_mod, only: namelist_type + use config_mod, only: config_type use lfric_xios_read_mod, only: read_field_generic use lfric_xios_write_mod, only: write_field_generic use local_mesh_collection_mod, only: local_mesh_collection_type, & @@ -44,16 +44,15 @@ module test_db_mod use fs_continuity_mod, only: Wchi, W0, W2H, W3 use step_calendar_mod, only: step_calendar_type - implicit none !> Object containing infrastructure for testing LFRic-XIOS type, public :: test_db_type private - type(lfric_comm_type), public :: comm - type(namelist_collection_type), public :: config - type(field_type), public :: chi(3) - type(field_type), public :: panel_id + type(lfric_comm_type), public :: comm + type(config_type), public :: config + type(field_type), public :: chi(3) + type(field_type), public :: panel_id type(model_clock_type), public, allocatable :: clock class(calendar_type), public, allocatable :: calendar type(field_collection_type), public :: temporal_fields @@ -77,8 +76,6 @@ subroutine initialise(self) type(mesh_type), target :: mesh, twod_mesh type(mesh_type), pointer :: mesh_ptr type(mesh_type), pointer :: twod_mesh_ptr - type(namelist_type), pointer :: time_nml - type(namelist_type), pointer :: timestepping_nml type(function_space_type), pointer :: wchi_fs type(function_space_type), pointer :: tmp_fs type(field_proxy_type) :: chi_p(3), pid_p, rproxy @@ -103,6 +100,8 @@ subroutine initialise(self) real(r_second) :: timestep_length + call parse_command_line( filename ) + ! Initialise MPI & logging call create_comm(self%comm) call global_mpi%initialise(self%comm) @@ -110,17 +109,15 @@ subroutine initialise(self) call initialise_logging(self%comm%get_comm_mpi_val(), 'lfric_xios_context_test') call log_set_level(LOG_LEVEL_TRACE) - call self%config%initialise("lfric_xios_integration_tests", table_len=10) - call get_initial_filename(filename) - call read_configuration(trim(adjustl(filename)), self%config) + call self%config%initialise("lfric_xios_integration_tests") + call read_configuration(trim(adjustl(filename)), config=self%config) + deallocate(filename) - time_nml => self%config%get_namelist('time') - timestepping_nml => self%config%get_namelist('timestepping') - call time_nml%get_value('calendar_start', start_date) - call time_nml%get_value('timestep_start', timestep_start) - call time_nml%get_value('timestep_end', timestep_end) - call timestepping_nml%get_value('dt', timestep_length) + start_date = self%config%time%calendar_start() + timestep_start = self%config%time%timestep_start() + timestep_end = self%config%time%timestep_end() + timestep_length = self%config%timestepping%dt() ! Create top level mesh collection, function spaces & routing tables local_mesh_collection = local_mesh_collection_type() @@ -226,7 +223,6 @@ subroutine initialise(self) nullify(local_mesh_ptr) nullify(mesh_ptr) - nullify(time_nml) nullify(twod_mesh_ptr) nullify(wchi_fs) nullify(tmp_fs) diff --git a/components/lfric-xios/rose-meta/lfric-xios/version30_31.py b/components/lfric-xios/rose-meta/lfric-xios/version30_31.py new file mode 100644 index 000000000..b2b22888b --- /dev/null +++ b/components/lfric-xios/rose-meta/lfric-xios/version30_31.py @@ -0,0 +1,45 @@ +import re +import sys + +from metomi.rose.upgrade import MacroUpgrade + +from .version22_30 import * + + +class UpgradeError(Exception): + """Exception created when an upgrade fails.""" + + def __init__(self, msg): + self.msg = msg + + def __repr__(self): + sys.tracebacklimit = 0 + return self.msg + + __str__ = __repr__ + + +""" +Copy this template and complete to add your macro +class vnXX_txxx(MacroUpgrade): + # Upgrade macro for by + BEFORE_TAG = "vnX.X" + AFTER_TAG = "vnX.X_txxx" + def upgrade(self, config, meta_config=None): + # Add settings + return config, self.reports +""" + + +class vn30_t306(MacroUpgrade): + """Upgrade macro for ticket TTTT by Unknown.""" + + BEFORE_TAG = "vn3.0" + AFTER_TAG = "vn3.1" + + def upgrade(self, config, meta_config=None): + # Commands From: rose-meta/lfric-driver + # Blank Upgrade Macro + # Commands From: rose-meta/lfric-xios + # Blank Upgrade Macro + return config, self.reports diff --git a/components/lfric-xios/rose-meta/lfric-xios/versions.py b/components/lfric-xios/rose-meta/lfric-xios/versions.py index 152c043d0..01798ad2b 100644 --- a/components/lfric-xios/rose-meta/lfric-xios/versions.py +++ b/components/lfric-xios/rose-meta/lfric-xios/versions.py @@ -1,8 +1,8 @@ import sys -from metomi.rose.upgrade import MacroUpgrade +from metomi.rose.upgrade import MacroUpgrade # noqa: F401 -from .version22_30 import * +from .version30_31 import * class UpgradeError(Exception): diff --git a/components/lfric-xios/rose-meta/lfric-xios/vn3.1/rose-meta.conf b/components/lfric-xios/rose-meta/lfric-xios/vn3.1/rose-meta.conf new file mode 100644 index 000000000..b9730e75e --- /dev/null +++ b/components/lfric-xios/rose-meta/lfric-xios/vn3.1/rose-meta.conf @@ -0,0 +1 @@ +import=lfric-driver/vn3.1 diff --git a/components/lfric-xios/source/lfric_xios_action_mod.f90 b/components/lfric-xios/source/lfric_xios_action_mod.f90 index 5dbc1083a..91cdce8ab 100644 --- a/components/lfric-xios/source/lfric_xios_action_mod.f90 +++ b/components/lfric-xios/source/lfric_xios_action_mod.f90 @@ -6,6 +6,7 @@ module lfric_xios_action_mod use constants_mod, only : str_def + use timing_mod, only : start_timing, stop_timing, tik, LPROF implicit none @@ -36,7 +37,6 @@ subroutine advance(context, model_clock) !> is old enough to not have xios_get_current_context forwarded through the !> xios module. use icontext, only : xios_get_current_context - use timer_mod, only : timer use xios, only : xios_context, & xios_set_current_context, & xios_update_calendar @@ -50,6 +50,7 @@ subroutine advance(context, model_clock) type(lfric_xios_file_type), pointer :: file => null() type(xios_context) :: xios_context_handle type(linked_list_type), pointer :: filelist + integer(tik) :: timing_id ! Get the handle of the current context (Not necessarily the one passed to this routine). ! This is used to reset the context on return. @@ -76,9 +77,9 @@ subroutine advance(context, model_clock) end if ! Update XIOS calendar - if (context%get_timer_flag()) call timer('xios_update_calendar') + if ( LPROF ) call start_timing( timing_id, 'xios.update_calendar' ) call xios_update_calendar( model_clock%get_step() - model_clock%get_first_step() + 1 ) - if (context%get_timer_flag()) call timer('xios_update_calendar') + if ( LPROF ) call stop_timing( timing_id, 'xios.update_calendar' ) ! Read all files that need to be read from filelist => context%get_filelist() @@ -126,7 +127,6 @@ subroutine advance_read_only(context, model_clock) !> is old enough to not have xios_get_current_context forwarded through the !> xios module. use icontext, only : xios_get_current_context - use timer_mod, only : timer use xios, only : xios_context, & xios_date, & xios_set_current_context, & @@ -143,6 +143,7 @@ subroutine advance_read_only(context, model_clock) type(lfric_xios_file_type), pointer :: file => null() type(xios_context) :: xios_context_handle type(linked_list_type), pointer :: filelist + integer(tik) :: timing_id ! Get the handle of the current context (Not necessarily the one passed to this routine). ! This is used to reset the context on return. @@ -153,10 +154,9 @@ subroutine advance_read_only(context, model_clock) call context%set_current() call context%tick_context_clock() ! Update XIOS calendar - if (context%get_timer_flag()) call timer('xios_update_calendar') - + if ( LPROF ) call start_timing( timing_id, 'xios.update_calendar' ) call xios_update_calendar( context%get_context_clock_step() ) - if (context%get_timer_flag()) call timer('xios_update_calendar') + if ( LPROF ) call stop_timing( timing_id, 'xios.update_calendar' ) ! Read all files that need to be read from filelist => context%get_filelist() diff --git a/components/lfric-xios/source/lfric_xios_context_mod.f90 b/components/lfric-xios/source/lfric_xios_context_mod.f90 index 7f3d0e429..9f951767d 100644 --- a/components/lfric-xios/source/lfric_xios_context_mod.f90 +++ b/components/lfric-xios/source/lfric_xios_context_mod.f90 @@ -25,7 +25,8 @@ module lfric_xios_context_mod use lfric_xios_file_mod, only : lfric_xios_file_type use linked_list_mod, only : linked_list_type, linked_list_item_type use model_clock_mod, only : model_clock_type - use timer_mod, only : timer + use timing_mod, only : start_timing, stop_timing, & + tik, LPROF use xios, only : xios_context, & xios_context_initialize, & xios_close_context_definition, & @@ -56,8 +57,6 @@ module lfric_xios_context_mod procedure, public :: initialise_xios_context procedure, public :: get_filelist procedure, public :: set_current - procedure, public :: set_timer_flag - procedure, public :: get_timer_flag procedure, public :: tick_context_clock procedure, public :: get_context_clock_step procedure, public :: finalise_xios_context @@ -115,10 +114,12 @@ subroutine initialise_xios_context( this, communicator, & type(linked_list_item_type), pointer :: loop => null() type(lfric_xios_file_type), pointer :: file => null() logical :: zero_start + integer(tik) :: timing_idlx, timing_idxc write(log_scratch_space, "(A)") & "Initialising XIOS context: " // this%get_context_name() call log_event(log_scratch_space, log_level_debug) + if ( LPROF ) call start_timing(timing_idlx, 'lfric_xios.init_context') if (present(start_at_zero)) then zero_start = start_at_zero @@ -138,9 +139,14 @@ subroutine initialise_xios_context( this, communicator, & if (associated(before_close)) call before_close(model_clock) - ! Close the context definition - no more I/O operations can be defined - ! after this point + ! Close the context definition - no more I/O configuration operations + ! can be defined after this point + if ( LPROF ) call start_timing(timing_idxc, 'xios.close_context_definition') + call log_event('XIOS context definition closing', log_level_debug) call xios_close_context_definition() + if ( LPROF ) call stop_timing(timing_idxc, 'xios.close_context_definition') + call log_event('XIOS context definition closed', log_level_debug) + this%xios_context_initialised = .true. ! Read all files that need to be read from @@ -155,6 +161,7 @@ subroutine initialise_xios_context( this, communicator, & loop => loop%next end do end if + if ( LPROF ) call stop_timing(timing_idlx, 'lfric_xios.init_context') end subroutine initialise_xios_context @@ -176,7 +183,9 @@ subroutine finalise_xios_context( this ) type(linked_list_item_type), pointer :: loop => null() type(lfric_xios_file_type), pointer :: file => null() + integer(tik) :: timing_idlx, timing_idxc + if ( LPROF ) call start_timing(timing_idlx, 'lfric_xios.finalise_context') if (this%xios_context_initialised) then ! Perform final write if (this%filelist%get_length() > 0) then @@ -195,7 +204,9 @@ subroutine finalise_xios_context( this ) ! will be closed. write(log_scratch_space, "(A)") "Finalising XIOS context: " // this%get_context_name() call log_event(log_scratch_space, log_level_debug) + if ( LPROF ) call start_timing(timing_idxc, 'xios.context_finalize') call xios_context_finalize() + if ( LPROF ) call stop_timing(timing_idxc, 'xios.context_finalize') ! We have closed the context on our end, but we need to make sure that XIOS ! has closed the files for all servers before we process them. @@ -217,6 +228,7 @@ subroutine finalise_xios_context( this ) end if nullify(loop) nullify(file) + if ( LPROF ) call stop_timing(timing_idlx, 'lfric_xios.finalise_context') end subroutine finalise_xios_context @@ -247,38 +259,6 @@ subroutine set_current( this ) end subroutine set_current - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !> Tells I/O context whether to use subroutine timers - !> - !> @param[in] timer_flag - !> - subroutine set_timer_flag( this, timer_flag ) - - implicit none - - class(lfric_xios_context_type), target, intent(inout) :: this - logical, intent(in) :: timer_flag - - this%uses_timer = timer_flag - - end subroutine set_timer_flag - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !> Returns whether the IO context uses timers - !> - !> @return timer_flag - !> - function get_timer_flag(this) result(timer_flag) - - implicit none - - class(lfric_xios_context_type), target, intent(in) :: this - logical :: timer_flag - - timer_flag = this%uses_timer - - end function get_timer_flag - subroutine tick_context_clock(this) implicit none class(lfric_xios_context_type), intent(inout) :: this diff --git a/components/lfric-xios/source/lfric_xios_field_mod.f90 b/components/lfric-xios/source/lfric_xios_field_mod.f90 index e49a5aae8..c24946a60 100644 --- a/components/lfric-xios/source/lfric_xios_field_mod.f90 +++ b/components/lfric-xios/source/lfric_xios_field_mod.f90 @@ -112,11 +112,12 @@ end function lfric_xios_field_constructor !> Registers a representation of the model field with the associated XIOS field !> group -subroutine register(self) +subroutine register(self, field_read_access) implicit none class(lfric_xios_field_type), intent(inout) :: self + logical, intent(in) :: field_read_access type(xios_fieldgroup) :: fieldgroup_hdl type(xios_domain) :: domain @@ -135,7 +136,9 @@ subroutine register(self) ! Get field group handle and add field call xios_get_handle(trim(adjustl(self%fieldgroup_id)), fieldgroup_hdl) call xios_add_child(fieldgroup_hdl, self%handle, trim(self%xios_id)) - call xios_set_attr(self%handle, name=trim(adjustl(self%model_field%get_name()))) + call xios_set_attr( self%handle, & + name=trim(adjustl(self%model_field%get_name())), & + read_access=field_read_access ) ! Set up dimensions of output field vspace => self%model_field%get_function_space() diff --git a/components/lfric-xios/source/lfric_xios_file_mod.f90 b/components/lfric-xios/source/lfric_xios_file_mod.f90 index cc1e9a820..71deba6fd 100644 --- a/components/lfric-xios/source/lfric_xios_file_mod.f90 +++ b/components/lfric-xios/source/lfric_xios_file_mod.f90 @@ -389,7 +389,10 @@ subroutine register_with_context(self) call xios_get_timestep(timestep_duration) if (.not. self%freq_ts == undef_freq) then self%frequency = self%freq_ts * timestep_duration - call xios_set_attr( self%handle, output_freq=self%frequency ) + call xios_set_attr(self%handle, output_freq=self%frequency) + else + ! If frequency is uninitialised, get it from XIOS + call xios_get_file_attr(self%xios_id, output_freq=self%frequency) end if ! Set the date of the first operation @@ -410,7 +413,7 @@ subroutine register_with_context(self) ! Iterate over field collection and register fields do i = 1, size(self%fields) - call self%fields(i)%register() + call self%fields(i)%register(field_read_access=self%mode_is_read()) end do ! Set up time axis if needed diff --git a/components/lfric-xios/source/lfric_xios_metafile_mod.F90 b/components/lfric-xios/source/lfric_xios_metafile_mod.F90 index ae5841734..a138ccf00 100644 --- a/components/lfric-xios/source/lfric_xios_metafile_mod.F90 +++ b/components/lfric-xios/source/lfric_xios_metafile_mod.F90 @@ -269,6 +269,12 @@ subroutine add_field(metafile, dict_field_id, mode, operation, id_as_name, legac end if end if end if + + ! Enable read_access if field is being added for restarting + if (mode == RESTARTING) then + call xios_set_field_attr(field_id, read_access=.true.) + end if + end do end subroutine add_field diff --git a/components/lfric-xios/source/lfric_xios_read_mod.F90 b/components/lfric-xios/source/lfric_xios_read_mod.F90 index ad8051a33..456ce5f3d 100644 --- a/components/lfric-xios/source/lfric_xios_read_mod.F90 +++ b/components/lfric-xios/source/lfric_xios_read_mod.F90 @@ -38,6 +38,8 @@ module lfric_xios_read_mod LOG_LEVEL_INFO, & LOG_LEVEL_ERROR, & LOG_LEVEL_TRACE + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF #ifdef UNIT_TEST use lfric_xios_mock_mod, only: xios_recv_field, & xios_get_domain_attr, & @@ -84,6 +86,9 @@ subroutine checkpoint_read_xios(xios_field_name, file_name, field_proxy) integer(i_def) :: undf integer(i_def) :: fs_id + integer(tik) :: timing_id + + if ( LPROF ) call start_timing(timing_id, 'lfric_xios.chkpt_readf') ! We only read in up to undf for the partition undf = field_proxy%vspace%get_last_dof_owned() @@ -103,6 +108,7 @@ subroutine checkpoint_read_xios(xios_field_name, file_name, field_proxy) call log_event( "Invalid type for input field proxy", LOG_LEVEL_ERROR ) end select + if ( LPROF ) call stop_timing(timing_id, 'lfric_xios.chkpt_readf') end subroutine checkpoint_read_xios @@ -114,6 +120,9 @@ subroutine checkpoint_read_value(io_value, value_name) character(*), optional, intent(in) :: value_name character(str_def) :: restart_id integer(i_def) :: array_dims + integer(tik) :: timing_id + + if ( LPROF ) call start_timing(timing_id, 'lfric_xios.chkpt_readv') if(present(value_name)) then restart_id = trim(value_name) @@ -129,6 +138,7 @@ subroutine checkpoint_read_value(io_value, value_name) call log_event( 'No XIOS field with id="'//trim(restart_id)//'" is defined', & LOG_LEVEL_ERROR ) end if + if ( LPROF ) call stop_timing(timing_id, 'lfric_xios.chkpt_readv') end subroutine checkpoint_read_value @@ -168,6 +178,9 @@ subroutine read_field_generic(xios_field_name, field_proxy) integer(i_def) :: vdim ! vertical dimension real(dp_xios), allocatable :: xios_data(:) logical(l_def) :: legacy + integer(tik) :: timing_id + + if ( LPROF ) call start_timing(timing_id, 'lfric_xios.read_fldg') undf = field_proxy%vspace%get_last_dof_owned() ! total dimension @@ -198,6 +211,8 @@ subroutine read_field_generic(xios_field_name, field_proxy) deallocate(xios_data) + if ( LPROF ) call stop_timing(timing_id, 'lfric_xios.read_fldg') + end subroutine read_field_generic !> @brief Read a time-varying field, with given time dimension, in UGRID format using XIOS diff --git a/components/lfric-xios/source/lfric_xios_write_mod.F90 b/components/lfric-xios/source/lfric_xios_write_mod.F90 index ea1d25e68..634aefd1b 100644 --- a/components/lfric-xios/source/lfric_xios_write_mod.F90 +++ b/components/lfric-xios/source/lfric_xios_write_mod.F90 @@ -44,6 +44,8 @@ module lfric_xios_write_mod LOG_LEVEL_WARNING, & LOG_LEVEL_ERROR use lfric_string_mod, only: split_string + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF #ifdef UNIT_TEST use lfric_xios_mock_mod, only: xios_send_field, & xios_get_domain_attr, & @@ -118,11 +120,14 @@ subroutine write_field_generic(field_name, field_proxy) integer(i_def) :: vdim ! vertical dimension real(dp_xios), allocatable :: xios_data(:) logical(l_def) :: legacy + integer(tik) :: timing_id ! If the field is not active in xios at this timestep, exit this routine ! without doing anything if (.not. field_is_active(field_name, .true.)) return + if ( LPROF ) call start_timing(timing_id, 'lfric_xios.write_fldg') + undf = field_proxy%vspace%get_last_dof_owned() ! total dimension vdim = field_proxy%vspace%get_ndata() * size(field_proxy%vspace%get_levels()) @@ -152,6 +157,8 @@ subroutine write_field_generic(field_name, field_proxy) deallocate(xios_data) + if ( LPROF ) call stop_timing(timing_id, 'lfric_xios.write_fldg') + end subroutine write_field_generic !> @brief Graceful failure if an empty field is attempted to be written diff --git a/components/science/rose-meta/lfric-science/version30_31.py b/components/science/rose-meta/lfric-science/version30_31.py new file mode 100644 index 000000000..5924e0a74 --- /dev/null +++ b/components/science/rose-meta/lfric-science/version30_31.py @@ -0,0 +1,45 @@ +import re +import sys + +from metomi.rose.upgrade import MacroUpgrade + +from .version22_30 import * + + +class UpgradeError(Exception): + """Exception created when an upgrade fails.""" + + def __init__(self, msg): + self.msg = msg + + def __repr__(self): + sys.tracebacklimit = 0 + return self.msg + + __str__ = __repr__ + + +""" +Copy this template and complete to add your macro +class vnXX_txxx(MacroUpgrade): + # Upgrade macro for by + BEFORE_TAG = "vnX.X" + AFTER_TAG = "vnX.X_txxx" + def upgrade(self, config, meta_config=None): + # Add settings + return config, self.reports +""" + + +class vn30_t306(MacroUpgrade): + """Upgrade macro for ticket TTTT by Unknown.""" + + BEFORE_TAG = "vn3.0" + AFTER_TAG = "vn3.1" + + def upgrade(self, config, meta_config=None): + # Commands From: rose-meta/lfric-driver + # Blank Upgrade Macro + # Commands From: rose-meta/lfric-science + # Blank Upgrade Macro + return config, self.reports diff --git a/components/science/rose-meta/lfric-science/versions.py b/components/science/rose-meta/lfric-science/versions.py index 152c043d0..01798ad2b 100644 --- a/components/science/rose-meta/lfric-science/versions.py +++ b/components/science/rose-meta/lfric-science/versions.py @@ -1,8 +1,8 @@ import sys -from metomi.rose.upgrade import MacroUpgrade +from metomi.rose.upgrade import MacroUpgrade # noqa: F401 -from .version22_30 import * +from .version30_31 import * class UpgradeError(Exception): diff --git a/components/science/rose-meta/lfric-science/vn3.1/rose-meta.conf b/components/science/rose-meta/lfric-science/vn3.1/rose-meta.conf new file mode 100644 index 000000000..b9730e75e --- /dev/null +++ b/components/science/rose-meta/lfric-science/vn3.1/rose-meta.conf @@ -0,0 +1 @@ +import=lfric-driver/vn3.1 diff --git a/components/science/source/algorithm/sci_fem_constants_mod.x90 b/components/science/source/algorithm/sci_fem_constants_mod.x90 index 6477c64ff..72679babc 100644 --- a/components/science/source/algorithm/sci_fem_constants_mod.x90 +++ b/components/science/source/algorithm/sci_fem_constants_mod.x90 @@ -23,14 +23,14 @@ module sci_fem_constants_mod use function_space_collection_mod, only: function_space_collection use function_space_mod, only: function_space_type use inventory_by_mesh_mod, only: inventory_by_mesh_type - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, LOG_LEVEL_ERROR use mesh_collection_mod, only: mesh_collection use mesh_mod, only: mesh_type use operator_mod, only: operator_type use quadrature_xyoz_mod, only: quadrature_xyoz_type use quadrature_rule_gaussian_mod, only: quadrature_rule_gaussian_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Configuration use finite_element_config_mod, only: element_order_h, & @@ -228,6 +228,7 @@ contains logical(kind=l_def), parameter :: extend_mesh = .false. type(field_type) :: dummy_field integer(kind=i_def), parameter :: stencil_depth = 1_i_def + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -275,7 +276,7 @@ contains panel_id => get_panel_id(mesh_id) qr_ptr => get_qr_fe() - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space) call inventory%add_operator(mm_op, fs, fs, mesh) @@ -306,7 +307,7 @@ contains stencil_depth) ) end if - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -346,6 +347,7 @@ contains logical(kind=l_def), parameter :: extend_mesh = .false. type(field_type) :: dummy_field integer(kind=i_def), parameter :: stencil_depth = 1_i_def + integer(tik) :: id ! Point to appropriate inventory for this space select case (space) @@ -387,7 +389,7 @@ contains panel_id => get_panel_id(mesh_id) qr_ptr => get_qr_fv() - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, 0, 0, space) call inventory%add_operator(mm_op, fs, fs, mesh) @@ -417,7 +419,7 @@ contains stencil_depth) ) end if - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -444,6 +446,7 @@ contains type(function_space_type), pointer :: fs type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -489,7 +492,7 @@ contains ! Create constant if it doesn't already exist mass_matrix => get_mass_matrix_fe(space, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space) @@ -497,7 +500,7 @@ contains call invoke ( setval_c(diagonal_mm, 0.0_r_def), & mm_diagonal_kernel_type(diagonal_mm, mass_matrix) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -524,6 +527,7 @@ contains type(function_space_type), pointer :: fs type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name + integer(tik) :: id ! Point to appropriate inventory for this space select case (space) @@ -563,14 +567,14 @@ contains ! Create constant if it doesn't already exist mass_matrix => get_mass_matrix_fv(space, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, 0, 0, space) call inventory%add_field(diagonal_mm, fs, mesh) call invoke ( setval_c(diagonal_mm, 0.0_r_def), & mm_diagonal_kernel_type(diagonal_mm, mass_matrix) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -600,6 +604,7 @@ contains type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name integer(kind=i_def), parameter :: i_minus_one = -1_i_def + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -633,7 +638,7 @@ contains ! Create constant if it doesn't already exist mass_matrix => get_mass_matrix_fe(space, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space) @@ -654,7 +659,7 @@ contains ones, mass_matrix), & inc_X_powint_n(mm_linv, i_minus_one) ) end select - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -684,6 +689,7 @@ contains type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name integer(kind=i_def), parameter :: i_minus_one = -1_i_def + integer(tik) :: id ! Point to appropriate inventory for this space select case (space) @@ -711,7 +717,7 @@ contains ! Create constant if it doesn't already exist mass_matrix => get_mass_matrix_fv(space, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, 0, 0, space) call ones%initialise( fs ) @@ -731,7 +737,7 @@ contains ones, mass_matrix), & inc_X_powint_n(mm_linv, i_minus_one) ) end select - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -758,6 +764,7 @@ contains type(function_space_type), pointer :: fs type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -791,7 +798,7 @@ contains ! Create constant if it doesn't already exist mass_matrix => get_mass_matrix_fe(space, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space) @@ -800,7 +807,7 @@ contains call invoke( name = "create_inv_mass_matrix_fe", & invert_local_operator_kernel_type(mm_inv, mass_matrix) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -827,6 +834,7 @@ contains type(function_space_type), pointer :: fs type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name + integer(tik) :: id ! Point to appropriate inventory for this space select case (space) @@ -854,7 +862,7 @@ contains ! Create constant if it doesn't already exist mass_matrix => get_mass_matrix_fv(space, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, 0, 0, space) call inventory%add_operator(mm_inv, fs, fs, mesh) @@ -862,7 +870,7 @@ contains call invoke( name = "create_inv_mass_matrix_fv", & invert_local_operator_kernel_type(mm_inv, mass_matrix) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -888,6 +896,7 @@ contains type(quadrature_xyoz_type), pointer :: qr_ptr type(function_space_type), pointer :: w2_fs type(function_space_type), pointer :: w1_fs + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -914,12 +923,12 @@ contains w1_fs => function_space_collection%get_fs( mesh, element_order_h, & element_order_v, W1 ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) call curl_inventory_fe%add_operator(curl, w2_fs, w1_fs, mesh) call invoke( name='calculate_curl_fe', & compute_curl_operator_kernel_type(curl, chi, & panel_id, qr_ptr) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if call curl_inventory_fe%get_operator(mesh, curl) @@ -944,6 +953,7 @@ contains type(quadrature_xyoz_type), pointer :: qr_ptr type(function_space_type), pointer :: w2_fs type(function_space_type), pointer :: w1_fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. curl_inventory_fv%is_initialised()) then @@ -962,12 +972,12 @@ contains w2_fs => function_space_collection%get_fs( mesh, 0, 0, W2 ) w1_fs => function_space_collection%get_fs( mesh, 0, 0, W1 ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) call curl_inventory_fv%add_operator(curl, w2_fs, w1_fs, mesh) call invoke( name='calculate_curl_fv', & compute_curl_operator_kernel_type(curl, chi, & panel_id, qr_ptr) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if call curl_inventory_fv%get_operator(mesh, curl) @@ -990,6 +1000,7 @@ contains type(quadrature_xyoz_type), pointer :: qr_ptr type(function_space_type), pointer :: w3_fs type(function_space_type), pointer :: w2_fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. div_inventory%is_initialised()) then @@ -1010,12 +1021,12 @@ contains w3_fs => function_space_collection%get_fs( mesh, element_order_h, & element_order_v, W3 ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) call div_inventory%add_operator(div, w3_fs, w2_fs, mesh) call invoke( name='calculate_div', & compute_div_operator_kernel_type(div, chi, & panel_id, qr_ptr) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if call div_inventory%get_operator(mesh, div) @@ -1038,6 +1049,7 @@ contains type(quadrature_xyoz_type), pointer :: qr_ptr type(function_space_type), pointer :: w3_fs type(function_space_type), pointer :: w2h_fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. div_h_inventory%is_initialised()) then @@ -1058,12 +1070,12 @@ contains w3_fs => function_space_collection%get_fs( mesh, element_order_h, & element_order_v, W3 ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) call div_h_inventory%add_operator(div_h, w3_fs, w2h_fs, mesh) call invoke( name='calculate_div_h', & compute_div_operator_kernel_type(div_h, chi, & panel_id, qr_ptr) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if call div_h_inventory%get_operator(mesh, div_h) @@ -1090,6 +1102,7 @@ contains type(quadrature_xyoz_type), pointer :: qr_ptr type(function_space_type), pointer :: w3_fs type(function_space_type), pointer :: w2_fs + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -1117,13 +1130,13 @@ contains w3_fs => function_space_collection%get_fs( mesh, element_order_h, & element_order_v, W3 ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) call div%initialise( w3_fs, w2_fs ) call im3_div_inventory_fe%add_operator(im3_div, w3_fs, w2_fs, mesh) call invoke( compute_div_operator_kernel_type(div, chi, & panel_id, qr_ptr), & operator_x_times_y_kernel_type(im3_div, mm_w3_inv, div) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if call im3_div_inventory_fe%get_operator(mesh, im3_div) @@ -1150,6 +1163,7 @@ contains type(quadrature_xyoz_type), pointer :: qr_ptr type(function_space_type), pointer :: w3_fs type(function_space_type), pointer :: w2_fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. im3_div_inventory_fv%is_initialised()) then @@ -1169,13 +1183,13 @@ contains w2_fs => function_space_collection%get_fs( mesh, 0, 0, W2 ) w3_fs => function_space_collection%get_fs( mesh, 0, 0, W3 ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) call div%initialise( w3_fs, w2_fs ) call im3_div_inventory_fv%add_operator(im3_div, w3_fs, w2_fs, mesh) call invoke( compute_div_operator_kernel_type(div, chi, & panel_id, qr_ptr), & operator_x_times_y_kernel_type(im3_div, mm_w3_inv, div) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if call im3_div_inventory_fv%get_operator(mesh, im3_div) @@ -1201,6 +1215,7 @@ contains type(function_space_type), pointer :: fs type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -1238,7 +1253,7 @@ contains if (.not. constant_exists) then ! Create constant if it doesn't already exist - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space) @@ -1253,7 +1268,7 @@ contains multiplicity_kernel_type(nodal_multiplicity), & X_divideby_Y(rmultiplicity, ones, nodal_multiplicity) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -1280,6 +1295,7 @@ contains type(function_space_type), pointer :: fs type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name + integer(tik) :: id ! Point to appropriate inventory for this space select case (space) @@ -1311,7 +1327,7 @@ contains if (.not. constant_exists) then ! Create constant if it doesn't already exist - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, 0, 0, space) @@ -1325,7 +1341,7 @@ contains multiplicity_kernel_type(nodal_multiplicity), & X_divideby_Y(rmultiplicity, ones, nodal_multiplicity) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant diff --git a/components/science/source/algorithm/sci_geometric_constants_mod.x90 b/components/science/source/algorithm/sci_geometric_constants_mod.x90 index 744700203..524ee5622 100644 --- a/components/science/source/algorithm/sci_geometric_constants_mod.x90 +++ b/components/science/source/algorithm/sci_geometric_constants_mod.x90 @@ -18,18 +18,18 @@ module sci_geometric_constants_mod use constants_mod, only: i_def, r_def, l_def, str_def use extrusion_mod, only: TWOD, PRIME_EXTRUSION use field_mod, only: field_type - use fs_continuity_mod, only: W1, W2, W2H, W3, Wtheta + use fs_continuity_mod, only: W0, W1, W2, W2H, W3, Wtheta use function_space_collection_mod, only: function_space_collection use function_space_mod, only: function_space_type use integer_field_mod, only: integer_field_type use inventory_by_mesh_mod, only: inventory_by_mesh_type use inventory_by_local_mesh_mod, only: inventory_by_local_mesh_type - use io_config_mod, only: subroutine_timers use local_mesh_mod, only: local_mesh_type use log_mod, only: log_event, LOG_LEVEL_ERROR use mesh_collection_mod, only: mesh_collection use mesh_mod, only: mesh_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Configuration use finite_element_config_mod, only: element_order_h, & @@ -77,6 +77,8 @@ module sci_geometric_constants_mod type(inventory_by_local_mesh_type), target :: long_w2h_inventory_fv ! Heights of DoFs + type(inventory_by_mesh_type), target :: height_w0_inventory_fe + type(inventory_by_mesh_type), target :: height_w0_inventory_fv type(inventory_by_mesh_type), target :: height_w1_inventory_fe type(inventory_by_mesh_type), target :: height_w1_inventory_fv type(inventory_by_mesh_type), target :: height_w2_inventory_fe @@ -164,8 +166,9 @@ contains type(field_type), pointer :: panel_id type(function_space_type), pointer :: twod_fs integer(kind=i_def) :: k_h, k_v + integer(tik) :: id - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) if (use_fe) then k_h = element_order_h @@ -190,7 +193,7 @@ contains setval_c(long, f_lon) ) end if - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end subroutine compute_latlon @@ -217,8 +220,9 @@ contains type(integer_field_type) :: face_counter type(function_space_type), pointer :: w2h_2d_fs type(function_space_type), pointer :: w3_2d_fs + integer(tik) :: id - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) twod_mesh => mesh_collection%get_mesh(mesh, TWOD) local_mesh => mesh%get_local_mesh() @@ -246,7 +250,7 @@ contains face_selector_ns, & face_counter ) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end subroutine compute_face_selectors @@ -315,6 +319,7 @@ contains type(field_type), pointer :: chi(:) type(field_type), pointer :: panel_id type(function_space_type), pointer :: wchi_fs + integer(tik) :: id ! Initialise inventory if this is the first time getting this constant if (.not. extended_chi_inventory%is_initialised()) then @@ -329,7 +334,7 @@ contains chi => get_coordinates(mesh_id) panel_id => get_panel_id(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) wchi_fs => chi(1)%get_function_space() depth = mesh%get_halo_depth() @@ -347,7 +352,7 @@ contains call invoke( extend_chi_field_kernel_type(extended_chi, chi, & panel_id, depth) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) else ! Otherwise, return existing constant call extended_chi_inventory%get_field_array(mesh, extended_chi) @@ -374,6 +379,7 @@ contains type(field_type), pointer :: chi(:) type(field_type), pointer :: panel_id type(function_space_type), pointer :: w2_k0_fs + integer(tik) :: id ! Initialise inventory if this is the first time getting this constant if (.not. dA_at_w2_inventory%is_initialised()) then @@ -388,7 +394,7 @@ contains chi => get_coordinates(mesh_id) panel_id => get_panel_id(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) w2_k0_fs => function_space_collection%get_fs(mesh, 0, 0, W2) call dA_at_w2_inventory%add_field(dA_at_w2, w2_k0_fs, mesh) @@ -396,7 +402,7 @@ contains call invoke( setval_c(dA_at_w2, 0.0_r_def), & calc_dA_at_w2_kernel_type(dA_at_w2, chi, panel_id) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) else ! Otherwise, return existing constant call dA_at_w2_inventory%get_field(mesh, dA_at_w2) @@ -434,6 +440,7 @@ contains type(quadrature_xyoz_type) :: qr logical(kind=l_def) :: extended_mesh type(quadrature_rule_gaussian_type) :: quadrature_rule + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -455,7 +462,7 @@ contains panel_id => get_panel_id(mesh_id) ! Create the object as it doesn't exist yet - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) w3_fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, W3) @@ -476,7 +483,7 @@ contains setval_c(detj_at_w3, 0.0_r_def), & mm_diagonal_kernel_type(detj_at_w3, mm_w3) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Get existing constant @@ -513,6 +520,7 @@ contains type(quadrature_xyoz_type) :: qr logical(kind=l_def) :: extended_mesh type(quadrature_rule_gaussian_type) :: quadrature_rule + integer(tik) :: id ! Check inventory is initialised if (.not. detj_at_w3_inventory_fv%is_initialised()) then @@ -528,7 +536,7 @@ contains panel_id => get_panel_id(mesh_id) ! Create the object as it doesn't exist yet - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) w3_fs => function_space_collection%get_fs(mesh, 0, 0, W3) call detj_at_w3_inventory_fv%add_field(detj_at_w3, w3_fs, mesh) @@ -547,7 +555,7 @@ contains setval_c(detj_at_w3, 0.0_r_def), & mm_diagonal_kernel_type(detj_at_w3, mm_w3) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Get existing constant @@ -573,6 +581,7 @@ contains type(field_type), pointer :: panel_id type(field_type) :: multiplicity_w2 type(function_space_type), pointer :: w2_fs + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -594,7 +603,7 @@ contains panel_id => get_panel_id(mesh_id) ! Create the object as it doesn't exist yet - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) w2_fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, W2) @@ -608,7 +617,7 @@ contains setval_c(multiplicity_w2, 0.0_r_def), & multiplicity_kernel_type(multiplicity_w2), & inc_X_divideby_Y(detj_at_w2, multiplicity_w2) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Get existing constant @@ -634,6 +643,7 @@ contains type(field_type), pointer :: panel_id type(field_type) :: multiplicity_w2 type(function_space_type), pointer :: w2_fs + integer(tik) :: id ! Check inventory is initialised if (.not. detj_at_w2_inventory_fv%is_initialised()) then @@ -649,7 +659,7 @@ contains panel_id => get_panel_id(mesh_id) ! Create the object as it doesn't exist yet - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) w2_fs => function_space_collection%get_fs(mesh, 0, 0, W2) call multiplicity_w2%initialise( w2_fs ) @@ -662,7 +672,7 @@ contains setval_c(multiplicity_w2, 0.0_r_def), & multiplicity_kernel_type(multiplicity_w2), & inc_X_divideby_Y(detj_at_w2, multiplicity_w2) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Get existing constant @@ -685,6 +695,7 @@ contains logical(kind=l_def) :: constant_exists type(field_type), pointer :: height_w2 type(function_space_type), pointer :: w3_fs + integer(tik) :: id ! Initialise inventory if this is the first time getting this constant if (.not. dz_w3_inventory%is_initialised()) then @@ -699,14 +710,14 @@ contains ! Get height first to avoid potentially timing twice height_w2 => get_height_fv(W2, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) w3_fs => function_space_collection%get_fs(mesh, 0, 0, W3) call dz_w3_inventory%add_field(dz_w3, w3_fs, mesh) call invoke( get_dz_w3_kernel_type(dz_w3, height_w2) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) else ! Otherwise, return existing constant call dz_w3_inventory%get_field(mesh, dz_w3) @@ -730,6 +741,7 @@ contains type(field_type), pointer :: dx_at_w2 type(field_type), pointer :: delta_at_wtheta type(function_space_type), pointer :: wt_k0_fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. delta_at_wtheta_inventory%is_initialised()) then @@ -744,13 +756,13 @@ contains wt_k0_fs => function_space_collection%get_fs(mesh, 0, 0, Wtheta) dx_at_w2 => get_dx_at_w2(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) call delta_at_wtheta_inventory%add_field(delta_at_wtheta, wt_k0_fs, mesh) call invoke( calc_delta_at_wtheta_kernel_type(delta_at_wtheta, dx_at_w2) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Return constant @@ -772,6 +784,7 @@ contains type(field_type), pointer :: detj_at_w2 type(field_type), pointer :: dA_at_w2 type(function_space_type), pointer :: w2_fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. dx_at_w2_inventory%is_initialised()) then @@ -787,12 +800,12 @@ contains detj_at_w2 => get_detj_at_w2_fv(mesh_id) dA_at_w2 => get_dA_at_w2(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) call dx_at_w2_inventory%add_field(dx_at_w2, w2_fs, mesh) call invoke( X_divideby_Y(dx_at_w2, detj_at_w2, dA_at_w2) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Return constant @@ -817,6 +830,7 @@ contains type(field_type), pointer :: height_w3 type(field_type), pointer :: height_wth logical(kind=l_def) :: constant_exists + integer(tik) :: id ! Parameters of the cells integer(i_def), parameter :: n_centres = 1_i_def @@ -836,7 +850,7 @@ contains height_w3 => get_height_fv(W3, mesh_id) height_wth => get_height_fv(Wtheta, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) wtheta_k0_fs => function_space_collection%get_fs(mesh, 0, 0, Wtheta) @@ -845,7 +859,7 @@ contains call invoke( calc_dz_face_kernel_type(dz_at_wtheta, height_w3, & height_wth, n_centres, ign_surf) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Return constant @@ -875,6 +889,7 @@ contains type(field_type), pointer :: dA_msl_proj type(field_type), pointer :: dA_at_w2 type(function_space_type), pointer :: fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. dA_msl_proj_inventory%is_initialised()) then @@ -893,14 +908,14 @@ contains fs => function_space_collection%get_fs(twod_mesh, 0, 0, W3) dA_at_w2 => get_dA_at_w2(prime_mesh%get_id()) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) call dA_msl_proj_inventory%add_field(dA_msl_proj, fs, local_mesh) call invoke( calc_da_msl_proj_kernel_type(dA_at_w2, dA_msl_proj, & planet_radius, domain_height, & geometry, geometry_spherical) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Return constant @@ -1176,6 +1191,7 @@ contains type(field_type), pointer :: chi(:) type(field_type), pointer :: height character(len=str_def) :: inventory_name + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -1185,6 +1201,9 @@ contains ! Determine inventory based on space select case (space_id) + case (W0) + inventory => height_w0_inventory_fe + inventory_name = "height_w0_fe" case (W1) inventory => height_w1_inventory_fe inventory_name = "height_w1_fe" @@ -1217,7 +1236,7 @@ contains ! If this constant doesn't exist, create it chi => get_coordinates(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) space => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space_id) @@ -1225,7 +1244,7 @@ contains call invoke( get_height_kernel_type(height, chi, scaled_radius) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) else call inventory%get_field(mesh, height) end if @@ -1252,9 +1271,13 @@ contains type(field_type), pointer :: chi(:) type(field_type), pointer :: height character(len=str_def) :: inventory_name + integer(tik) :: id ! Determine inventory based on space select case (space_id) + case (W0) + inventory => height_w0_inventory_fv + inventory_name = "height_w0_fv" case (W1) inventory => height_w1_inventory_fv inventory_name = "height_w1_fv" @@ -1287,14 +1310,14 @@ contains ! If this constant doesn't exist, create it chi => get_coordinates(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) space => function_space_collection%get_fs(mesh, 0, 0, space_id) call inventory%add_field(height, space, mesh) call invoke( get_height_kernel_type(height, chi, scaled_radius) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) else call inventory%get_field(mesh, height) end if @@ -1419,6 +1442,8 @@ contains call height_w2h_inventory_fv%clear() call height_w1_inventory_fe%clear() call height_w1_inventory_fv%clear() + call height_w0_inventory_fe%clear() + call height_w0_inventory_fv%clear() call dz_w3_inventory%clear() call panel_id_inventory%clear() call chi_inventory%clear() diff --git a/components/science/source/algorithm/sci_mapping_constants_mod.x90 b/components/science/source/algorithm/sci_mapping_constants_mod.x90 index 7bcecf0f3..ffa819aa1 100644 --- a/components/science/source/algorithm/sci_mapping_constants_mod.x90 +++ b/components/science/source/algorithm/sci_mapping_constants_mod.x90 @@ -39,12 +39,12 @@ module sci_mapping_constants_mod use operator_mod, only: operator_type use quadrature_xyoz_mod, only: quadrature_xyoz_type use r_tran_field_mod, only: r_tran_field_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Configuration use finite_element_config_mod, only: element_order_h, & element_order_v - use io_config_mod, only: subroutine_timers ! Other algorithms use sci_geometric_constants_mod, only: get_coordinates, & @@ -272,6 +272,7 @@ contains type(operator_type), pointer :: u_lon_sample type(operator_type), pointer :: u_lat_sample type(operator_type), pointer :: u_up_sample + integer(tik) :: id if (.not. u_lon_sample_inventory%is_initialised()) then call u_lon_sample_inventory%initialise(name='u_lon_sample') @@ -287,7 +288,7 @@ contains chi => get_coordinates(mesh_id) panel_id => get_panel_id(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) ! Kernels only work for lowest order spaces so use finite volume w2_fs => function_space_collection%get_fs(mesh, 0, 0, W2) @@ -304,7 +305,7 @@ contains u_up_sample, & chi, panel_id) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end subroutine create_spherical_components_to_w2_sample @@ -330,6 +331,7 @@ contains type(function_space_type), pointer :: fs, coarse_fs, fine_fs type(quadrature_rule_segment_centre_type) :: quadrature_rule_sc type(quadrature_xyoz_type) :: qr + integer(tik) :: id if (.not. scalar_inter_element_order_weights_inventory%is_initialised()) then call scalar_inter_element_order_weights_inventory%initialise( & @@ -337,7 +339,7 @@ contains ) end if - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) k_h = element_order_h k_v = element_order_v @@ -384,7 +386,7 @@ contains dummy_fine, dummy_coarse, weights_high_low, weights_low_high, qr & ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end subroutine create_scalar_inter_element_order_weights @@ -410,6 +412,7 @@ contains type(function_space_type), pointer :: fs, coarse_fs, fine_fs type(quadrature_rule_newton_cotes_type) :: quadrature_rule_newton_cotes type(quadrature_xyoz_type) :: qr + integer(tik) :: id if (.not. w2_inter_element_order_weights_inventory%is_initialised()) then call w2_inter_element_order_weights_inventory%initialise( & @@ -417,7 +420,7 @@ contains ) end if - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) k_h = element_order_h k_v = element_order_v @@ -485,7 +488,7 @@ contains dummy_fine, dummy_coarse, weights_high_low, weights_low_high, qr & ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end subroutine create_w2_inter_element_order_weights @@ -517,6 +520,7 @@ contains type(field_type) :: dummy_theta integer(kind=i_def) :: k logical(kind=l_def) :: constant_exists + integer(tik) :: id ! Check inventory is initialised if (.not. proj_mr_to_sh_rho_inventory%is_initialised()) then @@ -540,7 +544,7 @@ contains double_level_chi => get_coordinates(double_level_mesh%get_id()) qr => get_qr_fv() - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) w3_fs => function_space_collection%get_fs(prime_extrusion_mesh, 0, 0, W3) wtheta_fs => function_space_collection%get_fs(prime_extrusion_mesh, 0, 0, Wtheta) @@ -560,7 +564,7 @@ contains dummy_theta, & qr) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if ! Get existing constant @@ -586,6 +590,7 @@ contains type(field_type) :: dummy_w2_field type(function_space_type), pointer :: fine_w2_fs type(function_space_type), pointer :: coarse_w2_fs + integer(tik) :: id ! Check inventory is initialised if (.not. intermesh_wghts_w2_inventory%is_initialised()) then @@ -608,7 +613,7 @@ contains call log_event(log_scratch_space, LOG_LEVEL_ERROR) end if - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) coarse_w2_fs => function_space_collection%get_fs(coarse_mesh, 0, 0, W2) fine_w2_fs => function_space_collection%get_fs(fine_mesh, 0, 0, W2) @@ -623,7 +628,7 @@ contains call invoke( setval_c(weights, 0.0_r_def), & weights_prolong_w2_kernel_type(weights, dummy_w2_field) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if ! Get existing constant @@ -651,6 +656,7 @@ contains type(function_space_type), pointer :: coarse_w3_fs type(field_type), pointer :: mm_w3_fine type(field_type), pointer :: mm_w3_coarse + integer(tik) :: id ! Check inventory is initialised if (.not. intermesh_wghts_rdef_w3_inventory%is_initialised()) then @@ -679,7 +685,7 @@ contains mm_w3_fine => get_mass_matrix_diagonal_fv(W3, fine_mesh%get_id()) mm_w3_coarse => get_mass_matrix_diagonal_fv(W3, coarse_mesh%get_id()) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) coarse_w3_fs => function_space_collection%get_fs(coarse_mesh, 0, 0, W3) fine_w3_fs => function_space_collection%get_fs(fine_mesh, 0, 0, W3) @@ -692,7 +698,7 @@ contains mm_w3_fine, & mm_w3_coarse) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if ! Get existing constant @@ -717,6 +723,7 @@ contains type(field_type), pointer :: weights_rdef type(r_tran_field_type), pointer :: weights_rtran type(function_space_type), pointer :: fine_w3_fs + integer(tik) :: id ! Check inventory is initialised if (.not. intermesh_wghts_rtran_w3_inventory%is_initialised()) then @@ -736,7 +743,7 @@ contains ! Create the object as it doesn't exist yet weights_rdef => get_intermesh_weights_w3_rdef(fine_mesh, coarse_mesh) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) fine_w3_fs => function_space_collection%get_fs(fine_mesh, 0, 0, W3) @@ -746,7 +753,7 @@ contains call copy_field(weights_rdef, weights_rtran) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if ! Get existing constant @@ -1017,6 +1024,7 @@ contains type(field_type), pointer :: panel_id type(quadrature_xyoz_type), pointer :: qr integer(kind=i_def), parameter :: xdirection = 1_i_def + integer(tik) :: id ! Check inventory is initialised if (.not. project_lon_dot_to_w1_inventory%is_initialised()) then @@ -1034,7 +1042,7 @@ contains panel_id => get_panel_id(mesh_id) qr => get_qr_fv() - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) w1_fs => function_space_collection%get_fs(mesh, 0, 0, W1) w3_fs => function_space_collection%get_fs(mesh, 0, 0, W3) @@ -1048,7 +1056,7 @@ contains chi, panel_id, & xdirection, qr) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if ! Return constant @@ -1073,6 +1081,7 @@ contains type(field_type), pointer :: panel_id type(quadrature_xyoz_type), pointer :: qr integer(kind=i_def), parameter :: ydirection = 2_i_def + integer(tik) :: id ! Check inventory is initialised if (.not. project_lat_dot_to_w1_inventory%is_initialised()) then @@ -1090,7 +1099,7 @@ contains panel_id => get_panel_id(mesh_id) qr => get_qr_fv() - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) w1_fs => function_space_collection%get_fs(mesh, 0, 0, W1) w3_fs => function_space_collection%get_fs(mesh, 0, 0, W3) @@ -1104,7 +1113,7 @@ contains chi, panel_id, & ydirection, qr) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if ! Return constant @@ -1129,6 +1138,7 @@ contains type(field_type), pointer :: panel_id type(quadrature_xyoz_type), pointer :: qr integer(kind=i_def), parameter :: zdirection = 3_i_def + integer(tik) :: id ! Check inventory is initialised if (.not. project_r_dot_to_w1_inventory%is_initialised()) then @@ -1144,7 +1154,7 @@ contains panel_id => get_panel_id(mesh_id) qr => get_qr_fv() - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) w1_fs => function_space_collection%get_fs(mesh, 0, 0, W1) w3_fs => function_space_collection%get_fs(mesh, 0, 0, W3) @@ -1158,7 +1168,7 @@ contains chi, panel_id, & zdirection, qr) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if ! Return constant @@ -1185,6 +1195,7 @@ contains type(field_type), pointer :: panel_id type(function_space_type), pointer :: w2h_k0_fs type(function_space_type), pointer :: w3_k0_fs + integer(tik) :: id ! Initialise inventory if this is the first time getting this constant if (.not. w3_to_w2_displacement_inventory%is_initialised()) then @@ -1208,7 +1219,7 @@ contains chi => get_coordinates(mesh_id) panel_id => get_panel_id(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) w2h_k0_fs => function_space_collection%get_fs(mesh, 0, 0, W2H) w3_k0_fs => function_space_collection%get_fs(mesh, 0, 0, W3) @@ -1220,7 +1231,7 @@ contains w3_to_w2_displacement_kernel_type(w3_to_w2_displacement, & chi, panel_id, dummy_w3) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if end function get_w3_to_w2_displacement diff --git a/components/science/source/algorithm/solver/sci_mass_matrix_solver_alg_mod.x90 b/components/science/source/algorithm/solver/sci_mass_matrix_solver_alg_mod.x90 index b21db98bb..20c1246b8 100644 --- a/components/science/source/algorithm/solver/sci_mass_matrix_solver_alg_mod.x90 +++ b/components/science/source/algorithm/solver/sci_mass_matrix_solver_alg_mod.x90 @@ -43,10 +43,8 @@ module sci_mass_matrix_solver_alg_mod precondition_only_type, & jacobi_type, & chebyshev_type - - - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF implicit none @@ -119,8 +117,9 @@ contains type(field_vector_type) :: vec_mm_diagonal real(kind=r_def) :: lmin, lmax + integer(tik) :: id - if ( subroutine_timers ) call timer('mass_matrix_solver_alg') + if ( LPROF ) call start_timing( id, 'mass_matrix_solver_alg' ) mesh_id = y%get_mesh_id() @@ -324,7 +323,7 @@ contains deallocate(mass_matrix_solver) end if - if ( subroutine_timers ) call timer('mass_matrix_solver_alg') + if ( LPROF ) call stop_timing( id, 'mass_matrix_solver_alg' ) end subroutine mass_matrix_solver_alg diff --git a/components/science/source/kernel/fem/sci_compute_broken_div_operator_kernel_mod.F90 b/components/science/source/kernel/fem/sci_compute_broken_div_operator_kernel_mod.F90 index 65f29eacf..3d00ff143 100644 --- a/components/science/source/kernel/fem/sci_compute_broken_div_operator_kernel_mod.F90 +++ b/components/science/source/kernel/fem/sci_compute_broken_div_operator_kernel_mod.F90 @@ -16,9 +16,12 @@ module sci_compute_broken_div_operator_kernel_mod use constants_mod, only: r_def, i_def use sci_coordinate_jacobian_mod, only: coordinate_jacobian use fs_continuity_mod, only: W2broken, W3 - use finite_element_config_mod, only: rehabilitate use kernel_mod, only: kernel_type + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system, rehabilitate + use planet_config_mod, only: scaled_radius + implicit none private @@ -141,7 +144,8 @@ subroutine compute_broken_div_operator_code(cell, nlayers, ncell_3d, & end do ! Compute Jacobian - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi, diff_basis_chi, jac, dj) ! Run over dof extent of W2Broken diff --git a/components/science/source/kernel/fem/sci_compute_curl_operator_kernel_mod.F90 b/components/science/source/kernel/fem/sci_compute_curl_operator_kernel_mod.F90 index 15da848d3..ddcb67d05 100644 --- a/components/science/source/kernel/fem/sci_compute_curl_operator_kernel_mod.F90 +++ b/components/science/source/kernel/fem/sci_compute_curl_operator_kernel_mod.F90 @@ -17,6 +17,10 @@ module sci_compute_curl_operator_kernel_mod use fs_continuity_mod, only: W1, W2 use kernel_mod, only: kernel_type + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -129,7 +133,8 @@ subroutine compute_curl_operator_code(cell, nlayers, ncell_3d, & chi2_e(df) = chi2(map_chi(df) + k) chi3_e(df) = chi3(map_chi(df) + k) end do - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi, diff_basis_chi, jac, dj) do df1 = 1, ndf_w1 do df2 = 1, ndf_w2 diff --git a/components/science/source/kernel/fem/sci_compute_derham_matrices_kernel_mod.F90 b/components/science/source/kernel/fem/sci_compute_derham_matrices_kernel_mod.F90 index d6af12148..dcbf2607b 100644 --- a/components/science/source/kernel/fem/sci_compute_derham_matrices_kernel_mod.F90 +++ b/components/science/source/kernel/fem/sci_compute_derham_matrices_kernel_mod.F90 @@ -28,6 +28,10 @@ module sci_compute_derham_matrices_kernel_mod use fs_continuity_mod, only: W0, W1, W2, W2broken, W3, Wtheta use kernel_mod, only: kernel_type + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -241,7 +245,9 @@ subroutine compute_derham_matrices_code(cell, nlayers, & do qp2 = 1, nqp_v do qp1 = 1, nqp_h ! Precompute some frequently used terms - call pointwise_coordinate_jacobian(ndf_chi, chi1_e, chi2_e, chi3_e, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi(:,:,qp1,qp2), & diff_basis_chi(:,:,qp1,qp2), & jac, dj) diff --git a/components/science/source/kernel/fem/sci_compute_div_operator_kernel_mod.F90 b/components/science/source/kernel/fem/sci_compute_div_operator_kernel_mod.F90 index b0e8c4630..05b84b344 100644 --- a/components/science/source/kernel/fem/sci_compute_div_operator_kernel_mod.F90 +++ b/components/science/source/kernel/fem/sci_compute_div_operator_kernel_mod.F90 @@ -15,9 +15,12 @@ module sci_compute_div_operator_kernel_mod use constants_mod, only: r_def, i_def use sci_coordinate_jacobian_mod, only: coordinate_jacobian use fs_continuity_mod, only: W2, W3 - use finite_element_config_mod, only: rehabilitate use kernel_mod, only: kernel_type + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system, rehabilitate + use planet_config_mod, only: scaled_radius + implicit none private @@ -138,7 +141,8 @@ subroutine compute_div_operator_code(cell, nlayers, ncell_3d, & chi2_e(df) = chi2(map_chi(df) + k) chi3_e(df) = chi3(map_chi(df) + k) end do - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi, diff_basis_chi, jac, dj) do df2 = 1, ndf_w2 diff --git a/components/science/source/kernel/fem/sci_compute_grad_operator_kernel_mod.F90 b/components/science/source/kernel/fem/sci_compute_grad_operator_kernel_mod.F90 index f221e2996..9c06d929f 100644 --- a/components/science/source/kernel/fem/sci_compute_grad_operator_kernel_mod.F90 +++ b/components/science/source/kernel/fem/sci_compute_grad_operator_kernel_mod.F90 @@ -19,6 +19,10 @@ module sci_compute_grad_operator_kernel_mod use fs_continuity_mod, only: W0, W1 use kernel_mod, only: kernel_type + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -134,7 +138,8 @@ subroutine compute_grad_operator_code(cell, nlayers, ncell_3d, & chi2_e(df) = chi2(map_chi(df) + k) chi3_e(df) = chi3(map_chi(df) + k) end do - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi, diff_basis_chi, jac, dj) call coordinate_jacobian_inverse(nqp_h, nqp_v, jac, dj, jac_inv) do qp2 = 1, nqp_v diff --git a/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w1_mod.F90 b/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w1_mod.F90 index f9dc0ff44..b0beabbbb 100644 --- a/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w1_mod.F90 +++ b/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w1_mod.F90 @@ -23,6 +23,10 @@ module sci_compute_mass_matrix_kernel_w1_mod use fs_continuity_mod, only: W1 use kernel_mod, only: kernel_type + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -134,7 +138,8 @@ subroutine compute_mass_matrix_w1_code(cell, nlayers, ncell_3d, & chi3_e(df) = chi3(map_chi(df) + k - 1) end do - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi, diff_basis_chi, jac, dj) call coordinate_jacobian_inverse(nqp_h, nqp_v, jac, dj, jac_inv) do df2 = 1, ndf_w1 diff --git a/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w2_mod.F90 b/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w2_mod.F90 index 351086a38..6c91b47f6 100644 --- a/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w2_mod.F90 +++ b/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w2_mod.F90 @@ -22,6 +22,10 @@ module sci_compute_mass_matrix_kernel_w2_mod use fs_continuity_mod, only: Wchi use kernel_mod, only: kernel_type + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -138,7 +142,8 @@ subroutine compute_mass_matrix_w2_code(cell, nlayers, ncell_3d, & chi3_e(df) = chi3(map_chi(df) + k - 1) end do - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi, diff_basis_chi, jac, dj) do df2 = 1, ndf_w2 diff --git a/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w3_mod.F90 b/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w3_mod.F90 index dfbf5b0e5..ac030d6be 100644 --- a/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w3_mod.F90 +++ b/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w3_mod.F90 @@ -18,10 +18,13 @@ module sci_compute_mass_matrix_kernel_w3_mod CELL_COLUMN, GH_QUADRATURE_XYoZ use sci_coordinate_jacobian_mod, only: coordinate_jacobian use constants_mod, only: i_def, r_single, r_double - use finite_element_config_mod, only: rehabilitate use fs_continuity_mod, only: W3 use kernel_mod, only: kernel_type + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system, rehabilitate + use planet_config_mod, only: scaled_radius + implicit none private @@ -138,7 +141,9 @@ subroutine compute_mass_matrix_w3_code_r_single( & chi3_e(df) = chi3(map_chi(df) + k - 1) end do - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, & + call coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, & chi1_e, chi2_e, chi3_e, & ipanel, basis_chi, & diff_basis_chi, jac, dj) @@ -229,7 +234,9 @@ subroutine compute_mass_matrix_w3_code_mixed_precision( & chi3_e(df) = chi3(map_chi(df) + k - 1) end do - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, & + call coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, & chi1_e, chi2_e, chi3_e, & ipanel, basis_chi, & diff_basis_chi, jac, dj) @@ -320,7 +327,9 @@ subroutine compute_mass_matrix_w3_code_r_double( & chi3_e(df) = chi3(map_chi(df) + k - 1) end do - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, & + call coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, & chi1_e, chi2_e, chi3_e, & ipanel, basis_chi, & diff_basis_chi, jac, dj) diff --git a/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w_scalar_mod.F90 b/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w_scalar_mod.F90 index f63540f33..a5b0054b1 100644 --- a/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w_scalar_mod.F90 +++ b/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w_scalar_mod.F90 @@ -24,6 +24,10 @@ module sci_compute_mass_matrix_kernel_w_scalar_mod use fs_continuity_mod, only: W0, Wtheta, Wchi use kernel_mod, only: kernel_type + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -161,7 +165,9 @@ subroutine compute_mass_matrix_w_scalar_code_r32( & chi3_e(df) = chi3(map_chi(df) + k - 1) end do - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, & + call coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, & chi1_e, chi2_e, chi3_e, ipanel, & basis_chi, diff_basis_chi, & jac, dj) @@ -257,7 +263,9 @@ subroutine compute_mass_matrix_w_scalar_code_r32r64( & chi3_e(df) = chi3(map_chi(df) + k - 1) end do - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, & + call coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, & chi1_e, chi2_e, chi3_e, ipanel, & basis_chi, diff_basis_chi, & jac, dj) @@ -356,7 +364,9 @@ subroutine compute_mass_matrix_w_scalar_code_r64( & chi3_e(df) = chi3(map_chi(df) + k - 1) end do - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, & + call coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, & chi1_e, chi2_e, chi3_e, ipanel, & basis_chi, diff_basis_chi, & jac, dj) diff --git a/components/science/source/kernel/fem/sci_gp_rhs_kernel_mod.F90 b/components/science/source/kernel/fem/sci_gp_rhs_kernel_mod.F90 index c2a874845..ca6d73d1e 100644 --- a/components/science/source/kernel/fem/sci_gp_rhs_kernel_mod.F90 +++ b/components/science/source/kernel/fem/sci_gp_rhs_kernel_mod.F90 @@ -96,6 +96,10 @@ subroutine gp_rhs_code(nlayers, & use sci_coordinate_jacobian_mod, only: coordinate_jacobian + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -135,7 +139,11 @@ subroutine gp_rhs_code(nlayers, & chi_2_cell(df) = chi_2( map_chi(df) + k ) chi_3_cell(df) = chi_3( map_chi(df) + k ) end do - call coordinate_jacobian(ndf_chi, & + call coordinate_jacobian(coord_system, & + geometry, & + topology, & + scaled_radius, & + ndf_chi, & nqp_h, & nqp_v, & chi_1_cell, & diff --git a/components/science/source/kernel/fem/sci_gp_vector_rhs_kernel_mod.F90 b/components/science/source/kernel/fem/sci_gp_vector_rhs_kernel_mod.F90 index 114b58b6f..0db2fbe49 100644 --- a/components/science/source/kernel/fem/sci_gp_vector_rhs_kernel_mod.F90 +++ b/components/science/source/kernel/fem/sci_gp_vector_rhs_kernel_mod.F90 @@ -14,8 +14,6 @@ module sci_gp_vector_rhs_kernel_mod ANY_DISCONTINUOUS_SPACE_3, & GH_BASIS, GH_DIFF_BASIS, & CELL_COLUMN, GH_QUADRATURE_XYoZ - use base_mesh_config_mod, only : geometry, & - geometry_spherical use sci_chi_transform_mod, only : chi2xyz use constants_mod, only : r_def, i_def use sci_coordinate_jacobian_mod, only : coordinate_jacobian, & @@ -24,6 +22,11 @@ module sci_gp_vector_rhs_kernel_mod use fs_continuity_mod, only : W0, W2 use kernel_mod, only : kernel_type + use base_mesh_config_mod, only: geometry, topology, & + geometry_spherical + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -171,7 +174,11 @@ subroutine gp_vector_rhs_code(nlayers, & chi_2_cell(df) = chi_2( map_chi(df) + k ) chi_3_cell(df) = chi_3( map_chi(df) + k ) end do - call coordinate_jacobian(ndf_chi, & + call coordinate_jacobian(coord_system, & + geometry, & + topology, & + scaled_radius, & + ndf_chi, & nqp_h, & nqp_v, & chi_1_cell, & diff --git a/components/science/source/kernel/fem/sci_mg_derham_mat_kernel_mod.F90 b/components/science/source/kernel/fem/sci_mg_derham_mat_kernel_mod.F90 index e40bb543f..04329bd5b 100644 --- a/components/science/source/kernel/fem/sci_mg_derham_mat_kernel_mod.F90 +++ b/components/science/source/kernel/fem/sci_mg_derham_mat_kernel_mod.F90 @@ -27,6 +27,10 @@ module sci_mg_derham_mat_kernel_mod use fs_continuity_mod, only: W2, W3, wtheta use kernel_mod, only: kernel_type + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -178,7 +182,9 @@ subroutine mg_derham_mat_code(cell, nlayers, & do qp2 = 1, nqp_v do qp1 = 1, nqp_h ! Precompute some frequently used terms - call pointwise_coordinate_jacobian(ndf_chi, chi1_e, chi2_e, chi3_e, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi(:,:,qp1,qp2), & diff_basis_chi(:,:,qp1,qp2), & jac, dj) diff --git a/components/science/source/kernel/geometry/sci_calc_da_at_w2_kernel_mod.F90 b/components/science/source/kernel/geometry/sci_calc_da_at_w2_kernel_mod.F90 index d69363c65..e351c679d 100644 --- a/components/science/source/kernel/geometry/sci_calc_da_at_w2_kernel_mod.F90 +++ b/components/science/source/kernel/geometry/sci_calc_da_at_w2_kernel_mod.F90 @@ -80,6 +80,10 @@ subroutine calc_dA_at_w2_code( nlayers, & use sci_coordinate_jacobian_mod, only: coordinate_jacobian, coordinate_jacobian_inverse + use finite_element_config_mod, only: coord_system + use base_mesh_config_mod, only: geometry, topology + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -120,8 +124,9 @@ subroutine calc_dA_at_w2_code( nlayers, & chi2_e(df) = chi2(map_chi(df) + k) chi3_e(df) = chi3(map_chi(df) + k) end do - call coordinate_jacobian(ndf_chi, ndf_w2, chi1_e, chi2_e, chi3_e, & - ipanel, basis_chi, diff_basis_chi, jacobian, dj) + call coordinate_jacobian( coord_system, geometry, topology, scaled_radius, & + ndf_chi, ndf_w2, chi1_e, chi2_e, chi3_e, & + ipanel, basis_chi, diff_basis_chi, jacobian, dj) call coordinate_jacobian_inverse(ndf_w2, jacobian, dj, jac_inv) diff --git a/components/science/source/kernel/geometry/sci_calc_detj_at_w2_kernel_mod.F90 b/components/science/source/kernel/geometry/sci_calc_detj_at_w2_kernel_mod.F90 index d1447a72f..de29f199a 100644 --- a/components/science/source/kernel/geometry/sci_calc_detj_at_w2_kernel_mod.F90 +++ b/components/science/source/kernel/geometry/sci_calc_detj_at_w2_kernel_mod.F90 @@ -82,6 +82,10 @@ subroutine calc_detj_at_w2_code( nlayers, & use sci_coordinate_jacobian_mod, only: pointwise_coordinate_jacobian + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -119,7 +123,9 @@ subroutine calc_detj_at_w2_code( nlayers, & end do do df = 1,ndf_w2 - call pointwise_coordinate_jacobian(ndf_chi, chi1_e, chi2_e, chi3_e, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi(:,:,df), & diff_basis_chi(:,:,df), & jacobian, detj) diff --git a/components/science/source/kernel/geometry/sci_calc_detj_at_w3_kernel_mod.F90 b/components/science/source/kernel/geometry/sci_calc_detj_at_w3_kernel_mod.F90 index ba6a1cfca..a9aef1b6d 100644 --- a/components/science/source/kernel/geometry/sci_calc_detj_at_w3_kernel_mod.F90 +++ b/components/science/source/kernel/geometry/sci_calc_detj_at_w3_kernel_mod.F90 @@ -20,6 +20,10 @@ module sci_calc_detj_at_w3_kernel_mod use fs_continuity_mod, only : W3 use kernel_mod, only : kernel_type + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -128,7 +132,9 @@ subroutine calc_detj_at_w3_code_r_single( nlayers, & end do do df = 1,ndf_w3 - call pointwise_coordinate_jacobian(ndf_chi, chi1_e, chi2_e, chi3_e, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi(:,:,df), & diff_basis_chi(:,:,df), & jacobian, detj) @@ -190,7 +196,9 @@ subroutine calc_detj_at_w3_code_r_double( nlayers, & end do do df = 1,ndf_w3 - call pointwise_coordinate_jacobian(ndf_chi, chi1_e, chi2_e, chi3_e, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi(:,:,df), & diff_basis_chi(:,:,df), & jacobian, detj) diff --git a/components/science/source/kernel/geometry/sci_calc_directional_detj_at_w2_kernel_mod.F90 b/components/science/source/kernel/geometry/sci_calc_directional_detj_at_w2_kernel_mod.F90 index 80093d8a9..f9bd1ee16 100644 --- a/components/science/source/kernel/geometry/sci_calc_directional_detj_at_w2_kernel_mod.F90 +++ b/components/science/source/kernel/geometry/sci_calc_directional_detj_at_w2_kernel_mod.F90 @@ -96,6 +96,10 @@ subroutine calc_directional_detj_at_w2_code( nlayers, & use sci_coordinate_jacobian_mod, only: pointwise_coordinate_jacobian + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -142,7 +146,9 @@ subroutine calc_directional_detj_at_w2_code( nlayers, & chi3_e(cdf) = chi3(map_chi(cdf) + k) end do - call pointwise_coordinate_jacobian(ndf_chi, chi1_e, chi2_e, chi3_e, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi(:,:,df), & diff_basis_chi(:,:,df), & jacobian, detj) diff --git a/components/science/source/kernel/geometry/sci_chi_transform_mod.F90 b/components/science/source/kernel/geometry/sci_chi_transform_mod.F90 index 4192c8791..39ccfe0fb 100644 --- a/components/science/source/kernel/geometry/sci_chi_transform_mod.F90 +++ b/components/science/source/kernel/geometry/sci_chi_transform_mod.F90 @@ -13,11 +13,6 @@ !------------------------------------------------------------------------------ module sci_chi_transform_mod -use base_mesh_config_mod, only : geometry, & - geometry_spherical, & - geometry_planar, & - topology, & - topology_fully_periodic use constants_mod, only : r_def, i_def, l_def, & str_def, EPS, PI, rmdi use coord_transform_mod, only : alphabetar2xyz, & @@ -28,15 +23,21 @@ module sci_chi_transform_mod mesh_rotation_matrix, & schmidt_transform_xyz, & inverse_schmidt_transform_xyz -use finite_element_config_mod, only : coord_system, & - coord_system_xyz, & - coord_system_native use log_mod, only : log_event, & log_scratch_space, & LOG_LEVEL_ERROR, & LOG_LEVEL_DEBUG, & LOG_LEVEL_WARNING use matrix_invert_mod, only : matrix_invert_3x3 + +use base_mesh_config_mod, only : geometry, & + geometry_spherical, & + geometry_planar, & + topology, & + topology_fully_periodic +use finite_element_config_mod, only : coord_system, & + coord_system_xyz, & + coord_system_native use planet_config_mod, only : scaled_radius implicit none @@ -89,7 +90,9 @@ module sci_chi_transform_mod !! argument, and ideally should only be used for !! unit-testing. !------------------------------------------------------------------------------ -subroutine init_chi_transforms(mesh_collection, north_pole_arg, equator_lat_arg) +subroutine init_chi_transforms( geometry, topology, & + mesh_collection, & + north_pole_arg, equator_lat_arg ) use local_mesh_mod, only : local_mesh_type use mesh_collection_mod, only : mesh_collection_type @@ -97,6 +100,9 @@ subroutine init_chi_transforms(mesh_collection, north_pole_arg, equator_lat_arg) implicit none + integer(i_def), intent(in) :: geometry + integer(i_def), intent(in) :: topology + type(mesh_collection_type), optional, intent(in) :: mesh_collection real(kind=r_def), optional, intent(in) :: north_pole_arg(2) real(kind=r_def), optional, intent(in) :: equator_lat_arg diff --git a/components/science/source/kernel/geometry/sci_coordinate_jacobian_mod.F90 b/components/science/source/kernel/geometry/sci_coordinate_jacobian_mod.F90 index df0a05e4d..c0c0d4524 100644 --- a/components/science/source/kernel/geometry/sci_coordinate_jacobian_mod.F90 +++ b/components/science/source/kernel/geometry/sci_coordinate_jacobian_mod.F90 @@ -10,14 +10,7 @@ !> per panel for certain meshes such as cubed sphere. module sci_coordinate_jacobian_mod - use base_mesh_config_mod, only: geometry, & - geometry_planar, & - topology, & - topology_fully_periodic - use constants_mod, only: l_def, i_def, r_double, r_single - use finite_element_config_mod, only: coord_system, & - coord_system_xyz, & - coord_system_native + use constants_mod, only: l_def, i_def, r_def, r_double, r_single use coord_transform_mod, only: PANEL_ROT_MATRIX, & alphabetar2xyz, & xyz2llr, & @@ -25,12 +18,17 @@ module sci_coordinate_jacobian_mod llr2xyz, & schmidt_transform_lat - use planet_config_mod, only: scaled_radius use sci_chi_transform_mod, only: get_mesh_rotation_matrix, & get_to_stretch, & get_to_rotate, & get_stretch_factor + ! Configuration modules + use base_mesh_config_mod, only: geometry_planar, & + topology_fully_periodic + use finite_element_config_mod, only: coord_system_xyz, & + coord_system_native + implicit none private @@ -39,6 +37,7 @@ module sci_coordinate_jacobian_mod public :: coordinate_jacobian_inverse public :: pointwise_coordinate_jacobian public :: pointwise_coordinate_jacobian_inverse + ! Public for unit-testing public :: jacobian_stretched @@ -120,19 +119,27 @@ module sci_coordinate_jacobian_mod !> J^{i,j} = \frac{\partial \chi_i} / {\partial \hat{\chi_j}} !> \f} !> - !! @param[in] ndf Size of the chi arrays - !! @param[in] ngp_h Number of quadrature points in horizontal direction - !! @param[in] ngp_v Number of quadrature points in vertical direction - !! @param[in] chi_1 1st component of the coordinate field - !! @param[in] chi_2 2nd component of the coordinate field - !! @param[in] chi_3 3rd component of the coordinate field - !! @param[in] panel_id An integer identifying the mesh panel - !! @param[in] basis Wchi basis functions - !! @param[in] diff_basis Grad of Wchi basis functions - !! @param[out] jac Jacobian on quadrature points - !! @param[out] dj Determinant of the Jacobian on quadrature points + !! @param[in] coord_system Finite-element coordinate system enumeration. + !! @param[in] geometry Mesh geometry enumeration. + !! @param[in] topology Mesh topology enumeration. + !! @param[in] scaled_radius Scaled planetary radius. + !! @param[in] ndf Size of the chi arrays + !! @param[in] ngp_h Number of quadrature points in horizontal direction + !! @param[in] ngp_v Number of quadrature points in vertical direction + !! @param[in] chi_1 1st component of the coordinate field + !! @param[in] chi_2 2nd component of the coordinate field + !! @param[in] chi_3 3rd component of the coordinate field + !! @param[in] panel_id An integer identifying the mesh panel + !! @param[in] basis Wchi basis functions + !! @param[in] diff_basis Grad of Wchi basis functions + !! @param[out] jac Jacobian on quadrature points + !! @param[out] dj Determinant of the Jacobian on quadrature points !! - subroutine coordinate_jacobian_quadrature_r_single( & + subroutine coordinate_jacobian_quadrature_r_single( & + coord_system, & + geometry, & + topology, & + scaled_radius, & ndf, ngp_h, ngp_v, & chi_1, chi_2, chi_3, & panel_id, basis, & @@ -143,6 +150,11 @@ subroutine coordinate_jacobian_quadrature_r_single( & !----------------------------------------------------------------------------- implicit none + integer(kind=i_def), intent(in) :: coord_system + integer(kind=i_def), intent(in) :: geometry + integer(kind=i_def), intent(in) :: topology + real(kind=r_def), intent(in) :: scaled_radius + integer(kind=i_def), intent(in) :: ndf, ngp_h, ngp_v integer(kind=i_def), intent(in) :: panel_id @@ -228,9 +240,9 @@ subroutine coordinate_jacobian_quadrature_r_single( & ! Apply stretching --------------------------------------------------- if (to_stretch) then ! Convert chi to spherical polar (un-stretched) coordinates - call alphabetar2xyz(alpha_vec(k), beta_vec(k), radius_vec(k), panel_id, & + call alphabetar2xyz(alpha_vec(k), beta_vec(k), radius_vec(k), panel_id, & native_x, native_y, native_z) - call xyz2ll(native_x, native_y, native_z, & + call xyz2ll(native_x, native_y, native_z, & native_lon, native_lat) stretch_factor = real(get_stretch_factor(), r_single) jac_S = jacobian_stretched(native_lon, native_lat, radius_vec(k), stretch_factor) @@ -286,7 +298,11 @@ subroutine coordinate_jacobian_quadrature_r_single( & end subroutine coordinate_jacobian_quadrature_r_single - subroutine coordinate_jacobian_quadrature_r_double( & + subroutine coordinate_jacobian_quadrature_r_double( & + coord_system, & + geometry, & + topology, & + scaled_radius, & ndf, ngp_h, ngp_v, & chi_1, chi_2, chi_3, & panel_id, basis, & @@ -297,6 +313,11 @@ subroutine coordinate_jacobian_quadrature_r_double( & !----------------------------------------------------------------------------- implicit none + integer(kind=i_def), intent(in) :: coord_system + integer(kind=i_def), intent(in) :: geometry + integer(kind=i_def), intent(in) :: topology + real(kind=r_def), intent(in) :: scaled_radius + integer(kind=i_def), intent(in) :: ndf, ngp_h, ngp_v integer(kind=i_def), intent(in) :: panel_id @@ -382,9 +403,9 @@ subroutine coordinate_jacobian_quadrature_r_double( & ! Apply stretching --------------------------------------------------- if (to_stretch) then ! Convert chi to spherical polar (un-stretched) coordinates - call alphabetar2xyz(alpha_vec(k), beta_vec(k), radius_vec(k), panel_id, & + call alphabetar2xyz(alpha_vec(k), beta_vec(k), radius_vec(k), panel_id, & native_x, native_y, native_z) - call xyz2ll(native_x, native_y, native_z, & + call xyz2ll(native_x, native_y, native_z, & native_lon, native_lat) stretch_factor = real(get_stretch_factor(), r_double) jac_S = jacobian_stretched(native_lon, native_lat, radius_vec(k), stretch_factor) @@ -450,17 +471,25 @@ end subroutine coordinate_jacobian_quadrature_r_double !> reference space \f[ \hat{\chi} \f] to physical space \f[ \chi \f] !> \f[ J^{i,j} = \frac{\partial \chi_i} / {\partial \hat{\chi_j}} \f] !> and the determinant det(J) - !! @param[in] ndf Size of the chi arrays - !! @param[in] neval_points Number of points basis functions are evaluated on - !! @param[in] chi_1 1st component of the coordinate field - !! @param[in] chi_2 2nd component of the coordinate field - !! @param[in] chi_3 3rd component of the coordinate field - !! @param[in] panel_id An integer identifying the mesh panel - !! @param[in] basis Wchi basis functions - !! @param[in] diff_basis Grad of Wchi basis functions - !! @param[out] jac Jacobian on quadrature points - !! @param[out] dj Determinant of the Jacobian on quadrature points - subroutine coordinate_jacobian_evaluator_r_single( & + !! @param[in] coord_system Finite-element coordinate system enumeration. + !! @param[in] geometry Mesh geometry enumeration. + !! @param[in] topology Mesh topology enumeration. + !! @param[in] scaled_radius Scaled planetary radius. + !! @param[in] ndf Size of the chi arrays + !! @param[in] neval_points Number of points basis functions are evaluated on + !! @param[in] chi_1 1st component of the coordinate field + !! @param[in] chi_2 2nd component of the coordinate field + !! @param[in] chi_3 3rd component of the coordinate field + !! @param[in] panel_id An integer identifying the mesh panel + !! @param[in] basis Wchi basis functions + !! @param[in] diff_basis Grad of Wchi basis functions + !! @param[out] jac Jacobian on quadrature points + !! @param[out] dj Determinant of the Jacobian on quadrature points + subroutine coordinate_jacobian_evaluator_r_single( & + coord_system, & + geometry, & + topology, & + scaled_radius, & ndf, neval_points, & chi_1, chi_2, chi_3, & panel_id, basis, & @@ -471,6 +500,11 @@ subroutine coordinate_jacobian_evaluator_r_single( & !----------------------------------------------------------------------------- implicit none + integer(kind=i_def), intent(in) :: coord_system + integer(kind=i_def), intent(in) :: geometry + integer(kind=i_def), intent(in) :: topology + real(kind=r_def), intent(in) :: scaled_radius + integer(kind=i_def), intent(in) :: ndf, neval_points integer(kind=i_def), intent(in) :: panel_id @@ -590,7 +624,11 @@ subroutine coordinate_jacobian_evaluator_r_single( & end subroutine coordinate_jacobian_evaluator_r_single - subroutine coordinate_jacobian_evaluator_r_double( & + subroutine coordinate_jacobian_evaluator_r_double( & + coord_system, & + geometry, & + topology, & + scaled_radius, & ndf, neval_points, & chi_1, chi_2, chi_3, & panel_id, basis, & @@ -601,6 +639,11 @@ subroutine coordinate_jacobian_evaluator_r_double( & !----------------------------------------------------------------------------- implicit none + integer(kind=i_def), intent(in) :: coord_system + integer(kind=i_def), intent(in) :: geometry + integer(kind=i_def), intent(in) :: topology + real(kind=r_def), intent(in) :: scaled_radius + integer(kind=i_def), intent(in) :: ndf, neval_points integer(kind=i_def), intent(in) :: panel_id @@ -869,21 +912,32 @@ end subroutine coordinate_jacobian_inverse_evaluator_r_double !> reference space \f[ \hat{\chi} \f] to physical space \f[ \chi \f] !> \f[ J^{i,j} = \frac{\partial \chi_i} / {\partial \hat{\chi_j}} \f] !> and the determinant det(J) for a single point - !! @param[in] ndf Size of the chi arrays - !! @param[in] chi_1 Coordinate field - !! @param[in] chi_2 Coordinate field - !! @param[in] chi_3 Coordinate field - !! @param[in] panel_id panel_id - !! @param[in] basis Wchi basis functions - !! @param[in] diff_basis Grad of Wchi basis functions - !! @param[out] jac Jacobian on quadrature points - !! @param[out] dj Determinant of the Jacobian on quadrature points - subroutine pointwise_coordinate_jacobian_r_single( & - ndf, chi_1, chi_2, chi_3, & - panel_id, basis, diff_basis, & - jac, dj ) + !! @param[in] coord_system Finite-element coordinate system enumeration. + !! @param[in] geometry Mesh geometry enumeration. + !! @param[in] topology Mesh topology enumeration. + !! @param[in] scaled_radius Scaled planetary radius. + !! @param[in] ndf Size of the chi arrays + !! @param[in] chi_1 Coordinate field + !! @param[in] chi_2 Coordinate field + !! @param[in] chi_3 Coordinate field + !! @param[in] panel_id panel_id + !! @param[in] basis Wchi basis functions + !! @param[in] diff_basis Grad of Wchi basis functions + !! @param[out] jac Jacobian on quadrature points + !! @param[out] dj Determinant of the Jacobian on quadrature points + subroutine pointwise_coordinate_jacobian_r_single( & + coord_system, geometry, & + topology, scaled_radius, & + ndf, chi_1, chi_2, chi_3, & + panel_id, basis, diff_basis, & + jac, dj ) implicit none + integer(kind=i_def), intent(in) :: coord_system + integer(kind=i_def), intent(in) :: geometry + integer(kind=i_def), intent(in) :: topology + real(kind=r_def), intent(in) :: scaled_radius + integer(kind=i_def), intent(in) :: ndf integer(kind=i_def), intent(in) :: panel_id @@ -990,12 +1044,19 @@ subroutine pointwise_coordinate_jacobian_r_single( & end subroutine pointwise_coordinate_jacobian_r_single - subroutine pointwise_coordinate_jacobian_r_double( & - ndf, chi_1, chi_2, chi_3, & - panel_id, basis, diff_basis, & - jac, dj ) + subroutine pointwise_coordinate_jacobian_r_double( & + coord_system, geometry, & + topology, scaled_radius, & + ndf, chi_1, chi_2, chi_3, & + panel_id, basis, diff_basis, & + jac, dj ) implicit none + integer(kind=i_def), intent(in) :: coord_system + integer(kind=i_def), intent(in) :: geometry + integer(kind=i_def), intent(in) :: topology + real(kind=r_def), intent(in) :: scaled_radius + integer(kind=i_def), intent(in) :: ndf integer(kind=i_def), intent(in) :: panel_id diff --git a/components/science/source/kernel/geometry/sci_native_jacobian_mod.F90 b/components/science/source/kernel/geometry/sci_native_jacobian_mod.F90 index 53a375d7b..9e6b7446e 100644 --- a/components/science/source/kernel/geometry/sci_native_jacobian_mod.F90 +++ b/components/science/source/kernel/geometry/sci_native_jacobian_mod.F90 @@ -13,27 +13,23 @@ !! This gives a data access optimisation. module sci_native_jacobian_mod - use base_mesh_config_mod, only: geometry, & - geometry_planar, & - topology, & - topology_fully_periodic use constants_mod, only: l_def, i_def, r_def, r_single - use finite_element_config_mod, only: coord_system, & - coord_system_xyz, & - coord_system_native use coord_transform_mod, only: PANEL_ROT_MATRIX, & alphabetar2xyz, & xyz2llr, & xyz2ll, & llr2xyz, & schmidt_transform_lat - - use planet_config_mod, only: scaled_radius use sci_chi_transform_mod, only: get_mesh_rotation_matrix, & get_to_stretch, & get_to_rotate, & get_stretch_factor + use finite_element_config_mod, only: coord_system_xyz, & + coord_system_native + use base_mesh_config_mod, only: geometry_planar, & + topology_fully_periodic + implicit none private @@ -53,22 +49,32 @@ module sci_native_jacobian_mod !> @brief Compute the Jacobian matrices at a 1D array of points (e.g. DoFs) !! for a whole column, using the native coordinates of the mesh - !> @param[in] ndf_chi Num DoFs per cell for coordinate fields - !> @param[in] nlayers Number of layers in the mesh - !> @param[in] chi_1 First native coord field, for a single cell - !> @param[in] chi_2 Second native coord field, for a single cell - !> @param[in] chi_3 Third native coord field, for the whole column - !> @param[in] panel_id Mesh panel ID value for the column - !> @param[in] basis Wchi basis, evaluated at a 1D array of points - !> @param[in] diff_basis Derivatives of Wchi basis functions, evaluated at + !! @param[in] coord_system Finite-element coordinate system enumeration. + !! @param[in] geometry Mesh geometry enumeration. + !! @param[in] topology Mesh topology enumeration. + !! @param[in] scaled_radius Scaled planetary radius. + !> @param[in] ndf_chi Num DoFs per cell for coordinate fields + !> @param[in] nlayers Number of layers in the mesh + !> @param[in] chi_1 First native coord field, for a single cell + !> @param[in] chi_2 Second native coord field, for a single cell + !> @param[in] chi_3 Third native coord field, for the whole column + !> @param[in] panel_id Mesh panel ID value for the column + !> @param[in] basis Wchi basis, evaluated at a 1D array of points + !> @param[in] diff_basis Derivatives of Wchi basis functions, evaluated at !! a 1D array of points !> @param[in,out] jac Array of Jacobian matrices to be calculated for !! a whole column !> @param[in,out] dj Jacobian determinants for the whole column - subroutine native_jacobian(ndf_chi, nlayers, chi_1, chi_2, chi_3, panel_id, & + subroutine native_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi, nlayers, chi_1, chi_2, chi_3, panel_id, & basis, diff_basis, jac, dj) implicit none + integer(kind=i_def), intent(in) :: coord_system + integer(kind=i_def), intent(in) :: geometry + integer(kind=i_def), intent(in) :: topology + real(kind=r_def), intent(in) :: scaled_radius + integer(kind=i_def), intent(in) :: ndf_chi integer(kind=i_def), intent(in) :: nlayers integer(kind=i_def), intent(in) :: panel_id diff --git a/components/science/source/kernel/geometry/sci_scale_by_detj_kernel_mod.F90 b/components/science/source/kernel/geometry/sci_scale_by_detj_kernel_mod.F90 index a4acdd020..04c411675 100644 --- a/components/science/source/kernel/geometry/sci_scale_by_detj_kernel_mod.F90 +++ b/components/science/source/kernel/geometry/sci_scale_by_detj_kernel_mod.F90 @@ -86,6 +86,10 @@ subroutine scale_by_detj_code(nlayers, & use sci_coordinate_jacobian_mod, only: pointwise_coordinate_jacobian + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -124,7 +128,9 @@ subroutine scale_by_detj_code(nlayers, & do df = 1,ndf_ws ! Compute detj at dof points - call pointwise_coordinate_jacobian(ndf_wx, chi1_e, chi2_e, chi3_e, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_wx, chi1_e, chi2_e, chi3_e, & ipanel, basis_wx(:,:,df), & diff_basis_wx(:,:,df), & jac, detj) diff --git a/components/science/source/kernel/inter_function_space/sci_compute_map_u_operators_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_compute_map_u_operators_kernel_mod.F90 index 722a5f256..a78f203d4 100644 --- a/components/science/source/kernel/inter_function_space/sci_compute_map_u_operators_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_compute_map_u_operators_kernel_mod.F90 @@ -113,12 +113,15 @@ subroutine compute_map_u_operators_code(cell, nlayers, ncell_3d_1, & nqp_h, nqp_v, wqp_h, wqp_v & ) - use base_mesh_config_mod, only : geometry, & - geometry_spherical, & - geometry_planar - use sci_chi_transform_mod, only : chi2llr + use sci_chi_transform_mod, only : chi2llr use sci_coordinate_jacobian_mod, only : coordinate_jacobian - use coord_transform_mod, only : sphere2cart_vector + use coord_transform_mod, only : sphere2cart_vector + + use finite_element_config_mod, only: coord_system + use base_mesh_config_mod, only: geometry, topology, & + geometry_spherical, & + geometry_planar + use planet_config_mod, only: scaled_radius implicit none @@ -173,7 +176,11 @@ subroutine compute_map_u_operators_code(cell, nlayers, ncell_3d_1, & chi_sph_3_cell(df) = chi_sph_3( map_chi_sph(df) + k ) end do - call coordinate_jacobian(ndf_chi_sph, & + call coordinate_jacobian(coord_system, & + geometry, & + topology, & + scaled_radius, & + ndf_chi_sph, & nqp_h, & nqp_v, & chi_sph_1_cell, & diff --git a/components/science/source/kernel/inter_function_space/sci_compute_sample_u_ops_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_compute_sample_u_ops_kernel_mod.F90 index c6426b267..4bfbb79e1 100644 --- a/components/science/source/kernel/inter_function_space/sci_compute_sample_u_ops_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_compute_sample_u_ops_kernel_mod.F90 @@ -26,14 +26,18 @@ module sci_compute_sample_u_ops_kernel_mod use constants_mod, only : r_def, i_def use fs_continuity_mod, only : W2broken, W3, Wtheta, Wchi use kernel_mod, only : kernel_type - use base_mesh_config_mod, only : geometry, geometry_spherical, & - geometry_planar use sci_chi_transform_mod, only : chi2llr use sci_coordinate_jacobian_mod, only : coordinate_jacobian, & coordinate_jacobian_inverse use coord_transform_mod, only : sphere2cart_vector use reference_element_mod, only : W, S, N, E, T, B + use finite_element_config_mod, only: coord_system + use base_mesh_config_mod, only: geometry, topology, & + geometry_spherical, & + geometry_planar + use planet_config_mod, only: scaled_radius + implicit none private @@ -176,8 +180,9 @@ subroutine compute_sample_u_ops_code( col, nlayers, & chi3_e(df_chi) = chi3(map_chi(df_chi) + k) end do - call coordinate_jacobian(ndf_chi, ndf_w2b, chi1_e, chi2_e, chi3_e, & - ipanel, chi_basis, chi_diff_basis, jacobian, dj) + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi, ndf_w2b, chi1_e, chi2_e, chi3_e, & + ipanel, chi_basis, chi_diff_basis, jacobian, dj) call coordinate_jacobian_inverse(ndf_w2b, jacobian, dj, jac_inv) ! X and Y components contribute equally to all W2 DoFs @@ -225,7 +230,8 @@ subroutine compute_sample_u_ops_code( col, nlayers, & chi3_e(df_chi) = chi3(map_chi(df_chi) + k) end do - call coordinate_jacobian(ndf_chi, ndf_w2b, chi1_e, chi2_e, chi3_e, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi, ndf_w2b, chi1_e, chi2_e, chi3_e, & ipanel, chi_basis, chi_diff_basis, jacobian, dj) call coordinate_jacobian_inverse(ndf_w2b, jacobian, dj, jac_inv) diff --git a/components/science/source/kernel/inter_function_space/sci_convert_hcurl_field_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_convert_hcurl_field_kernel_mod.F90 index 8cbc37847..a075503ae 100644 --- a/components/science/source/kernel/inter_function_space/sci_convert_hcurl_field_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_convert_hcurl_field_kernel_mod.F90 @@ -89,7 +89,13 @@ subroutine convert_hcurl_field_code(nlayers, & ndf_pid, undf_pid, map_pid & ) - use sci_coordinate_jacobian_mod, only: coordinate_jacobian, coordinate_jacobian_inverse + use sci_coordinate_jacobian_mod, only: coordinate_jacobian, & + coordinate_jacobian_inverse + + use finite_element_config_mod, only: coord_system + use base_mesh_config_mod, only: geometry, topology + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -124,7 +130,8 @@ subroutine convert_hcurl_field_code(nlayers, & chi2_e(df) = chi2(map_chi(df) + k) chi3_e(df) = chi3(map_chi(df) + k) end do - call coordinate_jacobian(ndf_chi, ndf,chi1_e, chi2_e, chi3_e, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi, ndf,chi1_e, chi2_e, chi3_e, & ipanel, basis_chi, diff_basis_chi, jacobian, dj) call coordinate_jacobian_inverse(ndf, jacobian, dj, jacobian_inv) do df = 1,ndf diff --git a/components/science/source/kernel/inter_function_space/sci_convert_hdiv_field_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_convert_hdiv_field_kernel_mod.F90 index bc56cbe84..a9b5d98c1 100644 --- a/components/science/source/kernel/inter_function_space/sci_convert_hdiv_field_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_convert_hdiv_field_kernel_mod.F90 @@ -99,6 +99,11 @@ subroutine convert_hdiv_field_code(nlayers, & ndf_pid, undf_pid, map_pid & ) use sci_coordinate_jacobian_mod, only: coordinate_jacobian + + use finite_element_config_mod, only: coord_system + use base_mesh_config_mod, only: geometry, topology + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -141,7 +146,8 @@ subroutine convert_hdiv_field_code(nlayers, & chi2_e(df) = chi2(map_chi(df) + k) chi3_e(df) = chi3(map_chi(df) + k) end do - call coordinate_jacobian(ndf_chi, ndf1, chi1_e, chi2_e, chi3_e, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi, ndf1, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi, diff_basis_chi, jacobian, dj) do df = 1,ndf1 diff --git a/components/science/source/kernel/inter_function_space/sci_convert_hdiv_native_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_convert_hdiv_native_kernel_mod.F90 index 24b789b88..b5e4782d6 100644 --- a/components/science/source/kernel/inter_function_space/sci_convert_hdiv_native_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_convert_hdiv_native_kernel_mod.F90 @@ -100,6 +100,10 @@ subroutine convert_hdiv_native_code(nlayers, & use sci_native_jacobian_mod, only: native_jacobian + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -149,10 +153,11 @@ subroutine convert_hdiv_native_code(nlayers, & do df_w2 = 1, ndf_w2 ! Compute Jacobian for whole column at this DoF - call native_jacobian( & - ndf_chi, nlayers, chi_1_e, chi_2_e, chi_3_e, ipanel, & - basis_chi(:,:,df_w2), diff_basis_chi(:,:,df_w2), jacobian, dj & - ) + call native_jacobian( & + coord_system, geometry, topology, scaled_radius, & + ndf_chi, nlayers, chi_1_e, chi_2_e, chi_3_e, ipanel, & + basis_chi(:,:,df_w2), diff_basis_chi(:,:,df_w2), & + jacobian, dj ) ! Create vector of HDiv values at this point vector_in(:,:) = 0.0_r_def diff --git a/components/science/source/kernel/inter_function_space/sci_convert_phys_to_hdiv_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_convert_phys_to_hdiv_kernel_mod.F90 index 9a6d2960e..fece67189 100644 --- a/components/science/source/kernel/inter_function_space/sci_convert_phys_to_hdiv_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_convert_phys_to_hdiv_kernel_mod.F90 @@ -106,12 +106,16 @@ subroutine convert_phys_to_hdiv_code( nlayers, & undf_pid, & map_pid ) - use base_mesh_config_mod, only : geometry_spherical use sci_chi_transform_mod, only : chi2llr use sci_coordinate_jacobian_mod, only : pointwise_coordinate_jacobian, & pointwise_coordinate_jacobian_inverse use coord_transform_mod, only : sphere2cart_vector + use base_mesh_config_mod, only: topology, & + geometry_spherical + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -163,7 +167,8 @@ subroutine convert_phys_to_hdiv_code( nlayers, & end do ! Compute Jacobian at this W2 point - call pointwise_coordinate_jacobian(ndf_chi, & + call pointwise_coordinate_jacobian(coord_system, geometry, topology, & + scaled_radius, ndf_chi, & chi_1_cell, chi_2_cell, chi_3_cell, & ipanel, & basis_chi(:,:,df_w2), & diff --git a/components/science/source/kernel/inter_function_space/sci_dg_convert_hdiv_field_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_dg_convert_hdiv_field_kernel_mod.F90 index 71c0acd92..a5f125b6f 100644 --- a/components/science/source/kernel/inter_function_space/sci_dg_convert_hdiv_field_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_dg_convert_hdiv_field_kernel_mod.F90 @@ -100,6 +100,11 @@ subroutine dg_convert_hdiv_field_code(nlayers, & ndf_pid, undf_pid, map_pid & ) use sci_coordinate_jacobian_mod, only: pointwise_coordinate_jacobian + + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -152,7 +157,9 @@ subroutine dg_convert_hdiv_field_code(nlayers, & chi2_e(dfx) = chi2(map_chi(dfx) + k) chi3_e(dfx) = chi3(map_chi(dfx) + k) end do - call pointwise_coordinate_jacobian(ndf_chi, chi1_e, chi2_e, chi3_e, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi(:,:,df), & diff_basis_chi(:,:,df), jacobian, dj) vector_in(:) = 0.0_r_def diff --git a/components/science/source/kernel/inter_function_space/sci_dg_convert_hdiv_native_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_dg_convert_hdiv_native_kernel_mod.F90 index 4d89fa4c8..1b93a5772 100644 --- a/components/science/source/kernel/inter_function_space/sci_dg_convert_hdiv_native_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_dg_convert_hdiv_native_kernel_mod.F90 @@ -104,6 +104,10 @@ subroutine dg_convert_hdiv_native_code(nlayers, & use sci_native_jacobian_mod, only: native_jacobian + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -137,7 +141,9 @@ subroutine dg_convert_hdiv_native_code(nlayers, & integer(kind=i_def) :: w2_idx, w3_idx, chi_idx real(kind=r_def) :: jacobian(nlayers,3,3), dj(nlayers) real(kind=r_def) :: vector_in(nlayers,3), vector_out(nlayers,3) - real(kind=r_def) :: chi_1_e(ndf_chi), chi_2_e(ndf_chi), chi_3_e(nlayers,ndf_chi) + real(kind=r_def) :: chi_1_e(ndf_chi) + real(kind=r_def) :: chi_2_e(ndf_chi) + real(kind=r_def) :: chi_3_e(nlayers,ndf_chi) integer(kind=i_def) :: ipanel @@ -154,17 +160,18 @@ subroutine dg_convert_hdiv_native_code(nlayers, & end do ! Compute Jacobian for whole column - call native_jacobian( & - ndf_chi, nlayers, chi_1_e, chi_2_e, chi_3_e, ipanel, & - basis_chi(:,:,df_w3), diff_basis_chi(:,:,df_w3), jacobian, dj & - ) + call native_jacobian( & + coord_system, geometry, topology, scaled_radius, & + ndf_chi, nlayers, chi_1_e, chi_2_e, chi_3_e, ipanel, & + basis_chi(:,:,df_w3), diff_basis_chi(:,:,df_w3), & + jacobian, dj ) ! Create vector of W2 values vector_in(:,:) = 0.0_r_def do df_w2 = 1, ndf_w2 w2_idx = map_w2(df_w2) do i = 1, 3 - vector_in(:,i) = vector_in(:,i) & + vector_in(:,i) = vector_in(:,i) & + hdiv_field(w2_idx : w2_idx+nlayers-1)*basis_w2(i,df_w2,1) end do end do diff --git a/components/science/source/kernel/inter_function_space/sci_project_w3_to_w2b_operator_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_project_w3_to_w2b_operator_kernel_mod.F90 index 426037eff..5fbf011d8 100644 --- a/components/science/source/kernel/inter_function_space/sci_project_w3_to_w2b_operator_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_project_w3_to_w2b_operator_kernel_mod.F90 @@ -100,6 +100,10 @@ subroutine project_w3_to_w2b_operator_code( cell, nlayers, & use sci_coordinate_jacobian_mod, only: pointwise_coordinate_jacobian + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -145,7 +149,9 @@ subroutine project_w3_to_w2b_operator_code( cell, nlayers, & projection_operator(ik,:,:) = 0.0_r_def do qp_v = 1,nqp_v do qp_h = 1,nqp_h - call pointwise_coordinate_jacobian(ndf_wx, chi1_e, chi2_e, chi3_e, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_wx, chi1_e, chi2_e, chi3_e, & ipanel, basis_wx(:,:,qp_h,qp_v), & diff_basis_wx(:,:,qp_h,qp_v), & jac, detj) diff --git a/components/science/source/kernel/inter_function_space/sci_project_ws_to_w1_operator_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_project_ws_to_w1_operator_kernel_mod.F90 index c8d849f7e..607c2782b 100644 --- a/components/science/source/kernel/inter_function_space/sci_project_ws_to_w1_operator_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_project_ws_to_w1_operator_kernel_mod.F90 @@ -106,9 +106,12 @@ subroutine project_ws_to_w1_operator_code( cell, nlayers, & pointwise_coordinate_jacobian_inverse use sci_chi_transform_mod, only: chi2llr use coord_transform_mod, only: sphere2cart_vector - use base_mesh_config_mod, only: geometry, & - geometry_spherical, & - geometry_planar + + use base_mesh_config_mod, only: geometry, topology, & + geometry_spherical, & + geometry_planar + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius implicit none @@ -173,7 +176,9 @@ subroutine project_ws_to_w1_operator_code( cell, nlayers, & ipanel, llr(1), llr(2), llr(3)) end if - call pointwise_coordinate_jacobian(ndf_wx, chi1_e, chi2_e, chi3_e, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_wx, chi1_e, chi2_e, chi3_e, & ipanel, basis_wx(:,:,qp_h,qp_v), & diff_basis_wx(:,:,qp_h,qp_v), & jac, detj) diff --git a/components/science/source/kernel/inter_function_space/sci_project_ws_to_w2_operator_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_project_ws_to_w2_operator_kernel_mod.F90 index 0d1f4ff08..a42d10188 100644 --- a/components/science/source/kernel/inter_function_space/sci_project_ws_to_w2_operator_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_project_ws_to_w2_operator_kernel_mod.F90 @@ -101,6 +101,10 @@ subroutine project_ws_to_w2_operator_code( cell, nlayers, & use sci_coordinate_jacobian_mod, only: pointwise_coordinate_jacobian + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -146,7 +150,9 @@ subroutine project_ws_to_w2_operator_code( cell, nlayers, & projection_operator(ik,:,:) = 0.0_r_def do qp_v = 1,nqp_v do qp_h = 1,nqp_h - call pointwise_coordinate_jacobian(ndf_wx, chi1_e, chi2_e, chi3_e, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_wx, chi1_e, chi2_e, chi3_e, & ipanel, basis_wx(:,:,qp_h,qp_v), & diff_basis_wx(:,:,qp_h,qp_v), & jac, detj) diff --git a/components/science/source/kernel/inter_function_space/sci_w3_to_w2_correction_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_w3_to_w2_correction_kernel_mod.F90 index 879d7f84c..24efd3b3b 100644 --- a/components/science/source/kernel/inter_function_space/sci_w3_to_w2_correction_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_w3_to_w2_correction_kernel_mod.F90 @@ -197,7 +197,7 @@ subroutine w3_to_w2_correction_code( & ! Add contribution to the averaged W2 field. Factor of 0.5 as there ! is a contribution from each face field_w2(map_w2(face)+k) = field_w2(map_w2(face)+k) - & - 0.5_r_def * gradient * displacement(map_w2h_2d(face)+k) + 0.5_r_def * gradient * displacement(map_w2h_2d(face)) end do else @@ -210,7 +210,7 @@ subroutine w3_to_w2_correction_code( & ! Add contribution to the averaged W2 field. Factor of 0.5 as there ! is a contribution from each face field_w2(map_w2(face)+k) = field_w2(map_w2(face)+k) - & - 0.5_r_def * gradient * displacement(map_w2h_2d(face)+k) + 0.5_r_def * gradient * displacement(map_w2h_2d(face)) end do end if end if diff --git a/components/science/source/kernel/inter_function_space/sci_wth_to_w0_average_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_wth_to_w0_average_kernel_mod.F90 index 571985cd3..cde614eaa 100644 --- a/components/science/source/kernel/inter_function_space/sci_wth_to_w0_average_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_wth_to_w0_average_kernel_mod.F90 @@ -83,9 +83,11 @@ subroutine wth_to_w0_average_code(nlayers, & ! Internal variables integer(kind=i_def) :: df, k - do k = 0, nlayers - do df = 1,4 ! Loop at the Bottom - field_w0(map_w0(df) + k) = field_w0(map_w0(df) + k) + field_wth(map_wtheta(1) + k)*rmultiplicity_w0(map_w0(df) + k) + do df = 1, 4 ! Use bottom four W0 DoFs in cell + do k = 0, nlayers + ! Use rmultiplicity from bottom layer to ensure appropriate average + field_w0(map_w0(df) + k) = field_w0(map_w0(df) + k) & + + field_wth(map_wtheta(1) + k)*rmultiplicity_w0(map_w0(df)) end do end do diff --git a/components/science/source/kernel/inter_mesh/sci_proj_mr_to_sh_rho_rhs_op_kernel_mod.F90 b/components/science/source/kernel/inter_mesh/sci_proj_mr_to_sh_rho_rhs_op_kernel_mod.F90 index 76511ae26..bbdee962a 100644 --- a/components/science/source/kernel/inter_mesh/sci_proj_mr_to_sh_rho_rhs_op_kernel_mod.F90 +++ b/components/science/source/kernel/inter_mesh/sci_proj_mr_to_sh_rho_rhs_op_kernel_mod.F90 @@ -125,6 +125,10 @@ subroutine proj_mr_to_sh_rho_rhs_op_code( & use sci_coordinate_jacobian_mod, only: coordinate_jacobian + use finite_element_config_mod, only: coord_system + use base_mesh_config_mod, only: geometry, topology + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -184,10 +188,12 @@ subroutine proj_mr_to_sh_rho_rhs_op_code( & end do ! Get detj for lower and upper half cells - call coordinate_jacobian(ndf_chi_dl, nqp_h, nqp_v, lower_chi_1_e, lower_chi_2_e, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi_dl, nqp_h, nqp_v, lower_chi_1_e, lower_chi_2_e, & lower_chi_3_e, ipanel, chi_dl_basis, chi_dl_diff_basis, & lower_jac, lower_dj) - call coordinate_jacobian(ndf_chi_dl, nqp_h, nqp_v, upper_chi_1_e, upper_chi_2_e, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi_dl, nqp_h, nqp_v, upper_chi_1_e, upper_chi_2_e, & upper_chi_3_e, ipanel, chi_dl_basis, chi_dl_diff_basis, & upper_jac, upper_dj) diff --git a/components/science/unit-test/algorithm/solver/sci_field_vector_mod_test.pf b/components/science/unit-test/algorithm/solver/sci_field_vector_mod_test.pf index 9eb563920..c5ab6cc8d 100644 --- a/components/science/unit-test/algorithm/solver/sci_field_vector_mod_test.pf +++ b/components/science/unit-test/algorithm/solver/sci_field_vector_mod_test.pf @@ -56,10 +56,8 @@ contains integer(i_def) :: mesh_id type(function_space_type), pointer :: w2_fs => null() - type(mesh_type), pointer :: mesh_out => null() type(mesh_type), pointer :: mesh_ptr => null() - integer(i_def) :: err integer :: i, undf real(r_def) :: sum1, min1, max1, sum2, min2, max2, scalar real(r_def) :: test, answer diff --git a/components/science/unit-test/kernel/algebra/dot_product_of_components_kernel_mod_test.pf b/components/science/unit-test/kernel/algebra/dot_product_of_components_kernel_mod_test.pf index 373eb81f7..fc4c5c624 100644 --- a/components/science/unit-test/kernel/algebra/dot_product_of_components_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/algebra/dot_product_of_components_kernel_mod_test.pf @@ -43,7 +43,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/algebra/set_any_dof_kernel_mod_test.pf b/components/science/unit-test/kernel/algebra/set_any_dof_kernel_mod_test.pf index cd3e90429..09c146f73 100644 --- a/components/science/unit-test/kernel/algebra/set_any_dof_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/algebra/set_any_dof_kernel_mod_test.pf @@ -46,7 +46,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/algebra/set_w1h_dofs_kernel_mod_test.pf b/components/science/unit-test/kernel/algebra/set_w1h_dofs_kernel_mod_test.pf index 964159e30..7e99fd66b 100644 --- a/components/science/unit-test/kernel/algebra/set_w1h_dofs_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/algebra/set_w1h_dofs_kernel_mod_test.pf @@ -45,7 +45,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/algebra/tri_matrix_vector_kernel_mod_test.pf b/components/science/unit-test/kernel/algebra/tri_matrix_vector_kernel_mod_test.pf index a34ba3c04..c54239248 100644 --- a/components/science/unit-test/kernel/algebra/tri_matrix_vector_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/algebra/tri_matrix_vector_kernel_mod_test.pf @@ -38,11 +38,10 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none - class(tri_matrix_vector_kernel_test_type), intent(inout) :: this call final_configuration() diff --git a/components/science/unit-test/kernel/fem/compute_broken_div_operator_kernel_mod_test.pf b/components/science/unit-test/kernel/fem/compute_broken_div_operator_kernel_mod_test.pf index 65f37e6fc..1b55bedf7 100644 --- a/components/science/unit-test/kernel/fem/compute_broken_div_operator_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_broken_div_operator_kernel_mod_test.pf @@ -7,7 +7,7 @@ !> module compute_broken_div_operator_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_dofmap_mod, & only : get_w0_m3x3_dofmap, & get_w3_m3x3_dofmap @@ -63,15 +63,15 @@ contains element_order_v=1_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/fem/compute_curl_operator_kernel_mod_test.pf b/components/science/unit-test/kernel/fem/compute_curl_operator_kernel_mod_test.pf index 50888b180..51792780b 100644 --- a/components/science/unit-test/kernel/fem/compute_curl_operator_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_curl_operator_kernel_mod_test.pf @@ -8,7 +8,7 @@ !> module compute_curl_operator_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_dofmap_mod, only : get_w0_m3x3_dofmap, & get_w3_m3x3_dofmap use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & @@ -66,15 +66,15 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/fem/compute_derham_matrices_kernel_mod_test.pf b/components/science/unit-test/kernel/fem/compute_derham_matrices_kernel_mod_test.pf index 50dd756d5..419bd61b8 100644 --- a/components/science/unit-test/kernel/fem/compute_derham_matrices_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_derham_matrices_kernel_mod_test.pf @@ -8,7 +8,7 @@ !> module compute_derham_matrices_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only: i_def, r_def, imdi use funit implicit none @@ -47,15 +47,15 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/fem/compute_div_operator_kernel_mod_test.pf b/components/science/unit-test/kernel/fem/compute_div_operator_kernel_mod_test.pf index 53474e517..c2e03822f 100644 --- a/components/science/unit-test/kernel/fem/compute_div_operator_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_div_operator_kernel_mod_test.pf @@ -8,7 +8,7 @@ !> module compute_div_operator_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_dofmap_mod, & only : get_w0_m3x3_dofmap, & get_w3_m3x3_dofmap @@ -64,15 +64,15 @@ contains element_order_v=1_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/fem/compute_grad_operator_kernel_mod_test.pf b/components/science/unit-test/kernel/fem/compute_grad_operator_kernel_mod_test.pf index da1dd8b61..40bf54429 100644 --- a/components/science/unit-test/kernel/fem/compute_grad_operator_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_grad_operator_kernel_mod_test.pf @@ -8,7 +8,7 @@ !> module compute_grad_operator_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & get_w1_m3x3_q3x3x3_size, & get_w3_m3x3_q3x3x3_size @@ -58,15 +58,15 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w0_mod_test.pf b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w0_mod_test.pf index f4f2296a8..3f690988e 100644 --- a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w0_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w0_mod_test.pf @@ -64,7 +64,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w1_mod_test.pf b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w1_mod_test.pf index 1d85c8213..9981b9412 100644 --- a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w1_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w1_mod_test.pf @@ -8,7 +8,7 @@ !> module compute_mass_matrix_kernel_w1_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_dofmap_mod, & only : get_w0_m3x3_dofmap, get_w3_m3x3_dofmap use get_unit_test_m3x3_q3x3x3_sizes_mod, & @@ -60,15 +60,15 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w2_mod_test.pf b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w2_mod_test.pf index 3e499f697..135907c6f 100644 --- a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w2_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w2_mod_test.pf @@ -8,7 +8,7 @@ !> module compute_mass_matrix_kernel_w2_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_dofmap_mod, & only : get_w0_m3x3_dofmap, get_w3_m3x3_dofmap use get_unit_test_m3x3_q3x3x3_sizes_mod, & @@ -60,15 +60,15 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w2b_mod_test.pf b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w2b_mod_test.pf index de1500edb..214c32247 100644 --- a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w2b_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w2b_mod_test.pf @@ -61,7 +61,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w3_mod_test.pf b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w3_mod_test.pf index 550e039c9..15edcf644 100644 --- a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w3_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w3_mod_test.pf @@ -8,7 +8,7 @@ !> module compute_mass_matrix_kernel_w3_mod_test - use constants_mod, only : i_def, r_def, r_single, r_double + use constants_mod, only : i_def, r_def, r_single, r_double, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & get_w3_m3x3_q3x3x3_size @@ -60,15 +60,15 @@ contains element_order_v = 0_i_def, & rehabilitate = .true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_wtheta_mod_test.pf b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_wtheta_mod_test.pf index e214ebfb4..81bfe9693 100644 --- a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_wtheta_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_wtheta_mod_test.pf @@ -8,7 +8,7 @@ !> module compute_mass_matrix_kernel_wtheta_mod_test - use constants_mod, only : i_def, r_def, r_single, r_double, l_def + use constants_mod, only : i_def, r_def, r_single, r_double, l_def, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, & only : get_w0_m3x3_q3x3x3_size, & @@ -66,15 +66,15 @@ contains element_order_v = 0_i_def, & rehabilitate = .true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/fem/compute_trace_operator_kernel_mod_test.pf b/components/science/unit-test/kernel/fem/compute_trace_operator_kernel_mod_test.pf index e1f46051a..461b82c8e 100644 --- a/components/science/unit-test/kernel/fem/compute_trace_operator_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_trace_operator_kernel_mod_test.pf @@ -43,7 +43,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/fem/gp_rhs_kernel_mod_test.pf b/components/science/unit-test/kernel/fem/gp_rhs_kernel_mod_test.pf index eee93bfa4..115d35382 100644 --- a/components/science/unit-test/kernel/fem/gp_rhs_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/fem/gp_rhs_kernel_mod_test.pf @@ -7,7 +7,7 @@ !------------------------------------------------------------------------------- module gp_rhs_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use funit use quadrature_xyoz_mod, only: quadrature_xyoz_type, & quadrature_xyoz_proxy_type @@ -65,7 +65,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) qr = quadrature_xyoz_type(3, quadrature_rule) @@ -82,8 +82,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/fem/gp_vector_rhs_kernel_mod_test.pf b/components/science/unit-test/kernel/fem/gp_vector_rhs_kernel_mod_test.pf index 20f623a67..257ae2285 100644 --- a/components/science/unit-test/kernel/fem/gp_vector_rhs_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/fem/gp_vector_rhs_kernel_mod_test.pf @@ -71,7 +71,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(geometry_planar, topology_fully_periodic) qr = quadrature_xyoz_type(3, quadrature_rule) @@ -88,8 +88,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/fem/mg_derham_mat_kernel_mod_test.pf b/components/science/unit-test/kernel/fem/mg_derham_mat_kernel_mod_test.pf index 11bc64083..ed4780122 100644 --- a/components/science/unit-test/kernel/fem/mg_derham_mat_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/fem/mg_derham_mat_kernel_mod_test.pf @@ -8,7 +8,7 @@ !> module mg_derham_mat_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use funit implicit none @@ -47,15 +47,15 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/geometry/calc_da_at_w2_kernel_mod_test.pf b/components/science/unit-test/kernel/geometry/calc_da_at_w2_kernel_mod_test.pf index fee5e8bbb..22fd81315 100644 --- a/components/science/unit-test/kernel/geometry/calc_da_at_w2_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/calc_da_at_w2_kernel_mod_test.pf @@ -8,7 +8,7 @@ !> module calc_dA_at_w2_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & get_w2_m3x3_q3x3x3_size, & @@ -59,15 +59,15 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/geometry/calc_detj_at_w2_kernel_mod_test.pf b/components/science/unit-test/kernel/geometry/calc_detj_at_w2_kernel_mod_test.pf index 75650dd78..26d06c299 100644 --- a/components/science/unit-test/kernel/geometry/calc_detj_at_w2_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/calc_detj_at_w2_kernel_mod_test.pf @@ -8,7 +8,7 @@ !> module calc_detj_at_w2_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use funit use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & @@ -60,15 +60,15 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/geometry/calc_detj_at_w3_kernel_mod_test.pf b/components/science/unit-test/kernel/geometry/calc_detj_at_w3_kernel_mod_test.pf index 4d69854d1..dcf7ab7cd 100644 --- a/components/science/unit-test/kernel/geometry/calc_detj_at_w3_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/calc_detj_at_w3_kernel_mod_test.pf @@ -8,7 +8,7 @@ !> module calc_detj_at_w3_kernel_mod_test - use constants_mod, only : i_def, r_def, r_single, r_double + use constants_mod, only: imdi, i_def, r_def, r_single, r_double use funit use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & @@ -59,15 +59,15 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/geometry/calc_directional_detj_at_w2_kernel_mod_test.pf b/components/science/unit-test/kernel/geometry/calc_directional_detj_at_w2_kernel_mod_test.pf index 963c6ecff..dbb62e143 100644 --- a/components/science/unit-test/kernel/geometry/calc_directional_detj_at_w2_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/calc_directional_detj_at_w2_kernel_mod_test.pf @@ -8,7 +8,7 @@ !> module calc_directional_detj_at_w2_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use funit use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & @@ -58,15 +58,15 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/geometry/chi_transform_mod_test.pf b/components/science/unit-test/kernel/geometry/chi_transform_mod_test.pf index a72fce3f5..fd1f60bbd 100644 --- a/components/science/unit-test/kernel/geometry/chi_transform_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/chi_transform_mod_test.pf @@ -283,15 +283,20 @@ contains if ( this%source_coord_system == LLH_rot ) then north_pole(1) = PI/2.0_r_def north_pole(2) = 0.0_r_def - call init_chi_transforms(north_pole_arg=north_pole) + call init_chi_transforms(geometry_spherical, & + topology, & + north_pole_arg=north_pole) else if ( this%source_coord_system == ABH_stretch_rot ) then north_pole(1) = -PI/2.0_r_def north_pole(2) = 0.0_r_def equatorial_latitude = PI/6.0_r_def - call init_chi_transforms(north_pole_arg=north_pole, equator_lat_arg=equatorial_latitude) + call init_chi_transforms(geometry_spherical, & + topology, & + north_pole_arg=north_pole, & + equator_lat_arg=equatorial_latitude) else ! Non-rotated or stretched case - call init_chi_transforms() + call init_chi_transforms(geometry_spherical, topology) end if end subroutine setUp @@ -299,8 +304,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use sci_chi_transform_mod, only: final_chi_transforms - use configuration_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/geometry/compute_latlon_kernel_mod_test.pf b/components/science/unit-test/kernel/geometry/compute_latlon_kernel_mod_test.pf index 4b686f674..ee65c0293 100644 --- a/components/science/unit-test/kernel/geometry/compute_latlon_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/compute_latlon_kernel_mod_test.pf @@ -6,7 +6,7 @@ module compute_latlon_kernel_mod_test - use constants_mod, only : i_def, r_def, pi + use constants_mod, only : i_def, r_def, pi, imdi use get_unit_test_m3x3_dofmap_mod, & only : get_w3_m3x3_dofmap, get_wchi_m3x3_dofmap use get_unit_test_m3x3_q3x3x3_sizes_mod, & @@ -57,7 +57,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp @@ -65,7 +65,7 @@ contains subroutine tearDown( this ) use sci_chi_transform_mod, only: final_chi_transforms - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/geometry/coordinate_jacobian_alphabetaz_mod_test.pf b/components/science/unit-test/kernel/geometry/coordinate_jacobian_alphabetaz_mod_test.pf index 083909300..756a4c84b 100644 --- a/components/science/unit-test/kernel/geometry/coordinate_jacobian_alphabetaz_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/coordinate_jacobian_alphabetaz_mod_test.pf @@ -10,6 +10,10 @@ module coordinate_jacobian_alphabetaz_mod_test use funit use constants_mod, only : r_def, i_def + use base_mesh_config_mod, only : geometry_spherical, & + topology_fully_periodic + use finite_element_config_mod, only : coord_system_native + implicit none public :: set_up, tear_down, test_all @@ -22,46 +26,11 @@ contains @before subroutine set_up() - use base_mesh_config_mod, only : geometry_spherical, & - topology_fully_periodic - use extrusion_config_mod, only : method_uniform, & - stretching_method_linear - use finite_element_config_mod, only : cellshape_quadrilateral, & - coord_system_native - use feign_config_mod, only : feign_base_mesh_config, & - feign_extrusion_config, & - feign_finite_element_config, & - feign_planet_config - use sci_chi_transform_mod, only : init_chi_transforms + use sci_chi_transform_mod, only: init_chi_transforms implicit none - call feign_extrusion_config( method=method_uniform, & - planet_radius=radius, & - domain_height=10.0_r_def, & - number_of_layers=5_i_def, & - stretching_method=stretching_method_linear, & - stretching_height=15.0_r_def, & - eta_values=(/0.5_r_def/) ) - - call feign_base_mesh_config( file_prefix='foo', & - prime_mesh_name='unit_test', & - geometry=geometry_spherical, & - prepartitioned=.false., & - topology=topology_fully_periodic, & - fplane=.false., f_lat_deg=0.0_r_def ) - - call feign_finite_element_config( & - cellshape=cellshape_quadrilateral, & - coord_order=0_i_def, & - coord_system=coord_system_native, & - element_order_h=0_i_def, & - element_order_v=0_i_def, & - rehabilitate=.true. ) - - call feign_planet_config( scaling_factor=1.0_r_def ) - - call init_chi_transforms() + call init_chi_transforms(geometry_spherical, topology_fully_periodic) end subroutine set_up @@ -69,8 +38,8 @@ contains @after subroutine tear_down() - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none @@ -109,6 +78,11 @@ contains real(kind=r_def), parameter :: b = 0.1_r_def real(kind=r_def), parameter :: h = 2.0_r_def + integer(i_def), parameter :: coord_system = coord_system_native + integer(i_def), parameter :: geometry = geometry_spherical + integer(i_def), parameter :: topology = topology_fully_periodic + real(r_def), parameter :: scaled_radius = 1000.0_r_def + ! We choose a box centred on alpha = 0, beta = 0 alpha(:) = (/ -a, a, a, -a, -a, a, a, -a /) beta(:) = (/ -b, -b, b, b, -b, -b, b, b /) @@ -147,7 +121,8 @@ contains basis(:,:,:,:) = 0.125_r_def - call coordinate_jacobian(ndf, ngp, ngp, alpha, beta, height, ipanel, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf, ngp, ngp, alpha, beta, height, ipanel, & basis, diff_basis, jac, dj) call coordinate_jacobian_inverse(ngp,ngp, jac, dj, jac_inv) @@ -183,7 +158,9 @@ contains end do ! Test the pointwise computations - call pointwise_coordinate_jacobian(ndf, alpha, beta, height, ipanel, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf, alpha, beta, height, ipanel, & basis(:,:,1,1), diff_basis(:,:,1,1), & jac(:,:,1,1), dj(1,1) ) jac_inv(:,:,1,1) = pointwise_coordinate_jacobian_inverse(jac(:,:,1,1), & diff --git a/components/science/unit-test/kernel/geometry/coordinate_jacobian_lonlatz_mod_test.pf b/components/science/unit-test/kernel/geometry/coordinate_jacobian_lonlatz_mod_test.pf index f4f5fd353..3d717c8b0 100644 --- a/components/science/unit-test/kernel/geometry/coordinate_jacobian_lonlatz_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/coordinate_jacobian_lonlatz_mod_test.pf @@ -22,55 +22,16 @@ contains @before subroutine set_up() - use base_mesh_config_mod, only : geometry_spherical, & - topology_non_periodic - use extrusion_config_mod, only : method_uniform, & - stretching_method_linear - use finite_element_config_mod, only : cellshape_quadrilateral, & - coord_system_native - use feign_config_mod, only : feign_base_mesh_config, & - feign_extrusion_config, & - feign_finite_element_config, & - feign_planet_config - use sci_chi_transform_mod, only : init_chi_transforms - implicit none - call feign_base_mesh_config( file_prefix='foo', & - prime_mesh_name='unit_test', & - geometry=geometry_spherical, & - prepartitioned=.false., & - topology=topology_non_periodic, & - fplane=.false., f_lat_deg=0.0_r_def ) - - call feign_extrusion_config( method=method_uniform, & - planet_radius=radius, & - domain_height=10.0_r_def, & - number_of_layers=5_i_def, & - stretching_method=stretching_method_linear, & - stretching_height=15.0_r_def, & - eta_values=(/0.5_r_def/) ) - - call feign_finite_element_config( & - cellshape=cellshape_quadrilateral, & - coord_order=0_i_def, & - coord_system=coord_system_native, & - element_order_h=0_i_def, & - element_order_v=0_i_def, & - rehabilitate=.true. ) - - call feign_planet_config( scaling_factor=1.0_r_def ) - - call init_chi_transforms() - end subroutine set_up !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @after subroutine tear_down() - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none @@ -84,12 +45,17 @@ contains subroutine test_all() use, intrinsic :: iso_fortran_env, only: real64 + use sci_chi_transform_mod, only : init_chi_transforms use sci_coordinate_jacobian_mod, & only : coordinate_jacobian, & coordinate_jacobian_inverse, & pointwise_coordinate_jacobian, & pointwise_coordinate_jacobian_inverse + use base_mesh_config_mod, only: geometry_spherical, & + topology_non_periodic + use finite_element_config_mod, only: coord_system_native + implicit none real(kind=r_def), parameter :: tol = 1.0e-12_r_def ! r_def 64bit @@ -104,6 +70,11 @@ contains real(kind=r_def) :: basis(1,8,1,1), jac(3,3,1,1), dj(1,1), h real(kind=r_def) :: jac_inv(3,3,1,1), identity(3,3,1,1), err, answer(3,3) + integer(i_def), parameter :: coord_system = coord_system_native + integer(i_def), parameter :: geometry = geometry_spherical + integer(i_def), parameter :: topology = topology_non_periodic + real(r_def), parameter :: scaled_radius = 270.0_r_def + ! Box of length dlon, width dlat and height dh real(kind=r_def), parameter :: dlon = 0.2_r_def real(kind=r_def), parameter :: dlat = 0.1_r_def @@ -163,7 +134,10 @@ contains basis(:,:,:,:) = 0.125_r_def - call coordinate_jacobian(ndf, ngp, ngp, longitude, latitude, height, & + call init_chi_transforms(geometry, topology) + + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf, ngp, ngp, longitude, latitude, height, & ipanel, basis, diff_basis, jac, dj) call coordinate_jacobian_inverse(ngp, ngp, jac, dj, jac_inv) @@ -197,7 +171,9 @@ contains end do ! Test the pointwise computations - call pointwise_coordinate_jacobian(ndf, longitude, latitude, height, ipanel, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf, longitude, latitude, height, ipanel, & basis(:,:,1,1), diff_basis(:,:,1,1), & jac(:,:,1,1), dj(1,1) ) jac_inv(:,:,1,1) = pointwise_coordinate_jacobian_inverse(jac(:,:,1,1), dj(1,1)) diff --git a/components/science/unit-test/kernel/geometry/coordinate_jacobian_stretched_mod_test.pf b/components/science/unit-test/kernel/geometry/coordinate_jacobian_stretched_mod_test.pf index a560eaaff..5fda132f3 100644 --- a/components/science/unit-test/kernel/geometry/coordinate_jacobian_stretched_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/coordinate_jacobian_stretched_mod_test.pf @@ -65,7 +65,7 @@ contains @after subroutine tear_down() - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/geometry/coordinate_jacobian_xyz_mod_test.pf b/components/science/unit-test/kernel/geometry/coordinate_jacobian_xyz_mod_test.pf index 3f3379bbe..525348b9e 100644 --- a/components/science/unit-test/kernel/geometry/coordinate_jacobian_xyz_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/coordinate_jacobian_xyz_mod_test.pf @@ -8,7 +8,7 @@ module coordinate_jacobian_xyz_mod_test use funit - use constants_mod, only : r_def, i_def + use constants_mod, only : r_def, i_def, imdi implicit none @@ -28,32 +28,21 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine setUp( this ) - use finite_element_config_mod, only : cellshape_quadrilateral, & - coord_system_xyz - use feign_config_mod, only : feign_finite_element_config use sci_chi_transform_mod, only : init_chi_transforms implicit none class(jacobian_xyz_test_type), intent(inout) :: this - call feign_finite_element_config( & - cellshape=cellshape_quadrilateral, & - coord_order=0_i_def, & - coord_system=coord_system_xyz, & - element_order_h=0_i_def, & - element_order_v=0_i_def, & - rehabilitate=.true. ) - - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none @@ -74,12 +63,21 @@ contains pointwise_coordinate_jacobian, & pointwise_coordinate_jacobian_inverse + use finite_element_config_mod, only: coord_system_xyz + use base_mesh_config_mod, only: geometry_planar, & + topology_non_periodic + implicit none class(jacobian_xyz_test_type), intent(inout) :: this real(kind=r_def) :: tol, zero, one, two, eight + integer(i_def), parameter :: coord_system = coord_system_xyz + integer(i_def), parameter :: geometry = geometry_planar + integer(i_def), parameter :: topology = topology_non_periodic + real(r_def), parameter :: scaled_radius = 1.0_r_def + integer :: ndf = 8 integer :: ngp = 1 integer :: ipanel = 1 @@ -109,7 +107,8 @@ contains basis(:,:,:,:) = 0.125_r_def - call coordinate_jacobian(ndf, ngp, ngp, x, y, z, ipanel, basis, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf, ngp, ngp, x, y, z, ipanel, basis, & diff_basis, jac, dj) call coordinate_jacobian_inverse(ngp,ngp, jac, dj, jac_inv) @@ -137,7 +136,9 @@ contains @assertEqual( zero, err, tol) ! Test the pointwise computations - call pointwise_coordinate_jacobian(ndf, x, y, z, ipanel, basis(:,:,1,1), & + call pointwise_coordinate_jacobian(coord_system, geometry, topology, & + scaled_radius, & + ndf, x, y, z, ipanel, basis(:,:,1,1), & diff_basis(:,:,1,1), jac(:,:,1,1), & dj(1,1)) diff --git a/components/science/unit-test/kernel/geometry/get_dz_w3_kernel_mod_test.pf b/components/science/unit-test/kernel/geometry/get_dz_w3_kernel_mod_test.pf index b633343d3..9dede6d94 100644 --- a/components/science/unit-test/kernel/geometry/get_dz_w3_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/get_dz_w3_kernel_mod_test.pf @@ -66,7 +66,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/geometry/get_height_kernel_mod_test.pf b/components/science/unit-test/kernel/geometry/get_height_kernel_mod_test.pf index 066d58f8d..97ede147b 100644 --- a/components/science/unit-test/kernel/geometry/get_height_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/get_height_kernel_mod_test.pf @@ -70,7 +70,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/geometry/native_jacobian_alphabetaz_mod_test.pf b/components/science/unit-test/kernel/geometry/native_jacobian_alphabetaz_mod_test.pf index 74df5e0fe..53aed1296 100644 --- a/components/science/unit-test/kernel/geometry/native_jacobian_alphabetaz_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/native_jacobian_alphabetaz_mod_test.pf @@ -8,7 +8,10 @@ module native_jacobian_alphabetaz_mod_test use funit - use constants_mod, only : r_def, i_def + use constants_mod, only: r_def, i_def + use base_mesh_config_mod, only: geometry_spherical, & + topology_fully_periodic + use finite_element_config_mod, only: coord_system_native implicit none @@ -22,46 +25,11 @@ contains @before subroutine set_up() - use base_mesh_config_mod, only : geometry_spherical, & - topology_fully_periodic - use extrusion_config_mod, only : method_uniform, & - stretching_method_linear - use finite_element_config_mod, only : cellshape_quadrilateral, & - coord_system_native - use feign_config_mod, only : feign_base_mesh_config, & - feign_extrusion_config, & - feign_finite_element_config, & - feign_planet_config use sci_chi_transform_mod, only : init_chi_transforms implicit none - call feign_extrusion_config( method=method_uniform, & - planet_radius=radius, & - domain_height=10.0_r_def, & - number_of_layers=5_i_def, & - stretching_method=stretching_method_linear, & - stretching_height=15.0_r_def, & - eta_values=(/0.5_r_def/) ) - - call feign_base_mesh_config( file_prefix='foo', & - prime_mesh_name='unit_test', & - geometry=geometry_spherical, & - prepartitioned=.false., & - topology=topology_fully_periodic, & - fplane=.false., f_lat_deg=0.0_r_def ) - - call feign_finite_element_config( & - cellshape=cellshape_quadrilateral, & - coord_order=0_i_def, & - coord_system=coord_system_native, & - element_order_h=0_i_def, & - element_order_v=0_i_def, & - rehabilitate=.true. ) - - call feign_planet_config( scaling_factor=1.0_r_def ) - - call init_chi_transforms() + call init_chi_transforms(geometry_spherical, topology_fully_periodic) end subroutine set_up @@ -69,8 +37,8 @@ contains @after subroutine tear_down() - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none @@ -105,6 +73,11 @@ contains real(kind=r_def), parameter :: b = 0.1_r_def real(kind=r_def), parameter :: h = 2.0_r_def + integer(i_def), parameter :: coord_system = coord_system_native + integer(i_def), parameter :: geometry = geometry_spherical + integer(i_def), parameter :: topology = topology_fully_periodic + real(r_def), parameter :: scaled_radius = 1000.0_r_def + ! We choose a box centred on alpha = 0, beta = 0 alpha(:) = (/ -a, a, a, -a, -a, a, a, -a /) beta(:) = (/ -b, -b, b, b, -b, -b, b, b /) @@ -142,7 +115,8 @@ contains basis(:,:,:,:) = 0.125_r_def ! Test the pointwise computations - call native_jacobian(ndf, nlayers, alpha, beta, height, ipanel, & + call native_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf, nlayers, alpha, beta, height, ipanel, & basis(:,:,1,1), diff_basis(:,:,1,1), jac, dj) if ( r_def == real64 ) then diff --git a/components/science/unit-test/kernel/geometry/native_jacobian_lonlatz_mod_test.pf b/components/science/unit-test/kernel/geometry/native_jacobian_lonlatz_mod_test.pf index 7497009b6..e63daeeab 100644 --- a/components/science/unit-test/kernel/geometry/native_jacobian_lonlatz_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/native_jacobian_lonlatz_mod_test.pf @@ -10,6 +10,10 @@ module native_jacobian_lonlatz_mod_test use funit use constants_mod, only : r_def, i_def, PI + use base_mesh_config_mod, only: geometry_spherical, & + topology_non_periodic + use finite_element_config_mod, only: coord_system_native + implicit none public :: set_up, tear_down, test_all @@ -22,46 +26,11 @@ contains @before subroutine set_up() - use base_mesh_config_mod, only : geometry_spherical, & - topology_non_periodic - use extrusion_config_mod, only : method_uniform, & - stretching_method_linear - use finite_element_config_mod, only : cellshape_quadrilateral, & - coord_system_native - use feign_config_mod, only : feign_base_mesh_config, & - feign_extrusion_config, & - feign_finite_element_config, & - feign_planet_config - use sci_chi_transform_mod, only : init_chi_transforms + use sci_chi_transform_mod, only: init_chi_transforms implicit none - call feign_base_mesh_config( file_prefix='foo', & - prime_mesh_name='unit_test', & - geometry=geometry_spherical, & - prepartitioned=.false., & - topology=topology_non_periodic, & - fplane=.false., f_lat_deg=0.0_r_def ) - - call feign_extrusion_config( method=method_uniform, & - planet_radius=radius, & - domain_height=10.0_r_def, & - number_of_layers=5_i_def, & - stretching_method=stretching_method_linear, & - stretching_height=15.0_r_def, & - eta_values=(/0.5_r_def/) ) - - call feign_finite_element_config( & - cellshape=cellshape_quadrilateral, & - coord_order=0_i_def, & - coord_system=coord_system_native, & - element_order_h=0_i_def, & - element_order_v=0_i_def, & - rehabilitate=.true. ) - - call feign_planet_config( scaling_factor=1.0_r_def ) - - call init_chi_transforms() + call init_chi_transforms(geometry_spherical, topology_non_periodic) end subroutine set_up @@ -69,8 +38,8 @@ contains @after subroutine tear_down() - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none @@ -97,7 +66,13 @@ contains integer(kind=i_def) :: ipanel = 1 integer(kind=i_def) :: df, i, j - real(kind=r_def) :: longitude(8), latitude(8), height(1,8), diff_basis(3,8,1,1) + integer(i_def), parameter :: coord_system = coord_system_native + integer(i_def), parameter :: geometry = geometry_spherical + integer(i_def), parameter :: topology = topology_non_periodic + real(r_def), parameter :: scaled_radius = 270.0_r_def + + real(kind=r_def) :: longitude(8), latitude(8) + real(kind=r_def) :: height(1,8), diff_basis(3,8,1,1) real(kind=r_def) :: basis(1,8,1,1), jac(1,3,3), dj(1), h real(kind=r_def) :: answer(1,3,3), answer_dj(1) @@ -159,7 +134,8 @@ contains basis(:,:,:,:) = 0.125_r_def ! Test the pointwise computations - call native_jacobian(ndf, nlayers, longitude, latitude, height, ipanel, & + call native_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf, nlayers, longitude, latitude, height, ipanel, & basis(:,:,1,1), diff_basis(:,:,1,1), jac, dj) if ( r_def == real64 ) then diff --git a/components/science/unit-test/kernel/geometry/native_jacobian_stretched_mod_test.pf b/components/science/unit-test/kernel/geometry/native_jacobian_stretched_mod_test.pf index ae02ad272..a93348f38 100644 --- a/components/science/unit-test/kernel/geometry/native_jacobian_stretched_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/native_jacobian_stretched_mod_test.pf @@ -65,7 +65,7 @@ contains @after subroutine tear_down() - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/geometry/native_jacobian_xyz_mod_test.pf b/components/science/unit-test/kernel/geometry/native_jacobian_xyz_mod_test.pf index 4ccd5b67a..20a73605c 100644 --- a/components/science/unit-test/kernel/geometry/native_jacobian_xyz_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/native_jacobian_xyz_mod_test.pf @@ -8,7 +8,7 @@ module native_jacobian_xyz_mod_test use funit - use constants_mod, only : r_def, i_def + use constants_mod, only : r_def, i_def, imdi implicit none @@ -28,32 +28,21 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine setUp( this ) - use finite_element_config_mod, only : cellshape_quadrilateral, & - coord_system_xyz - use feign_config_mod, only : feign_finite_element_config - use sci_chi_transform_mod, only : init_chi_transforms + use sci_chi_transform_mod, only : init_chi_transforms implicit none class(jacobian_xyz_test_type), intent(inout) :: this - call feign_finite_element_config( & - cellshape=cellshape_quadrilateral, & - coord_order=0_i_def, & - coord_system=coord_system_xyz, & - element_order_h=0_i_def, & - element_order_v=0_i_def, & - rehabilitate=.true. ) - - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none @@ -68,7 +57,8 @@ contains @Test subroutine test_all( this ) - use sci_native_jacobian_mod, only : native_jacobian + use sci_native_jacobian_mod, only: native_jacobian + use finite_element_config_mod, only: coord_system_xyz implicit none @@ -82,6 +72,11 @@ contains integer :: ipanel = 1 integer :: df + integer(i_def), parameter :: coord_system = coord_system_xyz + integer(i_def), parameter :: geometry = imdi + integer(i_def), parameter :: topology = imdi + real(r_def), parameter :: scaled_radius = imdi + real(kind=r_def) :: x(8), y(8), z(1,8), diff_basis(3,8,1,1), basis(1,8,1,1) real(kind=r_def) :: jac(1,3,3), dj(1) @@ -104,7 +99,8 @@ contains basis(:,:,:,:) = 0.125_r_def ! Test the pointwise computations - call native_jacobian(ndf, nlayers, x, y, z, ipanel, basis(:,:,1,1), & + call native_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf, nlayers, x, y, z, ipanel, basis(:,:,1,1), & diff_basis(:,:,1,1), jac, dj) eight = 8.0_r_def diff --git a/components/science/unit-test/kernel/geometry/nodal_xyz_coordinates_kernel_mod_test.pf b/components/science/unit-test/kernel/geometry/nodal_xyz_coordinates_kernel_mod_test.pf index abebdd0af..01bccfc8e 100644 --- a/components/science/unit-test/kernel/geometry/nodal_xyz_coordinates_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/nodal_xyz_coordinates_kernel_mod_test.pf @@ -6,7 +6,7 @@ module nodal_xyz_coordinates_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & get_w2_m3x3_q3x3x3_size, & @@ -61,7 +61,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp @@ -69,7 +69,7 @@ contains subroutine tearDown( this ) use sci_chi_transform_mod, only: final_chi_transforms - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/geometry/scale_by_detj_kernel_mod_test.pf b/components/science/unit-test/kernel/geometry/scale_by_detj_kernel_mod_test.pf index d65dd97f0..7e7a21976 100644 --- a/components/science/unit-test/kernel/geometry/scale_by_detj_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/scale_by_detj_kernel_mod_test.pf @@ -7,7 +7,7 @@ !> Test the scale by detJ kernel module scale_by_detj_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use funit use get_unit_test_wthetanodal_basis_mod, only : get_w0_wthetanodal_basis, & get_w0_wthetanodal_diff_basis @@ -49,15 +49,15 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/compute_map_u_operators_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/compute_map_u_operators_kernel_mod_test.pf index 1d218ac27..2a5c4dd49 100644 --- a/components/science/unit-test/kernel/inter_function_space/compute_map_u_operators_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/compute_map_u_operators_kernel_mod_test.pf @@ -61,7 +61,7 @@ contains call feign_planet_config( scaling_factor=1.0_r_def ) - call init_chi_transforms() + call init_chi_transforms(geometry_spherical,topology_non_periodic) end subroutine set_up @@ -69,8 +69,8 @@ contains @after subroutine tear_down() - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/compute_sample_u_ops_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/compute_sample_u_ops_kernel_mod_test.pf index 20d9ce641..f5fda906e 100644 --- a/components/science/unit-test/kernel/inter_function_space/compute_sample_u_ops_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/compute_sample_u_ops_kernel_mod_test.pf @@ -63,7 +63,7 @@ contains call feign_planet_config( scaling_factor=scaling ) - call init_chi_transforms() + call init_chi_transforms(geometry_spherical, topology_non_periodic) end subroutine set_up @@ -71,8 +71,8 @@ contains @after subroutine tear_down() - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/convert_hcurl_field_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/convert_hcurl_field_kernel_mod_test.pf index 563bcdab7..3d7743e9a 100644 --- a/components/science/unit-test/kernel/inter_function_space/convert_hcurl_field_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/convert_hcurl_field_kernel_mod_test.pf @@ -6,7 +6,7 @@ module convert_hcurl_field_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & get_w1_m3x3_q3x3x3_size, & get_w3_m3x3_q3x3x3_size @@ -55,15 +55,15 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/convert_hdiv_field_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/convert_hdiv_field_kernel_mod_test.pf index 28e712d54..bf164890c 100644 --- a/components/science/unit-test/kernel/inter_function_space/convert_hdiv_field_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/convert_hdiv_field_kernel_mod_test.pf @@ -6,7 +6,7 @@ module convert_hdiv_field_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & get_w2_m3x3_q3x3x3_size, & get_w3_m3x3_q3x3x3_size @@ -55,15 +55,15 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/convert_hdiv_native_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/convert_hdiv_native_kernel_mod_test.pf index 60ce7e2f2..f5874f147 100644 --- a/components/science/unit-test/kernel/inter_function_space/convert_hdiv_native_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/convert_hdiv_native_kernel_mod_test.pf @@ -6,7 +6,7 @@ module convert_hdiv_native_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & get_w2_m3x3_q3x3x3_size, & get_w3_m3x3_q3x3x3_size @@ -55,15 +55,15 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/convert_phys_to_hdiv_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/convert_phys_to_hdiv_kernel_mod_test.pf index 61802bbd0..247e482e9 100644 --- a/components/science/unit-test/kernel/inter_function_space/convert_phys_to_hdiv_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/convert_phys_to_hdiv_kernel_mod_test.pf @@ -56,15 +56,15 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(geometry_planar, topology_fully_periodic) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/dg_convert_hdiv_field_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/dg_convert_hdiv_field_kernel_mod_test.pf index 27cf34cda..7f4f63696 100644 --- a/components/science/unit-test/kernel/inter_function_space/dg_convert_hdiv_field_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/dg_convert_hdiv_field_kernel_mod_test.pf @@ -4,7 +4,8 @@ ! should have received as part of this distribution. !----------------------------------------------------------------------------- module dg_convert_hdiv_field_kernel_mod_test - use constants_mod, only : i_def, r_def + + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & get_w2_m3x3_q3x3x3_size, & get_w3_m3x3_q3x3x3_size, & @@ -58,15 +59,15 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/dg_convert_hdiv_native_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/dg_convert_hdiv_native_kernel_mod_test.pf index 7c263835e..16f6233b8 100644 --- a/components/science/unit-test/kernel/inter_function_space/dg_convert_hdiv_native_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/dg_convert_hdiv_native_kernel_mod_test.pf @@ -4,7 +4,7 @@ ! under which the code may be used. !----------------------------------------------------------------------------- module dg_convert_hdiv_native_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & get_w2_m3x3_q3x3x3_size, & get_w3_m3x3_q3x3x3_size @@ -56,15 +56,15 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/project_w3_to_w2b_operator_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/project_w3_to_w2b_operator_kernel_mod_test.pf index 0f2f906e9..6f8c4fe88 100644 --- a/components/science/unit-test/kernel/inter_function_space/project_w3_to_w2b_operator_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/project_w3_to_w2b_operator_kernel_mod_test.pf @@ -7,7 +7,7 @@ !> Test the kernel for computing the operator to projec from W3 to W2b module project_w3_to_w2b_operator_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use funit implicit none @@ -46,15 +46,15 @@ contains rehabilitate=.true., & coord_system=coord_system_xyz ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/project_ws_to_w1_operator_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/project_ws_to_w1_operator_kernel_mod_test.pf index 1e15845ee..3c8c17e91 100644 --- a/components/science/unit-test/kernel/inter_function_space/project_ws_to_w1_operator_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/project_ws_to_w1_operator_kernel_mod_test.pf @@ -68,15 +68,15 @@ contains rehabilitate=.true., & coord_system=coord_system_xyz ) - call init_chi_transforms() + call init_chi_transforms(geometry_planar,topology_fully_periodic) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/project_ws_to_w2_operator_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/project_ws_to_w2_operator_kernel_mod_test.pf index bd5b4ae33..c48388d5d 100644 --- a/components/science/unit-test/kernel/inter_function_space/project_ws_to_w2_operator_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/project_ws_to_w2_operator_kernel_mod_test.pf @@ -7,7 +7,7 @@ !> Test the projection from a scalar space to W2 module project_ws_to_w2_operator_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use funit implicit none @@ -46,15 +46,15 @@ contains rehabilitate=.true., & coord_system=coord_system_xyz ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/sample_w3_to_wtheta_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/sample_w3_to_wtheta_kernel_mod_test.pf index 5f3633ba0..9f87b1d06 100644 --- a/components/science/unit-test/kernel/inter_function_space/sample_w3_to_wtheta_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/sample_w3_to_wtheta_kernel_mod_test.pf @@ -54,7 +54,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/sample_wtheta_to_w3_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/sample_wtheta_to_w3_kernel_mod_test.pf index 7e67088f5..1f473d77a 100644 --- a/components/science/unit-test/kernel/inter_function_space/sample_wtheta_to_w3_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/sample_wtheta_to_w3_kernel_mod_test.pf @@ -52,7 +52,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/w3_to_w2_displacement_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/w3_to_w2_displacement_kernel_mod_test.pf index 79a9b86c9..c24a3b329 100644 --- a/components/science/unit-test/kernel/inter_function_space/w3_to_w2_displacement_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/w3_to_w2_displacement_kernel_mod_test.pf @@ -61,7 +61,7 @@ contains call feign_planet_config( scaling_factor=1.0_r_def ) - call init_chi_transforms() + call init_chi_transforms(geometry_spherical, topology_fully_periodic) end subroutine set_up @@ -69,8 +69,8 @@ contains @after subroutine tear_down() - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_mesh/apply_w3_to_sh_w3_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/apply_w3_to_sh_w3_kernel_mod_test.pf index 5beb63fd6..1f3347da4 100644 --- a/components/science/unit-test/kernel/inter_mesh/apply_w3_to_sh_w3_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/apply_w3_to_sh_w3_kernel_mod_test.pf @@ -39,7 +39,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/inter_mesh/consist_w2_to_sh_w2_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/consist_w2_to_sh_w2_kernel_mod_test.pf index dbebf14f7..5d8745c98 100644 --- a/components/science/unit-test/kernel/inter_mesh/consist_w2_to_sh_w2_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/consist_w2_to_sh_w2_kernel_mod_test.pf @@ -42,7 +42,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/inter_mesh/consist_w2h_to_sh_w2h_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/consist_w2h_to_sh_w2h_kernel_mod_test.pf index a5c1700db..3300ad325 100644 --- a/components/science/unit-test/kernel/inter_mesh/consist_w2h_to_sh_w2h_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/consist_w2h_to_sh_w2h_kernel_mod_test.pf @@ -42,7 +42,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/inter_mesh/consist_w2v_to_sh_w2v_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/consist_w2v_to_sh_w2v_kernel_mod_test.pf index 1a5b41e8c..5457d524d 100644 --- a/components/science/unit-test/kernel/inter_mesh/consist_w2v_to_sh_w2v_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/consist_w2v_to_sh_w2v_kernel_mod_test.pf @@ -41,7 +41,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/inter_mesh/consist_w3_to_sh_w3_op_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/consist_w3_to_sh_w3_op_kernel_mod_test.pf index 67dbf5a5e..43a2927eb 100644 --- a/components/science/unit-test/kernel/inter_mesh/consist_w3_to_sh_w3_op_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/consist_w3_to_sh_w3_op_kernel_mod_test.pf @@ -6,7 +6,7 @@ !> Test the consist_w3_to_sh_w3_op kernel !> module consist_w3_to_sh_w3_op_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w3_m3x3_q3x3x3_size use get_unit_test_m3x3_dofmap_mod, only : get_w3_m3x3_dofmap use funit @@ -48,14 +48,14 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_mesh/inject_sh_w3_to_wt_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/inject_sh_w3_to_wt_kernel_mod_test.pf index 535896cd9..24cad0316 100644 --- a/components/science/unit-test/kernel/inter_mesh/inject_sh_w3_to_wt_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/inject_sh_w3_to_wt_kernel_mod_test.pf @@ -52,7 +52,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/inter_mesh/inject_wt_to_sh_w3_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/inject_wt_to_sh_w3_kernel_mod_test.pf index 68872103c..f5467afc2 100644 --- a/components/science/unit-test/kernel/inter_mesh/inject_wt_to_sh_w3_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/inject_wt_to_sh_w3_kernel_mod_test.pf @@ -52,7 +52,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/inter_mesh/matrix_vector_shifted_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/matrix_vector_shifted_mod_test.pf index 8d820b98c..6af43fda9 100644 --- a/components/science/unit-test/kernel/inter_mesh/matrix_vector_shifted_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/matrix_vector_shifted_mod_test.pf @@ -39,7 +39,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/inter_mesh/proj_mr_to_sh_rho_rhs_op_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/proj_mr_to_sh_rho_rhs_op_kernel_mod_test.pf index 82aeebcc4..ee657d5e8 100644 --- a/components/science/unit-test/kernel/inter_mesh/proj_mr_to_sh_rho_rhs_op_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/proj_mr_to_sh_rho_rhs_op_kernel_mod_test.pf @@ -7,7 +7,7 @@ !> module proj_mr_to_sh_rho_rhs_op_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & get_w3_m3x3_q3x3x3_size, & get_wtheta_m3x3_q3x3x3_size @@ -59,18 +59,17 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none - class(proj_mr_to_sh_rho_rhs_op_test_type), intent(inout) :: this call final_configuration() diff --git a/components/science/unit-test/kernel/inter_mesh/proj_mr_to_sh_rho_rhs_update_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/proj_mr_to_sh_rho_rhs_update_kernel_mod_test.pf index 5e5d6fab5..6f3662348 100644 --- a/components/science/unit-test/kernel/inter_mesh/proj_mr_to_sh_rho_rhs_update_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/proj_mr_to_sh_rho_rhs_update_kernel_mod_test.pf @@ -39,11 +39,10 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none - class(proj_mr_to_sh_rho_rhs_update_kernel_test_type), intent(inout) :: this call final_configuration() diff --git a/components/science/unit-test/kernel/inter_mesh/sample_w2_to_sh_w2_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/sample_w2_to_sh_w2_kernel_mod_test.pf index 46972ee6e..a4d9ecfab 100644 --- a/components/science/unit-test/kernel/inter_mesh/sample_w2_to_sh_w2_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/sample_w2_to_sh_w2_kernel_mod_test.pf @@ -42,7 +42,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/inter_mesh/tri_solve_sh_rho_to_mr_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/tri_solve_sh_rho_to_mr_kernel_mod_test.pf index 2a632b4e7..7f6ed9ec8 100644 --- a/components/science/unit-test/kernel/inter_mesh/tri_solve_sh_rho_to_mr_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/tri_solve_sh_rho_to_mr_kernel_mod_test.pf @@ -37,11 +37,10 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none - class(tri_solve_sh_rho_to_mr_kernel_test_type), intent(inout) :: this call final_configuration() diff --git a/documentation/source/getting_started/installation/build_and_run.rst b/documentation/source/getting_started/installation/build_and_run.rst index 99e8e5f60..47b385182 100644 --- a/documentation/source/getting_started/installation/build_and_run.rst +++ b/documentation/source/getting_started/installation/build_and_run.rst @@ -19,56 +19,13 @@ A separate ``lfric_apps`` repository holds key science applications, such as ``lfric_atm``. The lfric_apps repository has a different set of instructions for building and testing apps, but largely they do the same thing. -Check-out a working copy ------------------------- +Obtain the code +--------------- -To checkout a working copy of the code to a new directory, named ``trunk`` in -this example, run this command: +Obtain the code from the Github repository and install it on your machine. -.. code-block:: - - fcm co https://code.metoffice.gov.uk/svn/lfric/LFRic/trunk trunk - -.. topic:: FCM Keywords - - Users of FCM may take advantage of its support for keywords to shorten this. - - Met Office developers should find they can use a site-wide keyword ``lfric.x`` - - .. code-block:: - - fcm co fcm:lfric.x-tr lfric_core_trunk - - Those without these site-wide keywords can set up their own locally. In - ``~/.metomi/fcm/keyword.cfg`` just add the following lines: - - .. code-block:: - - # LFRic repository - location{primary}[lfric] = https://code.metoffice.gov.uk/svn/lfric/LFRic - - You may now use the shortened URL: - - .. code-block:: - - fcm co fcm:lfric-tr - -If keywords are set up, to create a branch and check it out, run the following: - -.. code-block:: - - fcm bc MyBranchName fcm:lfric.x-tr - -The command will create a branch with your chosen name prefixed by the revision -number of the head of trunk. Assuming the current trunk revision is ``1234``, -the branch will be called ``r1234_MyBranchName``. The following checks the code -out and puts it into a directory called a ``working copy``. - -.. code-block:: - - fcm co r1234_MyBranchName [working_copy_name] - -If the working copy name is not specified, it defaults to the name of the branch. +The examples below assume you have cloned the repository or your fork of the +repository and placed it into a directory called ``lfric_core``. Building an application ----------------------- @@ -79,14 +36,15 @@ within its directory. .. code-block:: - cd r1234_MyBranchName/applications/simple_diffusion + cd lfric_core/applications/simple_diffusion make The ``make`` command will build the simple_diffusion executable and place it in the ``simple_diffusion/bin`` directory. It will also build and run any -integration and unit tests that the application has. The make command uses the -Makefile in the same directory as the application. The Makefile has a number of -optional arguments: +integration and unit tests that the application has. + +The make command uses the Makefile in the same directory as the application. The +Makefile has a number of optional arguments: * ``make build`` builds just the application executable. * ``make unit-tests`` builds and runs any the unit tests. @@ -98,10 +56,10 @@ optional arguments: lfric_apps repository, such as the lfric_atm atmosphere model, are different: - https://code.metoffice.gov.uk/trac/lfric_apps/wiki/local_builds + https://metoffice.github.io/lfric_apps/developer_guide/local_builds.html - The method is different because it needs to include steps to import external - code, including the LFRic core code. + The method is different because it includes steps to import external code, + including the LFRic core code. The Makefile has a number of optional variable settings that can be overridden. To see these, look in the file. More than one option can be supplied @@ -126,11 +84,19 @@ executable, the build process creates a ``working`` directory to hold the products of an executable build and a ``test`` directory to hold products of a build of the unit and integration tests. +If you are developing a change and testing builds within a branch, from time to +time you will want to commit changes to the upstream repository. A +``.gitignore`` file, found at the top-level of the directory tree, should +prevent you inadvertently including build artefacts in your commit if you ever +run a ``git add .`` command. But do use ``git status`` to be sure of what your +changeset includes. Note that it is always safer to use ``git add `` on the specific files you want to add/change. + Running ``make clean`` will remove the working, test and bin directories. After building an application from the command line, it can be useful to do a quick test to ensure it can run. Most applications in the lfric and lfric_apps -repository hold a simple example configuration in their ``example`` directory. +repository hold a simple example configuration in their ``example`` directory +(which is also included in the ``.gitignore`` file, so if you want to add or change files in the ``example`` directory, you will need to use ``git add -f ...``). After building, go into to the example directory and run the application, as follows: @@ -158,3 +124,17 @@ the top-level of the working copy: rose stem --group=developer cylc play + +Building the documentation +-------------------------- + +Documentation for the code exists as RST files in the documentation +directory. The directory includes a Makefile that runs Sphinx (currently using +v8.1.0 with the PyData Sphinx Theme 0.16.1) to generate html web pages. To build +the documentation and then view it with the Firefox browser: + +.. code-block:: + + cd lfric_core/documentation + make html + firefox build/html/index.html diff --git a/documentation/source/getting_started/installation/software_dependencies.rst b/documentation/source/getting_started/installation/software_dependencies.rst index e01304231..b50bf5d20 100644 --- a/documentation/source/getting_started/installation/software_dependencies.rst +++ b/documentation/source/getting_started/installation/software_dependencies.rst @@ -12,18 +12,18 @@ LFRic Applications ------------------ Given that most users of the LFRic core code are running applications such as -``lfric_atm`` that are stored in the separate "LFRic applications" repository, -`lfric_apps `_, it is worth +``lfric_atm`` that are stored in the separate "LFRic applications" , +`lfric_apps `_, it is worth describing the relation between the two repositories. Currently, the development of the two code bases is done hand-in-hand. Therefore, certain revisions of the core code are tagged with the -version number of the relevant ``lfric_apps`` release. For example, revision -51381 is tagged ``core2.1`` and works with the 2.1 LFRic apps release. +version number of the relevant ``lfric_apps`` release. For example, there exists +a revision tagged ``2025.12.1`` which works with the 3.0 LFRic apps release. Note, also, that any given revision of ``lfric_apps`` includes a -``dependencies.sh`` file in its top-level directory which references a specific -revision of the LFRic core code against which it will be built. +``dependencies.yaml`` file in its top-level directory which references a +specific revision of the LFRic core code against which it should be built. Compiler versions ----------------- @@ -43,7 +43,8 @@ Software Stack To build and run typical LFRic applications, the following software will be required. The numbers in parenthesis identify versions in use at the Met Office -for the revision of LFRic tagged ``core2.1``. +for the revision of LFRic tagged ``2025.12.1``, referencing the year and month +of the release. Common software which may already be installed on some HPC and research platforms: @@ -56,20 +57,16 @@ platforms: More specialist software for developing, building and running LFRic applications: - * FCM (2021.05.0). LFRic code is held in a Subversion repository. `FCM - `_ is an application that wraps - Subversion commands to help impose standard development workflows for LFRic - development. - * PSyclone (3.1.0), a code generation library used by LFRic for generating + * PSyclone (3.2.2), a code generation library used by LFRic for generating portable performance code. The `PSyclone documentation `_ list its own software dependencies, which include some Python packages and the following Fortran parser. - * fparser (0.2.0), a Fortran parser used by PSyclone. - * YAXT 0.10.0), an `MPI wrapper + * fparser (0.2.1), a Fortran parser used by PSyclone. + * YAXT 0.11.0), an `MPI wrapper `_ which supports MPI data exchange in LFRic application. - * XIOS (r2252) an `IO server library + * XIOS2 (r2701) an `IO server library `_ to support input and output of data to UGRID NetCDF files. * blitz (1.0.2), a `support library `_ @@ -90,6 +87,8 @@ application tests, or for processing documentation: `_ framework. * stylist (0.4.1): A `code style-checker `_. + * Sphinx v8.1.0, using the PyData Sphinx Theme 0.16.1 is used to generate the + Web documentation that is published alongside the code repository. * plantuml (1.2021.7): the LFRic repository holds formal descriptions of key LFRic classes using a format that can be rendered into UML diagrams by `plantuml `_. @@ -100,5 +99,5 @@ application tests, or for processing documentation: Future releases --------------- -About three releases of ``lfric_apps`` are planned to take place each year. The +About three releases of ``lfric_apps`` are planned to take place each year. The LFRic core code will be appropriately tagged against each such release. diff --git a/documentation/source/how_it_works/build_system/configurator.rst b/documentation/source/how_it_works/build_system/configurator.rst index 5d3361b94..347ca45fe 100644 --- a/documentation/source/how_it_works/build_system/configurator.rst +++ b/documentation/source/how_it_works/build_system/configurator.rst @@ -18,53 +18,139 @@ these structures and functions to access the configuration choices. To support parallel applications, the generated code manages the distribution of choices to all MPI ranks. -Usage ------ +The Configurator provides several python scripts found in +``infrastructure/build/tools``. Each of these scripts generate +Fortran source code that is specific to an application's metadata. -The Configurator calls three commands which may be found in -``infrastructure/build/tools`` and a separate tool -:ref:`rose_picker` which -converts the extended Rose metadata file into a JSON file. +.. _GenNmlLoader: -The first command takes the JSON file created by ``rose_picker`` and -creates a module for each namelist. Each module has procedures to read -a namelist configuration file for the namelist, to MPI broadcast -configuration choices and to access configuration choices:: +.. dropdown:: **GenerateNamelistLoader** - GenerateNamelist [-help] [-version] [-directory PATH] FILE + Takes a JSON file created by ``rose_picker`` from an applications + ``rose-meta.conf`` file. For each namelist described in the JSON file, a + Fortran module is generated. Each module has procedures to: -The ``-help`` and ``-version`` arguments cause the tool to tell you about -itself, then exit. + * Read the specifc namelist from a configuration file. + * Broadcast the namelist values across MPI ranks. + * Return the current namelist values as a generic/extended ``namelist_type``. -The ``FILE`` argument points to the metadata JSON file to -use. Generated source is put into the current working directory, or -into ``PATH`` if specified. + .. admonition:: Usage -The second command generates the code that calls procedures from the -previously generated namelist loading modules to actually read a -namelist configuration file:: + GenerateNamelistLoader + *[-help][-version][-directory PATH]* FILE - GenerateLoader [-help] [-version] [-verbose] FILE NAMELISTS... + ``-help`` | ``-version``: + Returns script information, then exits. + ``-directory PATH``: + Location of generated source. Default: current working directory. + ``FILE``: + JSON file containing the application metadata. -As before, ``-help`` and ``-version`` options reveal details about -the tool before exiting. +.. _GenConfigLoader: + +.. dropdown:: **GenerateConfigLoader** + + This generates the source module (``config_loader_mod.f90``) which controls + the loading of namelists from file and performs the broadcast of + configuration values to other MPI ranks. This module also retrieves the + namelist objects from the respective namelist configuration modules and + stores them in the applications configuration object (``config_type``). + + .. admonition:: Usage + + GenerateConfigLoader + *[-help][-version][-verbose][-directory PATH][-duplicate LISTNAME]* + NAMELISTS... + + ``-help`` | ``-version``: + Returns script information, then exits. + ``-directory PATH``: + Location of generated ``config_loader_mod.f90`` source. Default: current + working directory. + ``-duplicate LISTNAME``: + Adds LISTNAME to the set of namelists which allow duplicate instances. + ``NAMELISTS...``: + Space-separated list of one or more namelist names that the + ``config_loader_mod`` module will recognise for reading. Each namelist + listed will require a corresponding module generated by the + :ref:`GenerateNamelistLoader` script. + +.. _GenConfigType: + +.. dropdown:: **GenerateConfigType** + + Generates source code ``config_type_mod.f90`` which defines the type storing + the namelists specific to a given application. The ``config_type`` provides + (*mostly*) direct access to an applications configuration values. + + .. admonition:: Usage + + GenerateConfigType + *[-help][-version][-verbose][-directory PATH][-duplicate LISTNAME]* NAMELISTS... + + ``-help`` | ``-version``: + Returns script information, then exits. + ``-directory PATH``: + Location of generated ``config_type_mod.f90``. Defaul: current working + directory. + ``-duplicate LISTNAME``: + Optional argument to add LISTNAME to the set of namelists allowed + to have duplicate instances. + ``NAMELISTS...``: + Space-separated list of one or more namelist names that the ``config_type`` + will store. + +.. _GenExtNmlType: + +.. dropdown:: **GenerateExtendedNamelistType** + + Generates extended namelist type (``_nml_type``) specific to a + given namelist definition. One source module generated per defined namelist. + The resulting extended namelist type will allow direct access to the namelist + member values while remaining read-only. + + .. admonition:: Usage + + GenerateExtendedNamelistType + *[-help][-version][-verbose][-directory PATH]* FILE + + ``-help`` | ``-version``: + Returns script information, then exits. + ``-directory PATH``: + Location of generated source. Default: current working directory. + ``FILE``: + JSON file containing the application metadata. + +.. _GenFeign: + +.. dropdown:: **GenerateFeigns** + + Generates a module which provides procedures to directly configure + the contents of a namelist. This module should not be used within a + normal application. Instead, it is to allow test systems to + :ref:`feign` the reading of a namelist so + they can control the test environment: + + .. admonition:: Usage + + GenerateFeigns + *[-help] [-version] [-output FILE1]* FILE2 + + ``-help`` | ``-version``: + Caused the tool to tell you about itself, then exit. + ``-output FILE1``: + Generated source file is written FILE1, defaults to ``feign_config_mod.f90`` + in the current working directory, + ``FILE2``: + JSON metadata file created by ``rose-picker``. + +Ultimately, these scripts require an applications +extended Rose metadata in the form of a JSON file. + +For convienence, a separate tool, (:ref:`rose_picker`) +is used to convert the extended Rose metadata file into a JSON file. -The ``FILE`` is that of the resulting generated source file. Finally, -the ``NAMELISTS`` are a space-separated list of one or more namelist -names that the code will read. -The final command generates a module which provides procedures to -directly configuring the contents of a namelist. This module ought not -be used within a normal application. Instead, it is to allow test -systems to :ref:`feign ` the reading of a -namelist so they can control the test environment:: - GenerateFeigns [-help] [-version] [-output FILE1] FILE2 -Once again, ``-help`` and ``-version`` cause the command to exit after -giving its details. -The ``FILE2`` argument should point to a JSON metadata file created by -``rose-picker``. The resulting source file is written to ``FILE1``, or -to ``feign_config_mod.f90`` in the current working directory, if -``FILE1`` is not specified. diff --git a/documentation/source/how_to_use_it/components/driver.rst b/documentation/source/how_to_use_it/components/driver.rst index 9194cda64..7b3ac3d46 100644 --- a/documentation/source/how_to_use_it/components/driver.rst +++ b/documentation/source/how_to_use_it/components/driver.rst @@ -70,8 +70,7 @@ configuration files. ``_config_mod``, from which configuration options are extracted. These are the modules that are generated by the Configurator. Therefore, they cannot be found in the code bases of the application! See the - section on :ref:`how to use configuration information` for details of these files. + section on :ref:`how to use configuration information` for details of these files. The ``driver_config_mod`` component provides procedures for reading the configuration files created by the Configurator. @@ -85,25 +84,24 @@ Call the ``init_config`` procedure to read the namelist configuration. use driver_config_mod, only: init_config - type(namelist_collection_type) :: configuration + type(config_type) :: config - + ... - call init_config(filename, required_namelists, configuration) + call init_config(filename, required_namelists, config=config) Arguments are as follows: * ``filename``: The file containing the namelist configuration. * ``required_namelists``: A list of character strings containing the name of all the namelists that the application must read. -* ``configuration`` A ``namelist_collection_type`` which will be - loaded with the contents of the namelist configuration file. +* ``config``: A ``config_type`` which will be loaded with the contents + of the namelist configuration file. After reading the configuration file, the procedure checks whether all the namelists in the ``required_namelists`` array were present in the file, and reports an error if any are missing. -Once initialisation completes, applications can access -configuration information from the ``namelist_collection_type`` -:ref:`configuration object` or direct from the -:ref:`config_mod` files. +Once initialisation completes, applications can access configuration +information from the :ref:`config object` or direct +from the :ref:`config_mod` files. diff --git a/documentation/source/how_to_use_it/configuration/using_configuration.rst b/documentation/source/how_to_use_it/configuration/using_configuration.rst index a780bdba8..2668ccbc2 100644 --- a/documentation/source/how_to_use_it/configuration/using_configuration.rst +++ b/documentation/source/how_to_use_it/configuration/using_configuration.rst @@ -4,7 +4,7 @@ under which the code may be used. ----------------------------------------------------------------------------- -.. _using configuration: +.. _generating_configuration: Configuration code generation ============================= @@ -20,23 +20,33 @@ This section describes how to load an application configuration into the application, and how code can use the various types of application configuration. +.. _loading_configuration: + Loading the configuration ========================= -The Configurator generates a procedure, ``read_configuration``, to -read a namelist configuration file. Each namelist configuration is -stored in a ``namelist_type`` object. All the ``namelist_type`` -objects are stored in a ``namelist_collection_type`` object. +The Configurator generates a procedure (``read_configuration``) to read +a configuration file based on an application's metadata file (``.json``). +The configuration entails one or more Fortran namelists, which +are each read and stored in a namelist specific type +(`_nml_type`). These namelist objects are in turn stored +in a configuration object (`config_type`). + +This allows for multiple configurations to be loaded into a given +application. .. code-block:: fortran - use configuration_mod, only: read_configuration + use config_loader_mod, only: read_configuration - type(namelist_collection_type) :: configuration + type(config_type) :: config_A, config_B + ... - + call config_A%initialise( 'ConfigurationName_A' ) + call config_B%initialise( 'ConfigurationName_B' ) - call read_configuration( namelist_file, configuration ) + call read_configuration( namelist_file_A, config=config_A ) + call read_configuration( namelist_file_B, config=config_B ) The LFRic infrastructure provides a :ref:`driver configuration component` that orchestrates both reading of the @@ -44,42 +54,33 @@ namelist configuration file and cross-checking the contents to ensure all required namelists are present. The driver configuration component can be used instead of directly calling the above procedure. -.. _configuration object: +.. _using_config_object: -Using the Configuration Object +Using the Config Object ============================== -The term "configuration object" refers to an object of type -``namelist_collection_type``. It holds a number of ``namelist_type`` +The term "config object" refers to an object of type +``config_type``. It holds a number of extended ``namelist_type`` objects each of which holds the configuration choices for one of the -namelists. To access a namelist object, call the ``get_namelist`` -function on the namelist name: +namelists. To access a configuration value, simply reference +the configuration hirarchy in the ``config_type``, `e.g.` .. code-block:: fortran - use namelist_mod, only: namelist_type - use namelist_collection_mod, only : namelist_collection_type - - type(namelist_collection_type) :: configuration - - type(namelist_type), pointer :: base_mesh_nml - - base_mesh_nml => configuration%get_namelist('base_mesh') - -Then use the ``get_value`` function of the ``namelist_type`` object to -get the configuration value of a variable: + use config_mod, only: config_type -.. code-block:: fortran + type(config_type) :: config + character(str_def) :: name - character(str_def) :: mesh_name + name = config%base_mesh%mesh_name() - call base_mesh_nml%get_value('mesh_name', mesh_name) +.. _config_enumerations: Enumerations ------------ An enumeration is a variable that can take one of a small number of -fixed values. In the namelist the permitted values are strings, but +fixed values. In the namelist, the permitted values are strings, but within the code, the option and each of the permitted values are converted into integers. @@ -89,9 +90,9 @@ to check against. Enumerations are stored as ``i_def`` integers. The enumeration options are parameters that can be obtained directly from Configurator-generated ``_config_mod`` modules. -To illustrate, Rose metadata can configure the value of the -``geometry`` variable in the namelist so that it can be either the -string "spherical" or the string "planar". In the following code, is +To illustrate, Rose metadata specifies that the value of the +namelist variable ``geometry`` can be either the string "spherical" or +the string "planar". In the following code, the namelist entry is checked against two allowed choices of geometry: ``spherical`` and ``planar``, referenced by the two integer parameters in the ``base_mesh_config_mod`` module. The names of the parameters are @@ -105,8 +106,7 @@ duplication of parameter names with other enumeration variables: integer(i_def) :: geometry_choice real(r_def) :: domain_bottom - base_mesh_nml => configuration%get_namelist('base_mesh') - call base_mesh_nml%get_value('geometry', geometry_choice) + geometry_choice = config%base_mesh%geometry() select case (geometry_choice) case (geometry_planar) @@ -119,30 +119,41 @@ duplication of parameter names with other enumeration variables: .. admonition:: Hidden values - Use of enumerations can be better than using numerical options or - string variables. + Use of enumerations can be better than using numerical options or + string variables. + + A parameter name is more meaningful and memorable than a numerical + option, making code more readable. There is also a clearer link + between the name and the metadata, as the metadata can be easily + searched to find information about the option. - A parameter name is more meaningful and memorable than a numerical - option, making code more readable. There is also a clearer link - between the name and the metadata, as the metadata can be easily - searched to find information about the option. + Code that compares integer options and parameters is safer than code + that compares string options and parameters. If there are spelling + errors in the names in the code, the former will fail at compile + time whereas problems with the latter only arise at run-time. - Code that compares integer options and parameters is safer than code - that compares string options and parameters. If there are spelling - errors in the names in the code, the former will fail at compile - time whereas problems with the latter only arise at run-time. +.. _config_duplicate_namelists: -Duplicating namelists +Duplicate namelists --------------------- -Where namelists are duplicated, the possible values of the instance -variable can be used to distinguish between them. For example, for a -namelist ``partitioning`` with an instance key of ``mesh_choice``, -the relevant parts of the Rose metadata may look as follows:: +When a defined namelist is allowed to have multiple instances in a namelist +input file, the namelist is said to allow `duplicates` (with a given +configuration). This is indicated by the Rose metadata as ``duplicate=true``. +These namelist instances have the same variable names, though those varibles +may contain different values. + +Instances of a ``duplicate`` namelist may be differentiated using one of the +namelists members as a key. The :ref:`extended Rose metadata `, ``!instance_key_member`` +indicates to the configurator tool which namelist variable to use as the +instance key. For example, consider a ``partitioning`` namelist, with the +variable, ``mesh_choice`` used as the instance key member, the relevant parts +of the Rose metadata may look as follows:: [namelist:partitioning] duplicate=true - instance_key_member=mesh_choice + !instance_key_member=mesh_choice [namelist:partitioning=mesh_choice] !enumeration=true @@ -163,74 +174,50 @@ namelist each with a different ``mesh_choice``:: panel_decomposition = 'auto', / -The different namelist options can be extracted with the following -code (noting that the possible ``mesh_choice`` strings must be known -in the code): +To extract a *specific instance*, the possible ``mesh_choice`` string must be known: .. code-block:: fortran - ! Get namelist objects for the source and destination partitioning - source_partitioning_nml => & - configuration%get_namelist('partitioning', & - 'source') - destination_partitioning_nml => & - configuration%get_namelist('partitioning', & - 'destination') + type(partitioning_nml_iterator_type) :: iter + type(partitioning_nml_type), pointer :: partitioning_nml - ! Extract information from the two different namelist objects - call source_partitioning_nml%get_value('partitioner', & - source_partitioner) - call destination_partitioning_nml%get_value('partitioner', & - destination_partitioner) + call iter%initialise(config%partitioning) + do while (iter%has_next()) -.. _config_mod files: + partitioning_nml => iter%next() + mesh_choice = partitioning_nml%get_profile_name() -Using config_mod files -====================== + select case (trim(mesh_choice)) -In the examples above, the ``config_mod`` files were used only to -obtain the parameters that represent the options of an enumeration -variable. - -It is normally possible to obtain any variables direct from the -``config_mod`` files rather than going through the configuration -object functions. However, this method cannot work where namelists are -duplicated. Namelists can be duplicated by metadata definition as -described above, in which case values are distinguished by a key -variable. - -But applications can also be required to read two separate namelist -configurations where the same namelist appears in both. In these -cases, the application can load each configuration into two separate -configuration objects. This means that different parts of the -application can be passed different configuration objects, and the -data in the configuration object will be specific for that part of the -application. While the parameter values that define enumerator options -will be the same for both parts of the application, the values for the -first namelist in the ``config_mod`` file will be overwritten by the -second namelist to be read in. - -In the following example, the same requirement as the example above is -met by directly using the value of the ``geometry`` option from the -``config_mod`` file: + case('source') + srce_partitioner = partitioning_nml%partitioner() -.. code-block:: fortran + case('destination') + dest_partitioner = partitioning_nml%partitioner() - use base_mesh_config_mod, only: geometry_spherical, & - geometry_planar, & - geometry + end select - real(r_def) :: domain_bottom + end do - select case (geometry) - case (geometry_planar) - domain_bottom = 0.0_r_def - case (geometry_spherical) - domain_bottom = earth_radius - case default - call log_event("Invalid geometry", LOG_LEVEL_ERROR) - end select +.. _config_mod_files: + +Using configuration module files +================================ + +In the examples above, the ``config_mod`` modules were used **only** to +obtain the parameters that represent the options of an enumeration +variable. The preferred practice is to only use global scope +``config_mod`` modules to access fixed runtime parameters. + +.. admonition:: Configuration access via ``use`` statements. + + While existing code will allow access to any variables direct from + the ``config_mod`` files, this legacy practice is strongly + **discouraged**. Access via ``use`` statements cannot work where + namelists may have multiple instances or when an application wishes + to load multiple configuration files. It is recommended that access + to configuration namelists be limited to usage of the ``modeldb%config`` + item described above. -The ``default`` case would cause an error if ``geometry`` has not been -set or if it has been set to another valid value that is not supported -by this part of the code. + Direct access from ``*_config_mod`` modules will be restricted to + enumeration parameter values only by April 2026. diff --git a/documentation/source/how_to_use_it/deprecated/deprecated_configuration.rst b/documentation/source/how_to_use_it/deprecated/deprecated_configuration.rst new file mode 100644 index 000000000..d97c148a2 --- /dev/null +++ b/documentation/source/how_to_use_it/deprecated/deprecated_configuration.rst @@ -0,0 +1,59 @@ +.. _DeprecatedConfiguration: + +Modeldb Configuration Item +============================================== + +The ``configuration`` item (``namelist_collection_type``) within the ``modeldb`` +object stores the input namelists used to configure an instance of modeldb. +Once the configuration has been populated, the configuration values are +immutable, unlike other components of ``modeldb``. This item is **deprecated** +and use of the ``config`` item in ``modedb`` is the preferred configuration +access method. The component ``modeldb%configuration`` is marked for removal +after April 2026. + +.. Should provide a link to the namelist collection type (when it's written) #PR206 + +Initialising the configuration +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +The ``modeldb%configuration`` item is populated using a module generated +by the ``configurator`` tool. A namelist input file is simply read in and +any valid namelists are added the ``modeldb%configuration`` item. + +The ``configuration`` item is first initialised before reading a namelist input +file. + +.. code-block:: fortran + + use configuration_mod, only: read_configuration + + call modeldb%configuration%initialise() + call read_configuration( filename, configuration=modeldb%configuration ) + +.. _access_configuration_data: + +Accessing configuration data +^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +To access configuration data from the ``configuration`` item, a pointer to +the required namelist is first requested before the namelist variable +member can be retrieved. This allows for different namelists to have +member variables with the same name. + +.. code-block:: fortran + + type(namelist_type), pointer :: config_nml + + config_nml => modeldb%configuration%get_namelist('') + call config_nml%get_value( '', nml_var ) + +All namelists in the collection must have a unique ``, unless +the namelist metadata specfies ``duplicate=.true.``. For namelists which may +appear multiple times in a namelist file, the ``profile_name`` must also be +specified. + +.. code-block:: fortran + + type(namelist_type), pointer :: config_nml + + config_nml => modeldb%configuration%get_namelist( '', & + profile_name='' ) + call config_nml%get_value( '', nml_var ) diff --git a/documentation/source/how_to_use_it/deprecated/index.rst b/documentation/source/how_to_use_it/deprecated/index.rst new file mode 100644 index 000000000..fc4df4eba --- /dev/null +++ b/documentation/source/how_to_use_it/deprecated/index.rst @@ -0,0 +1,16 @@ +.. ----------------------------------------------------------------------------- + (c) Crown copyright Met Office. All rights reserved. + The file LICENCE, distributed with this code, contains details of the terms + under which the code may be used. + ----------------------------------------------------------------------------- + +.. _deprecated_index: + +Deprecated usage +================ + +.. toctree:: + :maxdepth: 1 + + deprecated_configuration + diff --git a/documentation/source/how_to_use_it/index.rst b/documentation/source/how_to_use_it/index.rst index 5d83a6480..a9a3d685b 100644 --- a/documentation/source/how_to_use_it/index.rst +++ b/documentation/source/how_to_use_it/index.rst @@ -23,3 +23,4 @@ How to use it build_and_test/index parallelism/index API/index + deprecated/index diff --git a/documentation/source/how_to_use_it/lfric_datamodel/modeldb.rst b/documentation/source/how_to_use_it/lfric_datamodel/modeldb.rst index 76b61b179..b1109d045 100644 --- a/documentation/source/how_to_use_it/lfric_datamodel/modeldb.rst +++ b/documentation/source/how_to_use_it/lfric_datamodel/modeldb.rst @@ -59,8 +59,8 @@ To add a collection to ``modeldb%fields`` use: .. code-block:: fortran - call modeldb%fields%add_empty_field_collection("my_collection", & - table_len = 100) + call modeldb%fields%add_empty_field_collection("my_collection", & + table_len = 100) where ``"my_collection"`` is the name of the field collection you want adding and the ``table_len`` is the length of the hash table that is @@ -76,11 +76,11 @@ To put a field into one of the collections .. code-block:: fortran - type( field_collection_type ), pointer :: my_collection - type( field_type ), :: my_field + type( field_collection_type ), pointer :: my_collection + type( field_type ), :: my_field - my_collection => modeldb%fields%get_field_collection("my_collection") - call my_collection%add_field(my_field) + my_collection => modeldb%fields%get_field_collection("my_collection") + call my_collection%add_field(my_field) This will put a copy of ``my_field`` into the collection. If you want to use the version held in the collection, you will need to retrieve a @@ -93,11 +93,11 @@ Assuming the field, ``my_field``, has the name "my_field", use: .. code-block:: fortran - type( field_collection_type ), pointer :: my_collection - type( field_type ), pointer :: my_field + type( field_collection_type ), pointer :: my_collection + type( field_type ), pointer :: my_field - my_collection => modeldb%fields%get_field_collection("my_collection") - call my_collection%get_field("my_field", my_field) + my_collection => modeldb%fields%get_field_collection("my_collection") + call my_collection%get_field("my_field", my_field) This returns a pointer to the actual field held in the collection. Any changes to the field you have extracted will instantly change the @@ -137,11 +137,11 @@ To put a value in .. code-block:: fortran - real(real64) :: my_value + real(real64) :: my_value - my_value = 7.0_real64 - call modeldb%values%initialise() - call modeldb%values%add_key_value('my_value', my_value) + my_value = 7.0_real64 + call modeldb%values%initialise() + call modeldb%values%add_key_value('my_value', my_value) Again, this will put a copy of the value into the collection @@ -150,9 +150,9 @@ To get a value out .. code-block:: fortran - real(real64), pointer :: my_value + real(real64), pointer :: my_value - call modeldb%values%get_value("my_value", my_value) + call modeldb%values%get_value("my_value", my_value) This returns a pointer to the value held in the collection. Any subsequent maths performed on what is returned (the pointer) will @@ -162,57 +162,56 @@ location in memory. Configuration ------------- -The configuration item within the modeldb object stores the input namelists -(from a namelist input file) used to configure an instance of modeldb. Once -the configuration has been populated from file, the configuration values are -immutable, unlike other components of modeldb. +The ``config`` item (`config_type`) within the ``modeldb`` object stores +the input namelists used to configure an instance of modeldb. Once the +``config`` item has been populated the configuration values are immutable, +unlike other components of modeldb. .. Should provide a link to the namelist collection type (when it's written) Initialising the configuration ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -The configration item is a `namelist collection type` and is populated using a -module generated by the `configurator` tool. A namelist input file is simply -read in and any valid namelists are added the modeldb%configuration item. +The ``config`` item is populated using a module generated by the +:ref:`Configurator` tool. A namelist input file is simply read +in and any valid namelists are added to the ``config`` item. -As with the ``values`` item, the ``configuration`` item must be initialised +As with the ``values`` item, the ``config`` item must be initialised prior to its first use. .. code-block:: fortran - use configuration_mod, only: read_configuration + use config_loader_mod, only: read_configuration - call modeldb%configuration%initialise() - call read_configuration( filename, modeldb%configuration ) + call modeldb%config%initialise() + call read_configuration( filename, config=modeldb%config ) .. _access_config_data: Accessing configuration data ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -To access data from the configuration item, a pointer to the required namelist -is first requested before the namelist variable member can be retrieved. This -allows for different namelists to have member variables with the same name. +To access configuration data from the ``config`` item, simply +reference the namelist member via its location in the configuration +hierachy. .. code-block:: fortran - type(namelist_type), pointer :: config_nml + MemberValue = modeldb%config%%() - config_nml => modeldb%configuration%get_namelist('') - call config_nml%get_value( '', nml_var ) - -All namelists in the collection must have a unique ``, unless -the namelist metadata specfies `duplicate=.true.`. For namelists which may -appear multiple times in a namelist file, the `profile_name` must also be -specified. +The access pattern for namelists which allow multiple instances +(with metadata ``duplicate=true``) is via an iterator which cycles +through instances of the namelist type. .. code-block:: fortran + :force: - type(namelist_type), pointer :: config_nml - - config_nml => modeldb%configuration%get_namelist( '', & - profile_name='' ) - call config_nml%get_value( '', nml_var ) + type( _nml_iterator_type ) :: iter + type( _nml_type ), pointer :: config_nml + call iter%initialise( modeldb%config% ) + do while ( iter%has_next() ) + config_nml => iter%next() + MemberValue = config_nml%() + end do I/O contexts ------------ @@ -231,10 +230,10 @@ To put an I/O context into the collection ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran - type( lfric_xios_context_type ) :: my_io_context + type( lfric_xios_context_type ) :: my_io_context - call modeldb%io_context%initialise() - call modeldb%io_contexts%add_context(my_io_context) + call modeldb%io_context%initialise() + call modeldb%io_contexts%add_context(my_io_context) This will put a copy of ``io_context`` into the collection. If you want to use the version held in the collection, you will need to @@ -247,8 +246,8 @@ Assuming the context, ``my_io_context``, has the name "my_io_context", use: .. code-block:: fortran - type( lfric_xios_context_type ) :: my_io_context + type( lfric_xios_context_type ) :: my_io_context - call modeldb%io_contexts%get_io_context("my_io_context", my_io_context) + call modeldb%io_contexts%get_io_context("my_io_context", my_io_context) This returns a pointer to the actual I/O context held in the collection. diff --git a/documentation/source/how_to_use_it/meshes/mesh_configuration_namelists.rst b/documentation/source/how_to_use_it/meshes/mesh_configuration_namelists.rst index bd68e46ef..36cfed950 100644 --- a/documentation/source/how_to_use_it/meshes/mesh_configuration_namelists.rst +++ b/documentation/source/how_to_use_it/meshes/mesh_configuration_namelists.rst @@ -258,8 +258,19 @@ depending on generator. ``custom`` Forces the partitioner to attempt to configure the panel into - partitions given by :ref:`panel_xproc` and - :ref:`panel_yproc`. + partitions given by :ref:`panel_xproc` and + :ref:`panel_yproc`. + + ``auto_nonuniform`` + The partitioner will attempt to group cells into partitions which + are square as possible but not necessarily uniform. This supports + numbers of partitions that do not neatly divide the mesh. + + ``guided_nonuniform`` + Forces the partitioner to divide the panel into a number of columns + given by :ref:`panel_xproc` then populate those columns + with partitions that are not necessarily uniform. This supports + numbers of partitions that do not neatly divide the mesh. .. _panel_xproc: diff --git a/documentation/source/how_to_use_it/technical_articles/lfric_distmem_impl.rst b/documentation/source/how_to_use_it/technical_articles/lfric_distmem_impl.rst index 14e77aa21..1a4ad0da8 100644 --- a/documentation/source/how_to_use_it/technical_articles/lfric_distmem_impl.rst +++ b/documentation/source/how_to_use_it/technical_articles/lfric_distmem_impl.rst @@ -177,8 +177,12 @@ supplied to the partitioner through the use of a function passed in via a function pointer. For efficiency reasons, the algorithm for partitioning a cubed-sphere -mesh is a specific algorithm that will only work for a cubed-sphere mesh -(each panel of the cubed-sphere is split into rectangular partitions). +mesh is a specific algorithm that will only work for a cubed-sphere mesh. +By default each panel of the cubed-sphere is split into rectangular partitions, +alternatively if the 'custom' decomposition type is used then sets of 2 or 3 +cubed-sphere panels can be grouped together before these sets are decomposed into +a number of rectangular panels. These restrictions mean that the total number of +partitions for cubed-sphere meshes needs to be a multiple of 2 or 3. This specific partitioner could be replaced with a more general partitioner for use on fully unstructured meshes. diff --git a/documentation/source/how_to_use_it/testing/index.rst b/documentation/source/how_to_use_it/testing/index.rst index cb9e12eaf..46317ce51 100644 --- a/documentation/source/how_to_use_it/testing/index.rst +++ b/documentation/source/how_to_use_it/testing/index.rst @@ -14,11 +14,134 @@ aren't testing. Automated because tests which aren't run aren't catching bugs. The LFRic project makes use of functional testing whereby a known set of input stimuli are presented to a piece of code and the resulting output is -compared to expected results. Any deviation indicates a change in behaviour. +compared to expected results. -This functional testing is a continuum from fine to coarse grained. +Reasons For Testing +------------------- -The finest grained end is "unit testing" where code units are tested. This +There are several reasons to test code, these can be summarised as Correctness, +Regression and Failure mode. These will be discussed shortly but it is important +to understand that while they can pull in the same direction they can also pull +in different directions. It may, therefore, be necessary to write several tests +to do different things. + +Correctness Testing +^^^^^^^^^^^^^^^^^^^ + +The most obvious thing a functional test can do is to test that the unit under +test produces the correct answer, given the inputs. + +In a perfect world, the test is written first (and by a different developer) so +it is informed only by the expected correct behaviour and not at all by +knowledge of the implementation. In the real world this is often not possible +but the developer should still do their best to divorce themselves from their +knowledge of the implementation. + +A numerical integration is an example of the ideal circumstance for correctness +testing; a function is used to generate the input data and an analytical +solution for the integral of that function is used to determine the expected +output. + +In this case we are very much testing the function of the numerical integration +and not its implementation. + +The inputs are an array of hard-coded values (feel free to provide the function +used to generate them as a comment) and likewise the expected result is also +provided as a literal value. (Again, feel free to provide the derivation of the +integral in a comment) + +If providing hand calculated values as inputs seems like too much work it may +be a sign that your input dataset is too large. Ask yourself if you need that +many data points for an effective test. + +While normally we try to avoid abitrary "magic numbers" in our code, in testing +we embrace them. A constant value cannot unexpectedly change its value in the +way a calculation might. + +Why are calculations viewed with suspicion? Because it is all too easy to have +them unexpectedly dependent on some value which may get changed without notice. + +For instance, imagine calculating the mean of an array. If that array changes +size the mean will likely change. Now if that array is coming from the code +under test it can change without any notice. + +Calculations involving only local data are safe but you have to be very sure +they do use only local data. + +The biggest pitfull with calculations is that the one being used for testing +may be the same as the one being tested. Obviously a calculation can't test +itself for correctness! + +Regression Testing +^^^^^^^^^^^^^^^^^^ + +The second testing super-power comes under the banner of "regression testing." + +Obviously this type of testing is intended to prevent "regression," but what +does that mean? + +The first kind of regression is where modifications to the code under test +causes it to behave differently to the expected behaviour of the tests. This +can sometimes be the intent of the change, in which case the tests will need to +be updated to reflect. + +Often this is an unintended consequence of fixing or adding a feature. The goal +of regression testing, in this case, is to make sure that no matter how much +the code under test is changed, it always honours the contract of its interface. + +Which is to say, the same input data produces the same results. + +The value of this is exactly that it allows the implementation to be improved and +optimised while retaining some confidence that it is still working correctly. +In that sense it is an extension of correctness testing. + +The other major aspect of regression testing is to try and prevent back-sliding +when bug fixes are applied. It is surprisingly common, after a bug has been +fixed, for the bug to re-appear. This can happen for a number of reasons, all of +them annoying. + +In this mode a new test is written which exercises the bug and is importantly +done before a fix is attempted. There are three reasons for writing the test +before fixing the bug. + +* In the case where the bug is not entirely understood it can be a vaulable + tool in gaining that complete understanding. +* Once a fix has been implemented it allows us to prove that it does, indeed, + fix the bug as the failing test will now pass. +* Finally, it means subsequent changes can't recreate the bug as there is now a + test which will fail if they do. The fact that it has failed in this way in + the past proves that this is a possible failure-mode. + +Failure-mode and Edge-case Testing +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +This brings us to our final aspect of functional testing. This is a bit of a +rag-bag of apparently unrelated stuff but can broadly be thought of as trying +to anticipate what *might* go wrong. + +This is particularly important when dealing with user input. There is no +guarantee that the user is going to pass us what we asked for. We should treat +such data with suspicion. As such it's important to test how our code behaves +when, for instance, a negative number is passed to a value which must be +positive. + +Even when we are not dealing directly with user input it is important to test +for likely fault conditions. What happens when the file we want to read doesn't +exist? What happens when a list is empty? + +A very common source of errors are around boundaries. If a unit expects input +in a range, check what happens when you pass values just inside, and just +outside, the range. Make sure you don't have an "out by one" error in there. + +If your unit can accpet zero as an input, test it. Because of the possiblity of +"divide by zero" errors it's important to test. + +Granularity of Testing +---------------------- + +Functional testing is a continuum from fine to coarse grained. + +The finest grained end is "unit testing" where code "units" are tested. This usually means individual procedures. This testing is very good at isolating faults to a small piece of code but it can't tell you how these units interact with each other. diff --git a/documentation/source/how_to_use_it/testing/integration_testing.rst b/documentation/source/how_to_use_it/testing/integration_testing.rst index c5ece6af8..0bbc3dcbf 100644 --- a/documentation/source/how_to_use_it/testing/integration_testing.rst +++ b/documentation/source/how_to_use_it/testing/integration_testing.rst @@ -98,13 +98,13 @@ Firstly we need a program in program cli_mod_test use, intrinsic :: iso_fortran_env, only : output_unit - use cli_mod, only : get_initial_filename + use cli_mod, only : parse_command_line implicit none character(:), allocatable :: filename - call get_initial_filename( filename ) + call parse_command_line( filename ) write( output_unit, '(A)' ) filename end program cli_mod_test diff --git a/infrastructure/build/configuration.mk b/infrastructure/build/configuration.mk index 1b020218c..cdf85cecd 100644 --- a/infrastructure/build/configuration.mk +++ b/infrastructure/build/configuration.mk @@ -11,7 +11,7 @@ export CONFIG_DIR=$(WORKING_DIR)/configuration .PHONY: configuration_files -configuration_files: $(WORKING_DIR)/configuration_mod.f90 \ +configuration_files: $(WORKING_DIR)/config_loader_mod.f90 \ $(WORKING_DIR)/feign_config_mod.f90 .INTERMEDIATE: $(CONFIG_DIR)/rose-meta.json $(CONFIG_DIR)/config_namelists.txt @@ -19,13 +19,13 @@ $(CONFIG_DIR)/rose-meta.json $(CONFIG_DIR)/config_namelists.txt: $(META_FILE_DIR $(call MESSAGE,Generating namelist configuration file.) $(Q)mkdir -p $(dir $@) ifdef APPS_ROOT_DIR - $(Q)rose_picker $(META_FILE_DIR)/rose-meta.conf \ - -directory $(CONFIG_DIR) \ - -include_dirs $(APPS_ROOT_DIR)/rose-meta \ + $(Q)rose_picker $(META_FILE_DIR)/rose-meta.conf \ + -directory $(CONFIG_DIR) \ + -include_dirs $(APPS_ROOT_DIR)/rose-meta \ -include_dirs $(CORE_ROOT_DIR)/rose-meta else - $(Q)rose_picker $(META_FILE_DIR)/rose-meta.conf \ - -directory $(CONFIG_DIR) \ + $(Q)rose_picker $(META_FILE_DIR)/rose-meta.conf \ + -directory $(CONFIG_DIR) \ -include_dirs $(CORE_ROOT_DIR)/rose-meta endif # It's not clear why this is needed but as of 5/2/20 the diagnostic @@ -35,27 +35,41 @@ endif .INTERMEDIATE: $(CONFIG_DIR)/build_config_loaders $(CONFIG_DIR)/build_config_loaders: $(CONFIG_DIR)/rose-meta.json $(call MESSAGE,Generating namelist loading modules.) - $(Q)$(LFRIC_BUILD)/tools/GenerateNamelist $(VERBOSE_ARG) \ - $(CONFIG_DIR)/rose-meta.json \ + $(Q)$(LFRIC_BUILD)/tools/GenerateNamelistLoader \ + $(VERBOSE_ARG) \ + $(CONFIG_DIR)/rose-meta.json \ -directory $(CONFIG_DIR) + $(Q)touch $(WORKING_DIR)/duplicate_namelists.txt $(Q)touch $(CONFIG_DIR)/build_config_loaders # This recipe requires config_namelists.txt, although adding it to the dependencies # causes a race condition when calling Make in parallel. The generation # of config_namelists.txt is done at the same time as rose-meta.json, so the # presense of config_namelists.txt is implied as true if rose-meta.json is present -.PRECIOUS: $(WORKING_DIR)/configuration_mod.f90 $(CONFIG_DIR)/%_config_mod.f90 -$(WORKING_DIR)/configuration_mod.f90: $(CONFIG_DIR)/build_config_loaders +.PRECIOUS: $(WORKING_DIR)/config_loader_mod.f90 $(CONFIG_DIR)/%_config_mod.f90 +$(WORKING_DIR)/config_loader_mod.f90: $(CONFIG_DIR)/build_config_loaders $(call MESSAGE,Generating configuration loader module,$(notdir $@)) $(Q)mkdir -p $(dir $@) - $(Q)$(LFRIC_BUILD)/tools/GenerateLoader $(VERBOSE_ARG) $@ $(shell cat $(CONFIG_DIR)/config_namelists.txt) - + $(Q)$(LFRIC_BUILD)/tools/GenerateConfigLoader \ + $(VERBOSE_ARG) \ + $(shell cat $(CONFIG_DIR)/config_namelists.txt) \ + -o $(WORKING_DIR) + $(Q)$(LFRIC_BUILD)/tools/GenerateExtendedNamelistType \ + $(VERBOSE_ARG) \ + $(CONFIG_DIR)/rose-meta.json \ + -directory $(CONFIG_DIR) + $(Q)$(shell sed 's\^\-duplicate \' <$(CONFIG_DIR)/duplicate_namelists.txt >$(CONFIG_DIR)/duplicates.txt) + $(Q)$(LFRIC_BUILD)/tools/GenerateConfigType \ + $(VERBOSE_ARG) \ + $(shell cat $(CONFIG_DIR)/config_namelists.txt) \ + $(shell cat $(CONFIG_DIR)/duplicates.txt) \ + -o $(WORKING_DIR) .PRECIOUS: $(WORKING_DIR)/feign_config_mod.f90 $(WORKING_DIR)/feign_config_mod.f90: $(CONFIG_DIR)/rose-meta.json $(call MESSAGE,Generating namelist feigning module.) $(Q)mkdir -p $(dir $@) - $(Q)$(LFRIC_BUILD)/tools/GenerateFeigns \ + $(Q)$(LFRIC_BUILD)/tools/GenerateFeigns \ $(CONFIG_DIR)/rose-meta.json \ -output $@ diff --git a/infrastructure/build/fortran/mpifort.mk b/infrastructure/build/fortran/mpifort.mk new file mode 100644 index 000000000..67e66277b --- /dev/null +++ b/infrastructure/build/fortran/mpifort.mk @@ -0,0 +1,23 @@ +############################################################################## +# (c) Crown copyright Met Office. All rights reserved. +# The file LICENCE, distributed with this code, contains details of the terms +# under which the code may be used. +############################################################################## + +MPIFORT_VN_STR := $(shell $(FC) --version) +MPIFORT_COMPILER := $(shell echo "$(MPIFORT_VN_STR)" | awk '{print $$1}') +$(info ** Chosen MPI Fortran compiler: $(MPIFORT_COMPILER)) + +ifeq '$(MPIFORT_COMPILER)' 'GNU' + FORTRAN_COMPILER = gfortran +else ifeq '$(MPIFORT_COMPILER)' 'ifort' + FORTRAN_COMPILER = ifort +else ifeq '$(MPIFORT_COMPILER)' 'Cray' + FORTRAN_COMPILER = crayftn +else ifeq '$(MPIFORT_COMPILER)' 'nvfortran' + FORTRAN_COMPILER = nvfortran +else + $(error Unrecognised mpifort compiler option: "$(MPIFORT_COMPILER)") +endif + +include $(LFRIC_BUILD)/fortran/$(FORTRAN_COMPILER).mk diff --git a/infrastructure/build/import.mk b/infrastructure/build/import.mk index a6e960dc5..da8edaabc 100644 --- a/infrastructure/build/import.mk +++ b/infrastructure/build/import.mk @@ -39,7 +39,7 @@ import-infrastructure: $(WORKING_DIR)/field/field_real32_mod.f90 \ $(WORKING_DIR)/field/field_%_mod.f90: $(LFRIC_INFRASTRUCTURE)/source/field/field_mod.t90 \ | $(WORKING_DIR)/field - $(call MESSAGE, Templating, $<) + $(call MESSAGE,Templating, $<) $Q$(TEMPLATE_TOOL) $< -o $@ -s type=$(TYPE_TABLE_$*) -s kind=$* $(WORKING_DIR)/field: @@ -47,7 +47,7 @@ $(WORKING_DIR)/field: $(WORKING_DIR)/operator/operator_%_mod.f90: $(LFRIC_INFRASTRUCTURE)/source/operator/operator_mod.t90 \ | $(WORKING_DIR)/operator - $(call MESSAGE, Templating, $<) + $(call MESSAGE,Templating, $<) $Q$(TEMPLATE_TOOL) $< -o $@ -s kind=$* $(WORKING_DIR)/operator: @@ -55,7 +55,7 @@ $(WORKING_DIR)/operator: $(WORKING_DIR)/scalar/scalar_%_mod.f90: $(LFRIC_INFRASTRUCTURE)/source/scalar/scalar_mod.t90 \ | $(WORKING_DIR)/scalar - $(call MESSAGE, Templating, $<) + $(call MESSAGE,Templating, $<) $Q$(TEMPLATE_TOOL) $< -o $@ -s type=$(TYPE_TABLE_$*) -s kind=$* $(WORKING_DIR)/scalar: diff --git a/infrastructure/build/lfric.mk b/infrastructure/build/lfric.mk index ab0ca4d9c..2cd391177 100644 --- a/infrastructure/build/lfric.mk +++ b/infrastructure/build/lfric.mk @@ -96,10 +96,27 @@ ifdef USE_VERNIER export PRE_PROCESS_MACROS += VERNIER endif +ifdef USE_LEGACY_TIMER + export PRE_PROCESS_MACROS += LEGACY_TIMER +endif + ifdef USE_TIMING_WRAPPER export PRE_PROCESS_MACROS += TIMING_ON endif +# Check that only one profiler is requested +ifneq ($(and $(findstring LEGACY_TIMER, $(PRE_PROCESS_MACROS)), \ + $(findstring VERNIER, $(PRE_PROCESS_MACROS))), ) + $(error Multiple profilers specified, limit choice to single profiler.) +endif + +# Check that TIMING ON has been set if any profiler requested. +ifneq ($(or $(findstring LEGACY_TIMER,$(PRE_PROCESS_MACROS)), \ + $(findstring VERNIER, $(PRE_PROCESS_MACROS))), ) +ifndef USE_TIMING_WRAPPER + $(error Conflicting options: Profiler requested with Timing disabled.) +endif +endif # Set the default precision for reals RDEF_PRECISION ?= 64 diff --git a/infrastructure/build/pfunit.mk b/infrastructure/build/pfunit.mk index 6ac4ecf45..446bb2996 100644 --- a/infrastructure/build/pfunit.mk +++ b/infrastructure/build/pfunit.mk @@ -38,12 +38,12 @@ $(WORKING_DIR)/%.F90: $(SOURCE_DIR)/%.pf $(Q)$(PFUNIT)/bin/funitproc $(QUIET_ARG_SINGLE) $< $@ $(WORKING_DIR)/%.F90: $(WORKING_DIR)/%.pf - $(call MESSAGE, Generating unit test, $@) + $(call MESSAGE,Generating unit test, $@) $Qmkdir -p $(dir $@) $Q$(PFUNIT)/bin/funitproc $(QUIET_ARG_SINGLE) $< $@ $(WORKING_DIR)/%.pf: $(SOURCE_DIR)/%.PF - $(call MESSAGE, Preprocessing unit test, $<) + $(call MESSAGE,Preprocessing unit test, $<) $Qmkdir -p $(dir $@) $Q$(FPP) $(addprefix -I, $(PRE_PROCESS_INCLUDE_DIRS)) \ $(addprefix -D, $(PRE_PROCESS_MACROS)) \ diff --git a/infrastructure/build/psyclone/psyclone_psykal.mk b/infrastructure/build/psyclone/psyclone_psykal.mk index fed281665..2d5afead4 100644 --- a/infrastructure/build/psyclone/psyclone_psykal.mk +++ b/infrastructure/build/psyclone/psyclone_psykal.mk @@ -11,6 +11,11 @@ # Set the DSL Method in use to collect the correct transformation files. DSL = psykal # + +# Set default psyclone command additional options +PSYCLONE_PSYKAL_EXTRAS ?= -l all +# + ALGORITHM_F_FILES := $(patsubst $(SOURCE_DIR)/%.X90, \ $(WORKING_DIR)/%.f90, \ $(shell find $(SOURCE_DIR) -name '*.X90' -print)) @@ -46,12 +51,14 @@ $(WORKING_DIR)/%.f90 $(WORKING_DIR)/%_psy.f90: \ $(WORKING_DIR)/%.x90 $$(OPTIMISATION_PATH)/$(DSL)/$$*.py | $$(dir $$@) $(call MESSAGE,PSyclone - local optimisation,$(subst $(SOURCE_DIR)/,,$<)) $QPYTHONPATH=$(LFRIC_BUILD)/psyclone:$$PYTHONPATH psyclone -api lfric \ - -l all -d $(WORKING_DIR) \ + -d $(WORKING_DIR) \ --config $(PSYCLONE_CONFIG_FILE) \ -s $(OPTIMISATION_PATH)/$(DSL)/$*.py \ -okern $(WORKING_DIR)/kernel \ -oalg $(WORKING_DIR)/$*.f90 \ - -opsy $(WORKING_DIR)/$*_psy.f90 $< + -opsy $(WORKING_DIR)/$*_psy.f90 \ + $(PSYCLONE_PSYKAL_EXTRAS) \ + $< # Where a global optimisation script exists, use it. # @@ -59,12 +66,14 @@ $(WORKING_DIR)/%.f90 $(WORKING_DIR)/%_psy.f90: \ $(WORKING_DIR)/%.x90 $(OPTIMISATION_PATH)/$(DSL)/global.py | $$(dir $$@) $(call MESSAGE,PSyclone - global optimisation,$(subst $(SOURCE_DIR)/,,$<)) $QPYTHONPATH=$(LFRIC_BUILD)/psyclone:$$PYTHONPATH psyclone -api lfric \ - -l all -d $(WORKING_DIR) \ + -d $(WORKING_DIR) \ --config $(PSYCLONE_CONFIG_FILE) \ -s $(OPTIMISATION_PATH)/$(DSL)/global.py \ -okern $(WORKING_DIR)/kernel \ -oalg $(WORKING_DIR)/$*.f90 \ - -opsy $(WORKING_DIR)/$*_psy.f90 $< + -opsy $(WORKING_DIR)/$*_psy.f90 \ + $(PSYCLONE_PSYKAL_EXTRAS) \ + $< # Where no optimisation script exists, don't use it. # @@ -76,7 +85,9 @@ $(WORKING_DIR)/%.x90 | $$(dir $$@) --config $(PSYCLONE_CONFIG_FILE) \ -okern $(WORKING_DIR)/kernel \ -oalg $(WORKING_DIR)/$*.f90 \ - -opsy $(WORKING_DIR)/$*_psy.f90 $< + -opsy $(WORKING_DIR)/$*_psy.f90 \ + $(PSYCLONE_PSYKAL_EXTRAS) \ + $< .PRECIOUS: $(WORKING_DIR)/%.x90 # Perform preprocessing for big X90 files. diff --git a/infrastructure/build/template.mk b/infrastructure/build/template.mk index 8c6593e7e..cee1ddf2d 100644 --- a/infrastructure/build/template.mk +++ b/infrastructure/build/template.mk @@ -20,11 +20,11 @@ SARGS = $(foreach key, $(SUBSTITUTIONS), $(foreach value, $(wordlist 2, 10, $(su generate-from-template: $(addprefix $(WORKING_DIR)/, $(FORTRAN_FILES)) $(WORKING_DIR)/%.f90: $(SOURCE_DIR)/%.t90 - $(call MESSAGE, Templating, $<) + $(call MESSAGE,Templating, $<) $Q$(TOOL) $< -o $@ $(SARGS) $(WORKING_DIR)/%.F90: $(SOURCE_DIR)/%.T90 - $(call MESSAGE, Templating, $<) + $(call MESSAGE,Templating, $<) $Q$(TOOL) $< -o $@ $(SARGS) #include $(LFRIC_BUILD)/lfric.mk diff --git a/infrastructure/build/tests.mk b/infrastructure/build/tests.mk index 23f362014..fcb7be98e 100644 --- a/infrastructure/build/tests.mk +++ b/infrastructure/build/tests.mk @@ -17,7 +17,7 @@ endif ifdef MPI_TESTS UNIT_TEST_PRE_PROCESS_MACROS = USE_MPI=YES - LAUNCHER = mpiexec -n 4 + LAUNCHER = mpiexec -n 6 else UNIT_TEST_PRE_PROCESS_MACROS = NO_MPI=no_mpi # It seems that the Cray 'ftn' wrapper always builds for MPI... @@ -109,16 +109,16 @@ $$(if $$(realpath $$(TEST_DIR)/$$(dir $$*)/iodef.xml), $$(BIN_DIR)/$$(dir $$*)/i do-integration-tests/resources/%: \ | $$(if $$(realpath $$(TEST_DIR)/support/resources), do-integration-tests/resources/support/$$*) - $(call MESSAGE, Harvesting, $*) + $(call MESSAGE,Harvesting, $*) $Qif [ -e $(TEST_DIR)/$(dir $*)resources ]; then rsync -a $(TEST_DIR)/$(dir $*)resources $(BIN_DIR)/$(dir $*); fi do-integration-tests/resources/support/%: $(BIN_DIR)/resources - $(call MESSAGE, Symlinking to, support/resources) + $(call MESSAGE,Symlinking to, support/resources) $Qmkdir -p $(BIN_DIR)/$(dir $*) $Qln -sf $(BIN_DIR)/resources $(BIN_DIR)/$(dir $*)shared-resources $(BIN_DIR)/resources: - $(call MESSAGE, Harvesting, support/resources) + $(call MESSAGE,Harvesting, support/resources) $Qrsync -a $(TEST_DIR)/support/resources $(BIN_DIR)/ $(BIN_DIR)/%.py: $(TEST_DIR)/%.py @@ -127,7 +127,7 @@ $(BIN_DIR)/%.py: $(TEST_DIR)/%.py $Qcp $< $@ $(BIN_DIR)%iodef.xml: $(TEST_DIR)%iodef.xml - $(call MESSAGE, Copying, $<) + $(call MESSAGE,Copying, $<) $Qmkdir -p $(dir $@) $Qcp $< $@ diff --git a/infrastructure/build/tools/GenerateLoader b/infrastructure/build/tools/GenerateConfigLoader similarity index 80% rename from infrastructure/build/tools/GenerateLoader rename to infrastructure/build/tools/GenerateConfigLoader index 2a047d9be..cfce217fd 100755 --- a/infrastructure/build/tools/GenerateLoader +++ b/infrastructure/build/tools/GenerateConfigLoader @@ -10,6 +10,8 @@ Takes a list of namelists and generates source for a namelist loader. """ import argparse import logging +import os + from pathlib import Path from configurator import __version__ @@ -28,9 +30,9 @@ def main(): version=f'%(prog)s {__version__}') parser.add_argument('-verbose', action='store_true', help='Provide a running commentry') - parser.add_argument('outputFilename', metavar='output-filename', - type=Path, - help='Source file to produce') + parser.add_argument( "-o", "--output-dir", type=Path, + default=os.getcwd(), + help="Path to the output directory (default: current directory)" ) parser.add_argument('namelistNames', metavar='namelist', nargs='*', help='Namelists to load.') @@ -41,13 +43,14 @@ def main(): logging.getLogger('configurator').addHandler(handler) logging.getLogger('configurator').setLevel(logging.WARNING) - module_name = args.outputFilename.stem - generator = loader.ConfigurationLoader(module_name) + moduleName = "config_loader_mod" + generator = loader.ConfigurationLoader(moduleName) + for name in args.namelistNames: generator.add_namelist(name) - generator.write_module(args.outputFilename) - + outputFile = Path(str(args.output_dir.joinpath(moduleName)) + ".f90") + generator.write_module(outputFile) if __name__ == '__main__': main() diff --git a/infrastructure/build/tools/GenerateConfigType b/infrastructure/build/tools/GenerateConfigType new file mode 100755 index 000000000..531792cee --- /dev/null +++ b/infrastructure/build/tools/GenerateConfigType @@ -0,0 +1,71 @@ +#!/usr/bin/env python3 +############################################################################## +# (C) Crown copyright 2025 Met Office. All rights reserved. +# The file LICENCE, distributed with this code, contains details of the terms +# under which the code may be used. +############################################################################## +# pylint: disable=invalid-name +""" +Takes a list of namelists and generates source defining a ConfigType based +on the namelists. In addition, source code is generated for namelist iterators +for any namelists identified as allowing multiple instances (duplicates). +""" +import argparse +import logging +import os + +from pathlib import Path + +from configurator import __version__ +import configurator.config_type as ConfigType + + +def main(): + """ + Entry point. Handles command-line arguments. + """ + parser = argparse.ArgumentParser(add_help=False, + description=__doc__) + parser.add_argument('-help', '-h', '--help', action='help', + help='Show this help message and exit') + parser.add_argument('-version', action='version', + version=f'%(prog)s {__version__}') + parser.add_argument('-verbose', action='store_true', + help='Provide a running commentry') + parser.add_argument( "-o", "--output-dir", type=Path, + default=os.getcwd(), + help="Path to the output directory (default: current directory)" ) + parser.add_argument('-duplicate', action='append', metavar='-duplicate', nargs=1, + help='Enables multiple instances for the specified namellist.') + parser.add_argument('namelistNames', metavar='namelist', + nargs='*', + help='Namelists memebers of app configuration.') + + args = parser.parse_args() + + if args.verbose: + handler = logging.StreamHandler() + logging.getLogger('configurator').addHandler(handler) + logging.getLogger('configurator').setLevel(logging.WARNING) + + moduleName = "config_mod" + generator = ConfigType.AppConfiguration(moduleName) + + duplicate_namelists = [] + if (args.duplicate): + for name in args.duplicate: + duplicate_namelists.extend(name) + + for name in args.namelistNames: + duplicate=False + if name in duplicate_namelists: + duplicate=True + + generator.add_namelist(name, duplicate) + + outputFile = Path(str(args.output_dir.joinpath(moduleName)) + ".f90") + generator.write_module(outputFile) + + +if __name__ == '__main__': + main() diff --git a/infrastructure/build/tools/GenerateExtendedNamelistType b/infrastructure/build/tools/GenerateExtendedNamelistType new file mode 100755 index 000000000..eeaabe52b --- /dev/null +++ b/infrastructure/build/tools/GenerateExtendedNamelistType @@ -0,0 +1,61 @@ +#!/usr/bin/env python3 +############################################################################## +# (C) Crown copyright 2025 Met Office. All rights reserved. +# The file LICENCE, distributed with this code, contains details of the terms +# under which the code may be used. +############################################################################## +# pylint: disable=invalid-name +""" +Reads in a namelist description file and produces Fortran source defining +an extended namelist type specific to the namelist description provided. +""" +import argparse +import logging +from pathlib import Path + +from configurator import __version__ +import configurator.extended_namelist_type as extended_nml + + +def main(): + """ + Entry point. Handles command-line arguments. + """ + parser = argparse.ArgumentParser(add_help=False, + description=__doc__) + parser.add_argument('-help', '-h', '--help', action='help', + help='Show this help message and exit') + parser.add_argument('-version', action='version', + version=f'%(prog)s {__version__}') + parser.add_argument('-verbose', action='store_true', + help='Provide a running commentry') + parser.add_argument('-directory', metavar='path', + type=Path, default=Path.cwd(), + help='Generated source files are put here.') + parser.add_argument('meta_filename', metavar='description-file', nargs=1, + type=Path, + help='The metadata file to load') + + args = parser.parse_args() + + if args.verbose: + handler = logging.StreamHandler() + logging.getLogger('configurator').addHandler(handler) + logging.getLogger('configurator').setLevel(logging.WARNING) + + description_list = [] + + meta_filename = args.meta_filename[0] + + meta_parser = extended_nml.NamelistConfigDescription() + + # Generate namelists from the namelist configuration file. + description_list = meta_parser.process_config(meta_filename) + + for description in description_list: + leafname = description.get_module_name() + '.f90' + module_file = args.directory / leafname + description.write_module(module_file) + +if __name__ == '__main__': + main() diff --git a/infrastructure/build/tools/GenerateNamelist b/infrastructure/build/tools/GenerateNamelistLoader similarity index 86% rename from infrastructure/build/tools/GenerateNamelist rename to infrastructure/build/tools/GenerateNamelistLoader index bc53c4cd3..41948393a 100755 --- a/infrastructure/build/tools/GenerateNamelist +++ b/infrastructure/build/tools/GenerateNamelistLoader @@ -45,6 +45,7 @@ def main(): logging.getLogger('configurator').setLevel(logging.WARNING) description_list = [] + duplicate_list = [] meta_filename = args.meta_filename[0] @@ -58,6 +59,14 @@ def main(): module_file = args.directory / leafname description.write_module(module_file) + if description._multiple_instances_allowed: + duplicate_list.append(description._listname) + + + # Write out which namelist allow duplicates + with open(f'{args.directory}/duplicate_namelists.txt', 'wt', encoding='utf-8') as output: + for listname in duplicate_list: + output.write(f'{listname}\n') if __name__ == '__main__': main() diff --git a/infrastructure/build/tools/configurator/config_type.py b/infrastructure/build/tools/configurator/config_type.py new file mode 100644 index 000000000..06ccbab2f --- /dev/null +++ b/infrastructure/build/tools/configurator/config_type.py @@ -0,0 +1,67 @@ +#!/usr/bin/env python3 +############################################################################## +# (C) Crown copyright 2025 Met Office. All rights reserved. +# The file LICENCE, distributed with this code, contains details of the terms +# under which the code may be used. +############################################################################## +""" +Generates Fortran source for application specifc configuration object. +""" + +from pathlib import Path +from typing import List + +import jinja2 + + +############################################################################## +class AppConfiguration: + """ + Fortran source object type to store configuration namelists. + """ + + def __init__(self, module_name: str): + self._engine = jinja2.Environment( + loader=jinja2.PackageLoader("configurator", "templates") + ) + self._module_name = module_name + self._namelists: List[str] = [] + self._duplicates: List[bool] = [] + + def add_namelist(self, name: str, duplicate: bool) -> None: + """ + Registers a namelist name for the object to store. + + :param name: Name to register. + :param duplicate: Is this namelist allowed multiple instances. + """ + self._namelists.append(name) + self._duplicates.append(duplicate) + + def write_module(self, module_file: Path) -> None: + """ + Stamps out the Fortran source. + + :param module_file: Filename to use. + """ + + if not self._namelists: + raise ValueError("No registered namelists to store.") + + inserts = { + "moduleName": self._module_name, + "namelists": self._namelists, + "duplicates": self._duplicates, + } + + template = self._engine.get_template("config_type.f90.jinja") + module_file.write_text(template.render(inserts)) + + iter_template = "namelist_iterator_type.f90.jinja" + for i, duplicate in enumerate(self._duplicates): + if duplicate: + iter_file = self._namelists[i] + '_nml_iterator_mod.f90' + name = self._namelists[i] + iter_filepath = module_file.parent.joinpath(iter_file) + template = self._engine.get_template(iter_template) + iter_filepath.write_text(template.render({"listname": name})) diff --git a/infrastructure/build/tools/configurator/configurationloader.py b/infrastructure/build/tools/configurator/configurationloader.py index d9145ea0f..57a4ff75a 100644 --- a/infrastructure/build/tools/configurator/configurationloader.py +++ b/infrastructure/build/tools/configurator/configurationloader.py @@ -41,10 +41,14 @@ def write_module(self, module_file: Path) -> None: :param module_file: Filename to use. """ + + if not self._namelists: + raise ValueError("No registered namelists to load.") + inserts = { "moduleName": self._module_name, "namelists": self._namelists, } - template = self._engine.get_template("loader.f90.jinja") + template = self._engine.get_template("config_loader.f90.jinja") module_file.write_text(template.render(inserts)) diff --git a/infrastructure/build/tools/configurator/extended_namelist_type.py b/infrastructure/build/tools/configurator/extended_namelist_type.py new file mode 100644 index 000000000..aabb8d141 --- /dev/null +++ b/infrastructure/build/tools/configurator/extended_namelist_type.py @@ -0,0 +1,779 @@ +#!/usr/bin/env python3 +############################################################################## +# (C) Crown copyright 2025 Met Office. All rights reserved. +# The file LICENCE, distributed with this code, contains details of the terms +# under which the code may be used. +############################################################################## +""" +Turns namelist descriptions into extended namelist specific objects. +""" + +import collections +import json +import re +from abc import ABC, abstractmethod +from pathlib import Path +from typing import Dict, List, Optional, Sequence, Tuple +from zlib import crc32 + +import jinja2 + +from configurator import jinjamacros + + +############################################################################## +class NamelistDescriptionException(Exception): + """ + Thrown for problems in the namelist. + """ + + pass # pylint: disable=unnecessary-pass + + +############################################################################## +class FortranType: + """ + Represents a Fortran type. + + Implements the singleton pattern such that there is only one object per + type. + """ + + _singletonMap: Dict[str, Dict[str, Dict[str, "FortranType"]]] = {} + + def __init__(self, intrinsic_type: str, kind: str, write_format: str): + """ + :param intrinsic_type: One of "integer", "real", etc. + :param kind: Name of data type kind. + :param write_format: Formatting string for this type. + """ + self.intrinsic_type = intrinsic_type + self.kind = kind + self.write_format = write_format + + def declaration(self) -> str: + """ + Gets the type designator used by declarations in source files. + """ + return f"{self.intrinsic_type}({self.kind})" + + def label(self) -> str: + """ + Gets a label for this type. + """ + return f"{self.intrinsic_type}_{self.kind}" + + def __lt__(self, other): + return self.declaration() < other.declaration() + + def __eq__(self, other): + return self.declaration() == other.declaration() + + def __key(self): + return (self.intrinsic_type, self.kind, self.write_format) + + def __hash__(self): + return hash(self.__key()) + + @classmethod + def instance(cls, intrinsic_type, kind, write_format) -> "FortranType": + """ + Gets the singleton object for a given type. + """ + if intrinsic_type not in cls._singletonMap: + cls._singletonMap[intrinsic_type] = {} + + if kind not in cls._singletonMap[intrinsic_type]: + cls._singletonMap[intrinsic_type][kind] = {} + + if write_format not in cls._singletonMap[intrinsic_type][kind]: + cls._singletonMap[intrinsic_type][kind][write_format] = cls( + intrinsic_type, kind, write_format + ) + + return cls._singletonMap[intrinsic_type][kind][write_format] + + +############################################################################## +class _Property(ABC): + """ + Root of all namelist fields. + + .. todo:: This interface is used externally so shouldn't be "private." + """ + + def __init__(self, name: str, fortran_type: FortranType): + """ + :param name: Identifying name. + :param fortran_type: field's Fortran type. + """ + self.name = name + self.fortran_type = fortran_type + + def required_kinds(self) -> List[str]: + """ + Gets Fortran kind of this field. + """ + return [self.fortran_type.kind] + + @abstractmethod + def get_configure_type(self) -> str: + """ + Gets the configuration meta-data type of this field. + """ + raise NotImplementedError() + + @property + @abstractmethod + def missing_data_indicator(self) -> str: + """ + Gets the value used to indicate an unset field. + """ + raise NotImplementedError() + + +############################################################################## +class _String(_Property): + """ + Namelist string field. + """ + + _fortranStringMap = {"default": "str_def", "filename": "str_max_filename"} + + def __init__(self, name: str, length: Optional[str] = None): + """ + :param name: Identifying name. + :param length: String length is a name which resolves to a length. + """ + if not length: + length = "default" + + super().__init__( + name, + FortranType.instance( + "character", self._fortranStringMap[length], "A" + ), + ) + + def get_configure_type(self) -> str: + return "string" + + @property + def missing_data_indicator(self) -> str: + return "cmdi" + + +############################################################################## +class _Enumeration(_Property): + """ + Namelist enumeration field. + """ + + def __init__(self, name: str, keyDictionary: Dict[str, int]): + """ + :param name: Identifying name. + :param keyDictionary: Mapping of enumerator to representation. + """ + super().__init__(name, FortranType.instance("integer", "i_def", "I0")) + + self.mapping = keyDictionary + self.inverse_mapping = { + value: key for key, value in self.mapping.items() + } + self.first_key = self.inverse_mapping[min(self.inverse_mapping.keys())] + + def required_kinds(self): + return [self.fortran_type.kind, "str_def"] + + def get_configure_type(self): + return "enumeration" + + @property + def missing_data_indicator(self): + return "emdi" + + +############################################################################## +class _Scalar(_Property): + """ + Namelist scalar value field. + """ + + _fortranKindMap = { + "character": {"default": "str_def", "filename": "str_max_filename"}, + "logical": {"default": "l_def", "native": "l_native"}, + "integer": { + "default": "i_def", + "short": "i_short", + "medium": "i_medium", + "long": "i_long", + }, + "real": { + "default": "r_def", + "native": "r_native", + "single": "r_single", + "double": "r_double", + "second": "r_second", + }, + } + + _fortranFormatMap = { + "character": "A", + "logical": "L2", + "integer": "I0", + "real": "E14.7", + } + + _fortranMissingDataIndicator = { + "character": "cmdi", + "logical": ".false.", + "integer": "imdi", + "real": "rmdi", + } + + def __init__( + self, + name: str, + configure_type: str, + configure_kind: Optional[str] = None, + ): + """ + :param name: Identifying name. + :param configure_type: Configuration type identifier. + :param configure_kind: Configuration kind identifier. + """ + if not configure_kind: + configure_kind = "default" + + if configure_type == "string": + configure_type = "character" + + super().__init__( + name, + FortranType.instance( + configure_type, + self._fortranKindMap[configure_type][configure_kind], + self._fortranFormatMap[configure_type], + ), + ) + self._mdi = self._fortranMissingDataIndicator[configure_type] + + def get_configure_type(self): + return "scalar" + + @property + def missing_data_indicator(self): + return self._mdi + + +############################################################################## +class _Computed(_Scalar): + """ + Namelist computed value field. + """ + + def __init__( + self, + name: str, + configure_type: str, + computation: str, + configure_kind: Optional[str], + dereferenced_list_vars: Optional[Sequence[str]] = None, + ): + # pylint: disable=too-many-arguments + """ + :param name: Identifying name. + :param configure_type: Configuration type identifier. + :param configure_kind: Configuration kind identifier. + :param computation: Fortran expression. + :param derefernced_list_vars: Fields needed from other namelists. + """ + super().__init__(name, configure_type, configure_kind) + self.computation = computation + self.dereferenced_list_vars = dereferenced_list_vars + + def get_configure_type(self): + return "computed" + + +############################################################################## +class _Array(_Property): + """ + Namelist array field. + """ + + def __init__(self, name: str, contentProperty: _Property, bounds: str): + """ + :param name: Identifying name. + :param contentProperty: Description of array elements. + :param bounds: Description of array size. + """ + super().__init__(name, contentProperty.fortran_type) + self.content = contentProperty + + if "," in bounds: + message = "Only 1D arrays allowed in configuration: {}" + raise NamelistDescriptionException(message.format(bounds)) + + if ":" in bounds and bounds.strip() != ":": + lower, upper = bounds.split(":") + + if lower.strip() not in ["1", ""]: + message = ( + "Only lower bound of 1 is allowed in configuration: {}" + ) + raise NamelistDescriptionException(message.format(bounds)) + + self.bounds = upper + else: + self.bounds = bounds + + def get_configure_type(self): + return "array" + + @property + def missing_data_indicator(self): + return self.content.missing_data_indicator + + def is_immediate_size(self) -> bool: + """ + :return: True if array size is a fixed number. + """ + if self.bounds.isdigit(): + return True + + return False + + def is_deferred_size(self): + """ + :return: True if array size is dependent on another field. + """ + if not self.bounds[0].isdigit() and self.bounds[0] != ":": + return True + + return False + + def is_arbitrary_size(self): + """ + :return: True if array size is unspecified. + """ + if self.bounds[0] == ":": + return True + + return False + + +############################################################################## +class NamelistDescription: + """ + Describes a namelist and its contained fields. + """ + + def __init__( + self, + listname: str, + multiple_instances_allowed: bool = False, + instance_key_member: Optional[str] = None, + ): + """ + :param listname: Identifying name. + """ + self._listname = listname + self._multiple_instances_allowed = multiple_instances_allowed + self._instance_key_member = instance_key_member + + self._engine = jinja2.Environment( + loader=jinja2.PackageLoader("configurator", "templates"), + extensions=["jinja2.ext.do"], + ) + self._engine.filters["decorate"] = jinjamacros.decorate_macro + + self._parameters: Dict[str, _Property] = collections.OrderedDict() + self._module_usage = collections.defaultdict(set) + self._module_usage["constants_mod"] = set( + ["cmdi", "emdi", "unset_key", "imdi", "rmdi", "str_def"] + ) + + def get_namelist_name(self) -> str: + """ + :return: Namelist identifier. + """ + return self._listname + + def get_module_name(self) -> str: + """ + :return: Namelist loader Fortran module name. + """ + return self._listname + "_nml_mod" + + def add_enumeration(self, name: str, enumerators: Sequence[str]) -> None: + """ + Adds an enumerated field to the namelist. + + .. warning:: + This routine will becomes stuck in an infinite loop if asked + to handle an enumeration with 2^31 enumerators. + + :param name: Identifying name. + :param enumerators: + """ + if not isinstance(enumerators, list): + message = "Expected list of enumerators" + raise NamelistDescriptionException(message) + + key_dict: Dict[str, int] = collections.OrderedDict() + for key in enumerators: + # Hash collisions are always possible and uniqueness is essential + # for our enumerators. This is a simple way of ensuring that + # uniqueness. Obviously it will get in an infinite loop if there + # are more than 2^32 things to deal with but that seems unlikely. + # + # Furthermore everything is limited to 2^31 as Fortran integers are + # always signed. + # + value = crc32(bytes(name + key, encoding="ascii")) & 0x7FFFFFFF + while value in key_dict.values(): + value = (value + 1) & 0x7FFFFFFF + key_dict[key] = value + + self._parameters[name] = _Enumeration(name, key_dict) + + def add_usage(self, name: str, module: str) -> None: + """ + Makes this namelist loading module depend on another Fortran module + for values used in computed fields. + + :param name: Variable name. + :param module: Module name. + """ + self._module_usage[module].add(name) + + def add_string( + self, + name: str, + configure_string_length: Optional[str] = None, + bounds: Optional[str] = None, + ) -> None: + """ + Adds a scalar or array string field to the namelist. + + :param name: Field name. + :param configure_string_length: Length of string is a label which + resolves to a length. + :param bounds: Either a length, slice or naked colon. + """ + new_parameter = _String(name, configure_string_length) + + if bounds: + dereffed_bounds, _ = self._dereference_expression(bounds) + self._parameters[name] = _Array( + name, new_parameter, dereffed_bounds + ) + else: + self._parameters[name] = new_parameter + + def add_value( + self, + name: str, + configure_type: str, + configure_kind: Optional[str] = None, + bounds: Optional[str] = None, + ) -> None: + """ + Adds a scalar or array field of type logical, integer or real to the + namelist. + + :param name: Field name. + :param configure_type: type identifier. + :param configure_kind: kind identifier. + :param bounds: Either a length, slice or naked colon. + """ + new_parameter = _Scalar(name, configure_type, configure_kind) + if bounds: + dereffed_bounds, _ = self._dereference_expression(bounds) + self._parameters[name] = _Array( + name, new_parameter, dereffed_bounds + ) + else: + self._parameters[name] = new_parameter + + def add_computed( + self, + name: str, + configure_type: str, + calculation: str, + configure_kind: Optional[str] = None, + ) -> None: + """ + Adds a computed field to the namelist. + + :param name: Field name. + :param configure_type: type identifier. + :param configure_kind: kind identifier. + :param colculation: Fortran expression. + """ + calculation, dereferenced_list_vars = self._dereference_expression( + calculation + ) + self._parameters[name] = _Computed( + name, + configure_type, + calculation, + configure_kind, + dereferenced_list_vars=dereferenced_list_vars, + ) + + def get_parameters(self) -> List[_Property]: + """ + Gets all the properties associated with this namelist. + """ + return list(self._parameters.values()) + + def write_module(self, file_object: Path) -> None: + """ + Generates Fortran module source and writes it to a file. + + :param file_object: Filename to write to. + """ + if not self._parameters: + message = ( + "Cannot write a module to load an empty namelist (" + + self._listname + + ")" + ) + raise NamelistDescriptionException(message) + + all_kinds = set(["i_def"]) + lone_kind_index = {} + lone_kind_tally: Dict[FortranType, int] = collections.defaultdict(int) + namelist = [] + + for name, parameter in self._parameters.items(): + all_kinds.update(parameter.required_kinds()) + + if not isinstance(parameter, _Computed) and not isinstance( + parameter, _Array + ): + lone_kind_tally[parameter.fortran_type] += 1 + lone_kind_index[name] = lone_kind_tally[parameter.fortran_type] + + if not isinstance(parameter, _Computed): + namelist.append(parameter.name) + + inserts = { + "all_kinds": all_kinds, + "arrays": [ + parameter.name + for parameter in self._parameters.values() + if isinstance(parameter, _Array) + ], + "allocatables": [ + parameter.name + for parameter in self._parameters.values() + if ( + isinstance(parameter, _Array) + and not parameter.is_immediate_size() + ) + ], + "enumerations": [ + parameter.name + for parameter in self._parameters.values() + if isinstance(parameter, _Enumeration) + ], + "listname": self._listname, + "multiple_instances_allowed": self._multiple_instances_allowed, + "instance_key_member": self._instance_key_member, + "lonekindindex": lone_kind_index, + "lonekindtally": lone_kind_tally, + "namelist": namelist, + "parameters": self._parameters, + "use_from": self._module_usage, + } + + nml_template = "extended_namelist_type.f90.jinja" + template = self._engine.get_template(nml_template) + file_object.write_text(template.render(inserts)) + + def _dereference_expression( + self, expression: str + ) -> Tuple[str, List[str]]: + """ + Resolve field references in an expression. + + :param expression: Fortran expression containing field references. + :result: Expression with references resolved and a list of namelist + fields involved. + """ + str_dict = { + "namelist": { + "regexString": r"namelist:(\w*)=(\w*)", + "removalString": r"namelist:\w*=", + "moduleSuffix": "_config_mod", + }, + "source": { + "regexString": r"source:(\w*)=(\w*)", + "removalString": r"source:\w*=", + "moduleSuffix": "", + }, + } + result = expression + + dereferenced_list_vars: List[str] = [] + + for key, value in str_dict.items(): + use_variables = re.findall(value["regexString"], result) + if use_variables is not None: + n_vars = len(use_variables) + + for i_var in range(0, n_vars): + list_name = use_variables[i_var][0] + var_name = use_variables[i_var][1] + + if use_variables[i_var][0] != self._listname: + module_name = f"{list_name}{value['moduleSuffix']}" + self.add_usage(var_name, module=module_name) + + if key == "namelist": + dereferenced_list_vars.append(var_name) + + result = re.sub(value["removalString"], "", result) + + if len(dereferenced_list_vars) == 0: + dereferenced_list_vars = [] + + return result, dereferenced_list_vars + + def add_member(self, member_name: str, meta_dict: Dict[str, str]) -> None: + # pylint: disable=too-many-branches + """ + Processes one field entry from the metadata and adds the appropriate + property to this namelist. + + :param member_name: Identifying name. + :param meta_dict: Field description. + """ + meta_keys = list(meta_dict.keys()) + string_length: Optional[str] = None + xtype: str = "" + xkind: Optional[str] = None + xbounds: Optional[str] = None + + if "string_length" in meta_keys: + string_length = meta_dict["string_length"] + + if "kind" in meta_keys: + xkind = meta_dict["kind"] + + if "type" in meta_keys: + xtype = meta_dict["type"] + if isinstance(xtype, str): + xtype = xtype.replace("character", "string") + + elif ( + "enumeration" not in meta_keys + or meta_dict["enumeration"] == "false" + ): + message = ( + "namelist:" + + self._listname + + "=" + + member_name + + ": Non-enumeration metadata requires " + + "a type definition" + ) + raise NamelistDescriptionException(message) + + # Determining array bounds if any. + if "length" in meta_keys: + xlength = meta_dict["length"] + + if xlength == ":": + if "bounds" in meta_keys: + xbounds = meta_dict["bounds"] + else: + xbounds = ":" + + elif isinstance(int(xlength), int): + xbounds = xlength + + # Generating Enumerators from metadata + # These are not dependant on xtype being specified + if "enumeration" in meta_keys and meta_dict["enumeration"] == "true": + key_values = meta_dict["values"] + if all(isinstance(item, str) for item in key_values): + key_values = key_values.replace("\n", "") + key_values = key_values.replace(" ", "") + key_values = key_values.replace("'", "") + keys = key_values.split(",") + + enumeration_keys = [ + re.sub(r"namelist:", "", member) for member in keys + ] + + self.add_enumeration(member_name, enumerators=enumeration_keys) + + # Check to see if member is a derived variable + elif "expression" in meta_keys: + expression_string = meta_dict["expression"] + self.add_computed( + member_name, + xtype, + configure_kind=xkind, + calculation=expression_string, + ) + + elif xtype == "string": + self.add_string( + member_name, + configure_string_length=string_length, + bounds=xbounds, + ) + else: + self.add_value( + member_name, xtype, configure_kind=xkind, bounds=xbounds + ) + + +############################################################################### +class NamelistConfigDescription: # pylint: disable=too-few-public-methods + """ + Manages the JSON representation of the configuration metadata. + """ + + @staticmethod + def process_config(nml_config_file: Path) -> List[NamelistDescription]: + """ + Loads the file and dissects it. + :param nml_config_file: Input JSON file. + """ + with open(nml_config_file, encoding="utf8") as config_file: + namelist_config = json.load(config_file) + + result = [] + + for listname in namelist_config.keys(): + multiple_instances_allowed = False + instance_key_member = None + if ( + "multiple_instances_allowed" + in namelist_config[listname].keys() + ): + multiple_instances_allowed = namelist_config[listname][ + "multiple_instances_allowed" + ] + instance_key_member = namelist_config[listname][ + "instance_key_member" + ] + + description = NamelistDescription( + listname, multiple_instances_allowed, instance_key_member + ) + members_dict = namelist_config[listname]["members"] + + for member in sorted(members_dict.keys()): + meta_dict = members_dict[member] + description.add_member(member, meta_dict) + + result.append(description) + + return result diff --git a/infrastructure/build/tools/configurator/namelistdescription.py b/infrastructure/build/tools/configurator/namelistdescription.py index d1e99b832..30cc22f1d 100644 --- a/infrastructure/build/tools/configurator/namelistdescription.py +++ b/infrastructure/build/tools/configurator/namelistdescription.py @@ -590,7 +590,7 @@ def write_module(self, file_object: Path) -> None: "use_from": self._module_usage, } - template = self._engine.get_template("namelist.f90.jinja") + template = self._engine.get_template("namelist_loader.f90.jinja") file_object.write_text(template.render(inserts)) def _dereference_expression( diff --git a/infrastructure/build/tools/configurator/templates/loader.f90.jinja b/infrastructure/build/tools/configurator/templates/config_loader.f90.jinja similarity index 73% rename from infrastructure/build/tools/configurator/templates/loader.f90.jinja rename to infrastructure/build/tools/configurator/templates/config_loader.f90.jinja index 224ce01bb..8edad5bf7 100644 --- a/infrastructure/build/tools/configurator/templates/loader.f90.jinja +++ b/infrastructure/build/tools/configurator/templates/config_loader.f90.jinja @@ -15,10 +15,13 @@ module {{moduleName}} use namelist_collection_mod, only: namelist_collection_type use namelist_mod, only: namelist_type - -{%- if namelists %} + use config_mod, only: config_type +{{-'\n'}} +{%- for listname in namelists %} + use {{listname}}_nml_mod, only: {{listname}}_nml_type +{%- endfor %} {{-'\n'}} -{%- for listname in namelists %} +{%- for listname in namelists %} use {{listname}}_config_mod, only : read_{{listname}}_namelist, & {%- set indent = ' use '+listname+'_config_mod, only : ' %} {%- set indent = indent | length() %} @@ -27,9 +30,9 @@ module {{moduleName}} {{' '*indent}}{{listname}}_is_loaded, & {{' '*indent}}{{listname}}_reset_load_status, & {{' '*indent}}{{listname}}_final, & -{{' '*indent}}get_{{listname}}_nml -{%- endfor %} -{%- endif %} +{{' '*indent}}get_{{listname}}_nml, & +{{' '*indent}}get_new_{{listname}}_nml +{%- endfor %} implicit none @@ -42,33 +45,60 @@ contains ! ! [in] filename File holding the namelists. ! - ! TODO: Assumes namelist tags come at the start of lines. ! TODO: Support "namelist file" namelists which recursively call this ! procedure to load other namelist files. ! - subroutine read_configuration( filename, nml_bank ) + subroutine read_configuration( filename, configuration, config ) use io_utility_mod, only : open_file, close_file implicit none character(*), intent(in) :: filename - type(namelist_collection_type), intent(inout) :: nml_bank + + type(namelist_collection_type), optional, intent(inout) :: configuration + type(config_type), optional, intent(inout) :: config integer(i_def) :: local_rank character(str_def), allocatable :: namelists(:) - integer(i_def) :: unit = -1 + integer(i_def) :: unit + + if (.not. present(configuration) .and. .not. present(config)) then + write(log_scratch_space,'(A)') & + 'At least one optional argument must be provided for ' //& + 'read_configuration.' + call log_event(log_scratch_space, log_level_error) + end if local_rank = global_mpi%get_comm_rank() + unit = -1 if (local_rank == 0) unit = open_file( filename ) call get_namelist_names( unit, local_rank, namelists ) - call read_configuration_namelists( unit, local_rank, & - namelists, filename, & - nml_bank ) + if (present(configuration) .and. present(config)) then + ! TODO Transition, remove when all code ported to config + ! access pattern + call read_configuration_namelists( unit, local_rank, & + namelists, filename, & + nml_bank=configuration, & + config=config ) + + else if (present(configuration) .and. .not. present(config)) then + ! TODO Deprecated, remove when all code ported to config + ! access pattern + call read_configuration_namelists( unit, local_rank, & + namelists, filename, & + nml_bank=configuration ) + + else if (.not. present(configuration) .and. present(config)) then + call read_configuration_namelists( unit, local_rank, & + namelists, filename, & + config=config ) + + end if if (local_rank == 0) call close_file( unit ) @@ -106,8 +136,7 @@ contains continue_read = read_line( unit, buffer ) if ( .not. continue_read ) exit text_line_loop - ! TODO: Assumes namelist tags are at the start of lines. #1753 - ! + buffer = adjustl(buffer) if (buffer(1:1) == '&') then namecount = namecount + 1 allocate(names_temp(namecount)) @@ -164,6 +193,7 @@ contains case ('{{listname}}') configuration_found = {{listname}}_is_loaded() {%- endfor %} + case default write( log_scratch_space, '(A)' ) & 'Tried to ensure unrecognised namelist "'// & @@ -181,7 +211,7 @@ contains subroutine read_configuration_namelists( unit, local_rank, & namelists, filename, & - nml_bank ) + nml_bank, config ) implicit none integer(i_def), intent(in) :: unit @@ -189,21 +219,23 @@ contains character(str_def), intent(in) :: namelists(:) character(*), intent(in) :: filename - type(namelist_collection_type), intent(inout) :: nml_bank + type(namelist_collection_type), optional, intent(inout) :: nml_bank + type(config_type), optional, intent(inout) :: config type(namelist_type) :: nml_obj +{%- for listname in namelists %} + type({{listname}}_nml_type) :: {{listname}}_nml_obj +{%- endfor %} + integer(i_def) :: i, j logical :: scan -{%- if namelists %} -{{-'\n'}} ! Reset load status from any previous file reads -{%- for listname in namelists %} +{%- for listname in namelists %} call {{listname}}_reset_load_status() -{%- endfor %} -{%- endif %} +{%- endfor %} ! Read the namelists do j=1, 2 @@ -218,14 +250,23 @@ contains do i=1, size(namelists) select case (trim(namelists(i))) -{%- for listname in namelists %} +{% for listname in namelists %} case ('{{listname}}') if ({{listname}}_is_loadable()) then call read_{{listname}}_namelist( unit, local_rank, scan ) if (.not. scan) then call postprocess_{{listname}}_namelist() - nml_obj = get_{{listname}}_nml() - call nml_bank%add_namelist(nml_obj) + + if (present(nml_bank)) then + nml_obj = get_{{listname}}_nml() + call nml_bank%add_namelist(nml_obj) + end if + + if (present(config)) then + {{listname}}_nml_obj = get_new_{{listname}}_nml() + call config%add_namelist({{listname}}_nml_obj) + end if + end if else write( log_scratch_space, '(A)' ) & @@ -234,6 +275,7 @@ contains call log_event( log_scratch_space, LOG_LEVEL_ERROR ) end if {%- endfor %} + case default write( log_scratch_space, '(A)' ) & 'Unrecognised namelist "'//trim(namelists(i))// & @@ -254,13 +296,10 @@ contains subroutine final_configuration() implicit none - -{%- if namelists %} {{-'\n'}} -{%- for listname in namelists %} +{%- for listname in namelists %} call {{listname}}_final() -{%- endfor %} -{%- endif %} +{%- endfor %} return end subroutine final_configuration diff --git a/infrastructure/build/tools/configurator/templates/config_type.f90.jinja b/infrastructure/build/tools/configurator/templates/config_type.f90.jinja new file mode 100644 index 000000000..a69748150 --- /dev/null +++ b/infrastructure/build/tools/configurator/templates/config_type.f90.jinja @@ -0,0 +1,446 @@ +!----------------------------------------------------------------------------- +! (C) Crown copyright 2025 Met Office. All rights reserved. +! The file LICENCE, distributed with this code, contains details of the terms +! under which the code may be used. +!----------------------------------------------------------------------------- +! +!> @brief Defines \ object. +!> @details A container object that holds namelist +!> objects of various types). +!> +!> Access pattern will differ for namelist types that are permitted +!> to have multiple instances within the configuration. +!> +module {{moduleName}} + + use constants_mod, only: i_def, l_def, str_def, cmdi + use log_mod, only: log_event, log_scratch_space, & + log_level_error, log_level_warning + use linked_list_mod, only: linked_list_type, linked_list_item_type + + use namelist_mod, only: namelist_type + use namelist_collection_mod, only: namelist_collection_type + +{{-'\n'}} +{%- for i in range(namelists|length) %} + use {{namelists[i]}}_nml_mod, only: {{namelists[i]}}_nml_type +{%- endfor %} + + implicit none + + private + + !----------------------------------------------------------------------------- + ! Type that stores namelists of an application configuration + !----------------------------------------------------------------------------- + type, public :: config_type + + private + + !> The name of the namelist collection if provided. + character(:), allocatable :: config_name + + !> Whether object has been initialised or not + logical :: isinitialised = .false. + + !> The name of the namelist collection if provided. + character(str_def), allocatable :: nml_fullnames(:) + +{{-'\n'}} + ! Single instance namelists +{%- for i in range(namelists|length) %} +{%- if not duplicates[i] %} + type({{namelists[i]}}_nml_type), public, allocatable :: {{namelists[i]}} +{%- endif %} +{%- endfor %} + + ! Namelists which may have multiple instances. + ! These are accesed via the associated + ! _list methods. +{%- for i in range(namelists|length) %} +{%- if duplicates[i] %} + type(linked_list_type), public, allocatable :: {{namelists[i]}} +{%- endif %} +{%- endfor %} + + contains + + procedure, public :: initialise + procedure, public :: name + procedure, public :: add_namelist + procedure, public :: contents + procedure, public :: n_namelists + procedure, public :: namelist_exists + +{{-'\n'}} +{%- for i in range(namelists|length) %} +{%- if duplicates[i] %} + procedure, public :: {{namelists[i]}}_list +{%- endif %} +{%- endfor %} + + procedure, public :: clear + + final :: config_destructor + + procedure, private :: update_contents + + end type config_type + +contains + + +!> @brief Initialises application configuration. +!> @param [in] name Optional: The name given to the configuration. +!===================================================================== +subroutine initialise(self, name) + + implicit none + + class(config_type), intent(inout) :: self + + character(*), optional, intent(in) :: name + + if (self%isinitialised) then + write(log_scratch_space, '(A)') & + 'Application configuration: [' // & + trim(self%config_name) // & + '] has already been initiaised.' + call log_event(log_scratch_space, log_level_error) + end if + + if (present(name)) then + self%config_name = trim(name) + else + self%config_name = cmdi + end if + + self%isinitialised = .true. + +end subroutine initialise + + +!> @brief Installs a new namelist object into the configuration. +!> @param [in] namelist_obj The extended namelist type object. Only +!> extended namelist types defined by the +!> application metadata file will be accepted. +!=================================================================== +subroutine add_namelist(self, namelist_obj) + + implicit none + + class(config_type), intent(inout) :: self + + class(namelist_type), intent(in) :: namelist_obj + + character(:), allocatable :: name + character(:), allocatable :: profile_name + character(:), allocatable :: full_name + + ! Check namelist name is valid, if not then exit with error + full_name = namelist_obj%get_full_name() + profile_name = namelist_obj%get_profile_name() + name = namelist_obj%get_listname() + + select type(namelist_obj) +{{-'\n'}} +{%- for i in range(namelists|length) %} +{%- if not duplicates[i] %} + type is( {{namelists[i]}}_nml_type ) + ! Multiple instances: NOT ALLOWED + if (self%namelist_exists(trim(name))) then + write(log_scratch_space, '(A)') & + trim(name) // ' namelist already allocated.' + call log_event(log_scratch_space, log_level_error) + else + allocate(self%{{namelists[i]}}, source=namelist_obj) + call self%update_contents(trim(name)) + end if +{% endif %} +{%- endfor %} + +{%- for i in range(namelists|length) %} +{%- if duplicates[i] %} + type is ( {{namelists[i]}}_nml_type ) + ! Multiple instances: ALLOWED + if (trim(profile_name) == cmdi) then + write(log_scratch_space, '(A)') 'Ignoring ' // trim(name) // & + ' namelist: missing profile name.' + call log_event(log_scratch_space, log_level_warning) + else if (self%namelist_exists(trim(full_name))) then + write(log_scratch_space, '(A)') trim(name) // & + ' namelist (' // trim(profile_name) // '), already allocated.' + call log_event(log_scratch_space, log_level_error) + else + if (.not. allocated(self%{{namelists[i]}})) then + allocate(self%{{namelists[i]}}) + end if + call self%{{namelists[i]}}%insert_item( namelist_obj ) + call self%update_contents(namelist_obj%get_full_name()) + end if +{% endif %} +{%- endfor %} + class default + write(log_scratch_space, '(A)') & + ' Undefined namelist type(' // trim(name) // & + '), for this configuration.' + call log_event(log_scratch_space, log_level_error) + + end select + +end subroutine add_namelist + + +!> @brief Check if a namelist is present the collection. +!> @param [in] name The name of the namelist to be checked. +!> @param [in] profile_name Optional: In the case of namelists which +!> are permitted to have multiple instances, +!> the profile name distiguishes the instances +!> of namelists. +!> @return exists Flag stating if namelist is present or not +!===================================================================== +function namelist_exists(self, name, profile_name) result(exists) + + implicit none + + class(config_type), intent(in) :: self + + character(*), intent(in) :: name + character(*), optional, intent(in) :: profile_name + + logical(l_def) :: exists + + integer(i_def) :: i + character(str_def) :: full_name + + exists = .false. + + if (allocated(self%nml_fullnames)) then + + if (present(profile_name)) then + full_name = trim(name)//':'//trim(profile_name) + else + full_name = trim(name) + end if + + do i=1, size(self%nml_fullnames) + if (trim(self%nml_fullnames(i)) == trim(full_name)) then + exists = .true. + exit + end if + end do + end if + +end function namelist_exists + +{{-'\n'}} +{%- for i in range(namelists|length) %} +{%- if duplicates[i] %} + +!> @brief Returns a pointer to an instance of <{{namelists[i]}}_nml_type>. +!> @param [in] profile_name Profile name used to identify the +!> instance of <{{namelists[i]}}_nml_type>. +!> @return {{namelists[i]}}_nml_obj Pointer to the requested namelist object. +!===================================================================== +function {{namelists[i]}}_list(self, profile_name) result({{namelists[i]}}_nml_obj) + + implicit none + + class(config_type), intent(in) :: self + character(*), intent(in) :: profile_name + + type({{namelists[i]}}_nml_type), pointer :: {{namelists[i]}}_nml_obj + + ! Pointer to linked list - used for looping through the list + type(linked_list_item_type), pointer :: loop + character(str_def) :: payload_name + + nullify({{namelists[i]}}_nml_obj) + nullify(loop) + + loop => self%{{namelists[i]}}%get_head() + do + ! If the list is empty or the end of the list was + ! reached without finding the namelist, fail with + ! an error. + if (.not. associated(loop)) then + write(log_scratch_space, '(A)') & + 'Instance ' // trim(profile_name) // ' of ' // & + '{{namelists[i]}}_nml_type ' // & + 'not found in configuration.' + call log_event(log_scratch_space, log_level_error) + end if + + ! Otherwise 'cast' to a {{namelists[i]}}_namelist_type + select type(payload => loop%payload) + type is ({{namelists[i]}}_nml_type) + payload_name = payload%get_profile_name() + if (trim(profile_name) == trim(payload_name)) then + {{namelists[i]}}_nml_obj => payload + exit + end if + end select + + loop => loop%next + end do + +end function {{namelists[i]}}_list + +{%- endif %} +{%- endfor %} + +!> @brief Queries config_type for the total number of namelists stored. +!> @return answer The number of namelists stored +!===================================================================== +function n_namelists(self) result(answer) + + implicit none + + class(config_type), intent(in) :: self + + integer(i_def) :: answer + + answer = 0 + if (allocated(self%nml_fullnames)) then + answer = size(self%nml_fullnames) + end if + +end function n_namelists + +!> @brief Queries the name of config_type. +!> @return name The name identifying this namelist collection +!> on initialisation. +!===================================================================== +function name(self) result(answer) + + implicit none + + class(config_type), intent(in) :: self + character(:), allocatable :: answer + + answer = self%config_name + +end function name + +!> @brief Extracts namelist names in config_type. +!> @param listname Optional: if specified, returns entries +!> begining with this string. +!> @return namelist_names Array of unique names of namelists in the +!> collection. +!===================================================================== +function contents(self, listname) result(namelist_names) + + implicit none + + class(config_type), intent(in) :: self + + character(*), optional, intent(in) :: listname + + character(str_def), allocatable :: namelist_names(:) + + character(str_def), allocatable :: tmp(:) + character(str_def) :: tmp_str + integer(i_def) :: n_found, i, start_index + + if (allocated(namelist_names)) deallocate(namelist_names) + + n_found = 0 + if (present(listname)) then + + allocate(tmp(size(self%nml_fullnames))) + + do i=1, size(self%nml_fullnames) + if (index(trim(self%nml_fullnames(i)), trim(listname)) > 0) then + tmp_str = trim(self%nml_fullnames(i)) + start_index = index(tmp_str, ':') + n_found = n_found + 1_i_def + tmp(n_found) = trim(tmp_str(start_index+1:)) + end if + end do + + allocate(namelist_names(n_found)) + namelist_names = tmp(1:n_found) + deallocate(tmp) + + else + + allocate(namelist_names, source=self%nml_fullnames) + + end if + +end function contents + + +!> @brief Clears all items from the namelist collection. +!===================================================================== +subroutine clear(self) + + implicit none + + class(config_type), intent(inout) :: self + +{{-'\n'}} + ! Namlists which may have multiple instances per configuration +{%- for i in range(namelists|length) %} +{%- if duplicates[i] %} + if (allocated(self%{{namelists[i]}})) call self%{{namelists[i]}}%clear() +{%- endif %} +{%- endfor %} +{% for i in range(namelists|length) %} + if (allocated(self%{{namelists[i]}})) deallocate(self%{{namelists[i]}}) +{%- endfor %} + + if (allocated(self%nml_fullnames)) deallocate(self%nml_fullnames) + + self%config_name = cmdi + self%isinitialised = .false. + +end subroutine clear + + +!> @brief Destructor for the namelist collection +!===================================================================== +subroutine config_destructor(self) + + implicit none + + type(config_type), intent(inout) :: self + + call self%clear() + +end subroutine config_destructor + + +!> @brief Adds namelist identifier to the to list on namelists stored. +!> @param [in] nml_full_name Namelists identifier to be added. +!===================================================================== +subroutine update_contents(self, nml_full_name) + + implicit none + + class(config_type), intent(inout) :: self + + character(*), intent(in) :: nml_full_name + + character(str_def), allocatable :: tmp_str(:) + integer(i_def) :: n_entries + + if (allocated(self%nml_fullnames)) then + + n_entries = size(self%nml_fullnames) + allocate(tmp_str, source=self%nml_fullnames) + deallocate(self%nml_fullnames) + allocate(self%nml_fullnames(n_entries+1)) + self%nml_fullnames(1:n_entries) = tmp_str(:) + self%nml_fullnames(n_entries+1) = nml_full_name + + else + + allocate(self%nml_fullnames(1)) + self%nml_fullnames(1) = trim(nml_full_name) + + end if + +end subroutine update_contents + +end module {{moduleName}} diff --git a/infrastructure/build/tools/configurator/templates/extended_namelist_type.f90.jinja b/infrastructure/build/tools/configurator/templates/extended_namelist_type.f90.jinja new file mode 100644 index 000000000..52c3cd22a --- /dev/null +++ b/infrastructure/build/tools/configurator/templates/extended_namelist_type.f90.jinja @@ -0,0 +1,63 @@ +{#- This is the skeleton of the namelist loading module. -#} +{#- The Jinja templating library is used to insert the actual code. -#} +!----------------------------------------------------------------------------- +! (C) Crown copyright 2025 Met Office. All rights reserved. +! The file LICENCE, distributed with this code, contains details of the terms +! under which the code may be used. +!----------------------------------------------------------------------------- +!> Manages the {{listname}} namelist. +!> +module {{listname}}_nml_mod + + use constants_mod, only: {{all_kinds | sort | join( ', &\n' + ' '*27 )}} + + use namelist_mod, only: namelist_type + + implicit none + + private + public :: {{listname}}_nml_type + + type, extends(namelist_type) :: {{listname}}_nml_type + private + contains + +{%- for name, parameter in parameters | dictsort %} +{%- if loop.first %}{{'\n'}}{%- endif %} + procedure :: {{parameter.name}} +{%- endfor %} + + end type {{listname}}_nml_type + +contains +{%- for name, parameter in parameters | dictsort %} +{%- if loop.first %}{{'\n'}}{%- endif %} +{%- if name in arrays %} +{# Template function to return an array namelist member #} + function {{parameter.name}}(self) result(answer) + + implicit none + + class({{listname}}_nml_type), intent(in) :: self + {{parameter.fortran_type.intrinsic_type}}({{parameter.fortran_type.kind}}), allocatable :: answer(:) + + call self%get_value('{{name}}', answer) + + end function {{parameter.name}} + +{%- else %} +{# Template function to return an scalar namelist member #} + function {{parameter.name}}(self) result(answer) + + implicit none + + class({{listname}}_nml_type), intent(in) :: self + {{parameter.fortran_type.intrinsic_type}}({{parameter.fortran_type.kind}}) :: answer + + call self%get_value('{{name}}', answer) + + end function {{parameter.name}} + +{%- endif %} +{% endfor %} +end module {{listname}}_nml_mod diff --git a/infrastructure/build/tools/configurator/templates/namelist_iterator_type.f90.jinja b/infrastructure/build/tools/configurator/templates/namelist_iterator_type.f90.jinja new file mode 100644 index 000000000..d0a882bf1 --- /dev/null +++ b/infrastructure/build/tools/configurator/templates/namelist_iterator_type.f90.jinja @@ -0,0 +1,117 @@ +{#- This is the skeleton of the namelist iterator module. -#} +{#- Provides and iterator for extended namelist types that may have -#} +{#- multiple instances. -#} +{#- The Jinja templating library is used to insert the actual code. -#} +!----------------------------------------------------------------------------- +! (C) Crown copyright 2025 Met Office. All rights reserved. +! The file LICENCE, distributed with this code, contains details of the terms +! under which the code may be used. +!----------------------------------------------------------------------------- +! +!> @brief Provides functionality for iterating over all members of a defined +!> namelist ({{listname}}) collection. +!> +!> @details Provides functionality for iteratively returning every member +!> of the defined namelist ({{listname}}) collection. The order of +!> the namelists returned is not defined and can change if the +!> implementation of the namelist collection is changed. +! +module {{listname}}_nml_iterator_mod + + use constants_mod, only: l_def + use linked_list_mod, only: linked_list_type, & + linked_list_item_type + + use {{listname}}_nml_mod, only: {{listname}}_nml_type + + implicit none + + private + public :: {{listname}}_nml_iterator_type + + !----------------------------------------------------------------------------- + ! Type that iterates through a linked list of only {{listname}}_nml_type + !----------------------------------------------------------------------------- + type :: {{listname}}_nml_iterator_type + + private + + !> A pointer to the namelist list being iterated over + type(linked_list_type), pointer :: {{listname}}_list + + !> A pointer to the linked list item within the + !> linked list that will contain the next namelist + !> to be returned + type(linked_list_item_type), pointer :: current + + contains + + procedure, public :: initialise + procedure, public :: next + procedure, public :: has_next + + end type {{listname}}_nml_iterator_type + +contains + +!> @brief Initialise a {{listname}} namelist collection iterator +!> @param [in] nml_list Linked list containing only +!> {{listname}}_nml_types to iterate over. +subroutine initialise(self, nml_list) + + implicit none + + class({{listname}}_nml_iterator_type), intent(inout) :: self + type(linked_list_type), intent(in), target :: nml_list + + ! Store a pointer to the collection being iterated over + self%{{listname}}_list => nml_list + + ! Start the iterator at the beginning of the nml_list. + nullify(self%current) + self%current => self%{{listname}}_list%get_head() + +end subroutine initialise + +!> @brief Returns the next {{listname}} namelist from the collection +!> @return A pointer to the next {{listname}} namelist in the collection +function next(self) result (nml_obj) + + implicit none + + class({{listname}}_nml_iterator_type), intent(inout), target :: self + type({{listname}}_nml_type), pointer :: nml_obj + + nml_obj => null() + + ! Empty lists are valid + ! + if (.not. associated(self%current)) return + + ! Extract a pointer to the current namelist + select type(list_nml => self%current%payload) + type is ({{listname}}_nml_type) + nml_obj => list_nml + end select + + ! Move the current item pointer onto the next item + self%current => self%current%next + +end function next + +!> @brief Checks if there are any further namelists in the collection +!> being iterated over. +!> @return next .true. if there is another namelist in the collection. +function has_next(self) result(next) + + implicit none + + class({{listname}}_nml_iterator_type), intent(in) :: self + logical(l_def) :: next + + next = .true. + if (.not.associated(self%current)) next = .false. + +end function has_next + +end module {{listname}}_nml_iterator_mod diff --git a/infrastructure/build/tools/configurator/templates/namelist.f90.jinja b/infrastructure/build/tools/configurator/templates/namelist_loader.f90.jinja similarity index 93% rename from infrastructure/build/tools/configurator/templates/namelist.f90.jinja rename to infrastructure/build/tools/configurator/templates/namelist_loader.f90.jinja index 3fda6acd1..abce2d3db 100644 --- a/infrastructure/build/tools/configurator/templates/namelist.f90.jinja +++ b/infrastructure/build/tools/configurator/templates/namelist_loader.f90.jinja @@ -34,7 +34,7 @@ module {{listname}}_config_mod {{' '*12}}{{listname}}_is_loadable, {{listname}}_is_loaded, & {{' '*12}}{{listname}}_reset_load_status, & {{' '*12}}{{listname}}_multiples_allowed, {{listname}}_final, & -{{' '*12}}get_{{listname}}_nml +{{' '*12}}get_{{listname}}_nml, get_new_{{listname}}_nml {%- for name in enumerations | sort %} {%- if loop.first %}{{'\n'}}{%- endif %} @@ -365,8 +365,8 @@ contains {%- for name, parameter in parameters | dictsort %} {%- if loop.first %}{{'\n'}}{% endif %} - call members({{loop.index}})%initialise( & - '{{parameter.name}}', {{parameter.name}} ) + call members({{loop.index}})%initialise( & + '{{parameter.name}}', {{parameter.name}} ) {{- '\n'}} {%- endfor %} if (trim(profile_name) /= trim(cmdi) ) then @@ -380,6 +380,35 @@ contains end function get_{{listname}}_nml + !> @brief Returns a <<{{listname}}_nml_type>> object populated with the + !> current contents of this configuration module. + !> @return namelist_obj <<{{listname}}_nml_type>> with current namelist contents. + function get_new_{{listname}}_nml() result(namelist_obj) + + use {{listname}}_nml_mod, only: {{listname}}_nml_type + + implicit none + + type({{listname}}_nml_type) :: namelist_obj + type(namelist_item_type) :: members({{parameters|length}}) + +{%- for name, parameter in parameters | dictsort %} +{%- if loop.first %}{{'\n'}}{% endif %} + call members({{loop.index}})%initialise( & + '{{parameter.name}}', {{parameter.name}} ) +{{- '\n'}} +{%- endfor %} + if (trim(profile_name) /= trim(cmdi) ) then + call namelist_obj%initialise( trim(listname), & + members, & + profile_name = profile_name ) + else + call namelist_obj%initialise( trim(listname), & + members ) + end if + + end function get_new_{{listname}}_nml + !> Performs any processing to be done once all namelists are loaded !> diff --git a/infrastructure/build/tools/configurator/tests/app_config/bar_nml_iterator_mod.f90 b/infrastructure/build/tools/configurator/tests/app_config/bar_nml_iterator_mod.f90 new file mode 100644 index 000000000..81329a75b --- /dev/null +++ b/infrastructure/build/tools/configurator/tests/app_config/bar_nml_iterator_mod.f90 @@ -0,0 +1,113 @@ +!----------------------------------------------------------------------------- +! (C) Crown copyright 2025 Met Office. All rights reserved. +! The file LICENCE, distributed with this code, contains details of the terms +! under which the code may be used. +!----------------------------------------------------------------------------- +! +!> @brief Provides functionality for iterating over all members of a defined +!> namelist (bar) collection. +!> +!> @details Provides functionality for iteratively returning every member +!> of the defined namelist (bar) collection. The order of +!> the namelists returned is not defined and can change if the +!> implementation of the namelist collection is changed. +! +module bar_nml_iterator_mod + + use constants_mod, only: l_def + use linked_list_mod, only: linked_list_type, & + linked_list_item_type + + use bar_nml_mod, only: bar_nml_type + + implicit none + + private + public :: bar_nml_iterator_type + + !----------------------------------------------------------------------------- + ! Type that iterates through a linked list of only bar_nml_type + !----------------------------------------------------------------------------- + type :: bar_nml_iterator_type + + private + + !> A pointer to the namelist list being iterated over + type(linked_list_type), pointer :: bar_list + + !> A pointer to the linked list item within the + !> linked list that will contain the next namelist + !> to be returned + type(linked_list_item_type), pointer :: current + + contains + + procedure, public :: initialise + procedure, public :: next + procedure, public :: has_next + + end type bar_nml_iterator_type + +contains + +!> @brief Initialise a bar namelist collection iterator +!> @param [in] nml_list Linked list containing only +!> bar_nml_types to iterate over. +subroutine initialise(self, nml_list) + + implicit none + + class(bar_nml_iterator_type), intent(inout) :: self + type(linked_list_type), intent(in), target :: nml_list + + ! Store a pointer to the collection being iterated over + self%bar_list => nml_list + + ! Start the iterator at the beginning of the nml_list. + nullify(self%current) + self%current => self%bar_list%get_head() + +end subroutine initialise + +!> @brief Returns the next bar namelist from the collection +!> @return A pointer to the next bar namelist in the collection +function next(self) result (nml_obj) + + implicit none + + class(bar_nml_iterator_type), intent(inout), target :: self + type(bar_nml_type), pointer :: nml_obj + + nml_obj => null() + + ! Empty lists are valid + ! + if (.not. associated(self%current)) return + + ! Extract a pointer to the current namelist + select type(list_nml => self%current%payload) + type is (bar_nml_type) + nml_obj => list_nml + end select + + ! Move the current item pointer onto the next item + self%current => self%current%next + +end function next + +!> @brief Checks if there are any further namelists in the collection +!> being iterated over. +!> @return next .true. if there is another namelist in the collection. +function has_next(self) result(next) + + implicit none + + class(bar_nml_iterator_type), intent(in) :: self + logical(l_def) :: next + + next = .true. + if (.not.associated(self%current)) next = .false. + +end function has_next + +end module bar_nml_iterator_mod diff --git a/infrastructure/build/tools/configurator/tests/app_config/content_mod.f90 b/infrastructure/build/tools/configurator/tests/app_config/content_mod.f90 new file mode 100644 index 000000000..cad68a8b5 --- /dev/null +++ b/infrastructure/build/tools/configurator/tests/app_config/content_mod.f90 @@ -0,0 +1,498 @@ +!----------------------------------------------------------------------------- +! (C) Crown copyright 2025 Met Office. All rights reserved. +! The file LICENCE, distributed with this code, contains details of the terms +! under which the code may be used. +!----------------------------------------------------------------------------- +! +!> @brief Defines \ object. +!> @details A container object that holds namelist +!> objects of various types). +!> +!> Access pattern will differ for namelist types that are permitted +!> to have multiple instances within the configuration. +!> +module config_mod + + use constants_mod, only: i_def, l_def, str_def, cmdi + use log_mod, only: log_event, log_scratch_space, & + log_level_error, log_level_warning + use linked_list_mod, only: linked_list_type, linked_list_item_type + + use namelist_mod, only: namelist_type + use namelist_collection_mod, only: namelist_collection_type + + use foo_nml_mod, only: foo_nml_type + use bar_nml_mod, only: bar_nml_type + use moo_nml_mod, only: moo_nml_type + use pot_nml_mod, only: pot_nml_type + + implicit none + + private + + !----------------------------------------------------------------------------- + ! Type that stores namelists of an application configuration + !----------------------------------------------------------------------------- + type, public :: config_type + + private + + !> The name of the namelist collection if provided. + character(:), allocatable :: config_name + + !> Whether object has been initialised or not + logical :: isinitialised = .false. + + !> The name of the namelist collection if provided. + character(str_def), allocatable :: nml_fullnames(:) + + ! Single instance namelists + type(foo_nml_type), public, allocatable :: foo + type(moo_nml_type), public, allocatable :: moo + + ! Namelists which may have multiple instances. + ! These are accesed via the associated + ! _list methods. + type(linked_list_type), public, allocatable :: bar + type(linked_list_type), public, allocatable :: pot + + contains + + procedure, public :: initialise + procedure, public :: name + procedure, public :: add_namelist + procedure, public :: contents + procedure, public :: n_namelists + procedure, public :: namelist_exists + + procedure, public :: bar_list + procedure, public :: pot_list + + procedure, public :: clear + + final :: config_destructor + + procedure, private :: update_contents + + end type config_type + +contains + + +!> @brief Initialises application configuration. +!> @param [in] name Optional: The name given to the configuration. +!===================================================================== +subroutine initialise(self, name) + + implicit none + + class(config_type), intent(inout) :: self + + character(*), optional, intent(in) :: name + + if (self%isinitialised) then + write(log_scratch_space, '(A)') & + 'Application configuration: [' // & + trim(self%config_name) // & + '] has already been initiaised.' + call log_event(log_scratch_space, log_level_error) + end if + + if (present(name)) then + self%config_name = trim(name) + else + self%config_name = cmdi + end if + + self%isinitialised = .true. + +end subroutine initialise + + +!> @brief Installs a new namelist object into the configuration. +!> @param [in] namelist_obj The extended namelist type object. Only +!> extended namelist types defined by the +!> application metadata file will be accepted. +!=================================================================== +subroutine add_namelist(self, namelist_obj) + + implicit none + + class(config_type), intent(inout) :: self + + class(namelist_type), intent(in) :: namelist_obj + + character(:), allocatable :: name + character(:), allocatable :: profile_name + character(:), allocatable :: full_name + + ! Check namelist name is valid, if not then exit with error + full_name = namelist_obj%get_full_name() + profile_name = namelist_obj%get_profile_name() + name = namelist_obj%get_listname() + + select type(namelist_obj) + + type is( foo_nml_type ) + ! Multiple instances: NOT ALLOWED + if (self%namelist_exists(trim(name))) then + write(log_scratch_space, '(A)') & + trim(name) // ' namelist already allocated.' + call log_event(log_scratch_space, log_level_error) + else + allocate(self%foo, source=namelist_obj) + call self%update_contents(trim(name)) + end if + + type is( moo_nml_type ) + ! Multiple instances: NOT ALLOWED + if (self%namelist_exists(trim(name))) then + write(log_scratch_space, '(A)') & + trim(name) // ' namelist already allocated.' + call log_event(log_scratch_space, log_level_error) + else + allocate(self%moo, source=namelist_obj) + call self%update_contents(trim(name)) + end if + + type is ( bar_nml_type ) + ! Multiple instances: ALLOWED + if (trim(profile_name) == cmdi) then + write(log_scratch_space, '(A)') 'Ignoring ' // trim(name) // & + ' namelist: missing profile name.' + call log_event(log_scratch_space, log_level_warning) + else if (self%namelist_exists(trim(full_name))) then + write(log_scratch_space, '(A)') trim(name) // & + ' namelist (' // trim(profile_name) // '), already allocated.' + call log_event(log_scratch_space, log_level_error) + else + if (.not. allocated(self%bar)) then + allocate(self%bar) + end if + call self%bar%insert_item( namelist_obj ) + call self%update_contents(namelist_obj%get_full_name()) + end if + + type is ( pot_nml_type ) + ! Multiple instances: ALLOWED + if (trim(profile_name) == cmdi) then + write(log_scratch_space, '(A)') 'Ignoring ' // trim(name) // & + ' namelist: missing profile name.' + call log_event(log_scratch_space, log_level_warning) + else if (self%namelist_exists(trim(full_name))) then + write(log_scratch_space, '(A)') trim(name) // & + ' namelist (' // trim(profile_name) // '), already allocated.' + call log_event(log_scratch_space, log_level_error) + else + if (.not. allocated(self%pot)) then + allocate(self%pot) + end if + call self%pot%insert_item( namelist_obj ) + call self%update_contents(namelist_obj%get_full_name()) + end if + + class default + write(log_scratch_space, '(A)') & + ' Undefined namelist type(' // trim(name) // & + '), for this configuration.' + call log_event(log_scratch_space, log_level_error) + + end select + +end subroutine add_namelist + + +!> @brief Check if a namelist is present the collection. +!> @param [in] name The name of the namelist to be checked. +!> @param [in] profile_name Optional: In the case of namelists which +!> are permitted to have multiple instances, +!> the profile name distiguishes the instances +!> of namelists. +!> @return exists Flag stating if namelist is present or not +!===================================================================== +function namelist_exists(self, name, profile_name) result(exists) + + implicit none + + class(config_type), intent(in) :: self + + character(*), intent(in) :: name + character(*), optional, intent(in) :: profile_name + + logical(l_def) :: exists + + integer(i_def) :: i + character(str_def) :: full_name + + exists = .false. + + if (allocated(self%nml_fullnames)) then + + if (present(profile_name)) then + full_name = trim(name)//':'//trim(profile_name) + else + full_name = trim(name) + end if + + do i=1, size(self%nml_fullnames) + if (trim(self%nml_fullnames(i)) == trim(full_name)) then + exists = .true. + exit + end if + end do + end if + +end function namelist_exists + + +!> @brief Returns a pointer to an instance of . +!> @param [in] profile_name Profile name used to identify the +!> instance of . +!> @return bar_nml_obj Pointer to the requested namelist object. +!===================================================================== +function bar_list(self, profile_name) result(bar_nml_obj) + + implicit none + + class(config_type), intent(in) :: self + character(*), intent(in) :: profile_name + + type(bar_nml_type), pointer :: bar_nml_obj + + ! Pointer to linked list - used for looping through the list + type(linked_list_item_type), pointer :: loop + character(str_def) :: payload_name + + nullify(bar_nml_obj) + nullify(loop) + + loop => self%bar%get_head() + do + ! If the list is empty or the end of the list was + ! reached without finding the namelist, fail with + ! an error. + if (.not. associated(loop)) then + write(log_scratch_space, '(A)') & + 'Instance ' // trim(profile_name) // ' of ' // & + 'bar_nml_type ' // & + 'not found in configuration.' + call log_event(log_scratch_space, log_level_error) + end if + + ! Otherwise 'cast' to a bar_namelist_type + select type(payload => loop%payload) + type is (bar_nml_type) + payload_name = payload%get_profile_name() + if (trim(profile_name) == trim(payload_name)) then + bar_nml_obj => payload + exit + end if + end select + + loop => loop%next + end do + +end function bar_list + +!> @brief Returns a pointer to an instance of . +!> @param [in] profile_name Profile name used to identify the +!> instance of . +!> @return pot_nml_obj Pointer to the requested namelist object. +!===================================================================== +function pot_list(self, profile_name) result(pot_nml_obj) + + implicit none + + class(config_type), intent(in) :: self + character(*), intent(in) :: profile_name + + type(pot_nml_type), pointer :: pot_nml_obj + + ! Pointer to linked list - used for looping through the list + type(linked_list_item_type), pointer :: loop + character(str_def) :: payload_name + + nullify(pot_nml_obj) + nullify(loop) + + loop => self%pot%get_head() + do + ! If the list is empty or the end of the list was + ! reached without finding the namelist, fail with + ! an error. + if (.not. associated(loop)) then + write(log_scratch_space, '(A)') & + 'Instance ' // trim(profile_name) // ' of ' // & + 'pot_nml_type ' // & + 'not found in configuration.' + call log_event(log_scratch_space, log_level_error) + end if + + ! Otherwise 'cast' to a pot_namelist_type + select type(payload => loop%payload) + type is (pot_nml_type) + payload_name = payload%get_profile_name() + if (trim(profile_name) == trim(payload_name)) then + pot_nml_obj => payload + exit + end if + end select + + loop => loop%next + end do + +end function pot_list + +!> @brief Queries config_type for the total number of namelists stored. +!> @return answer The number of namelists stored +!===================================================================== +function n_namelists(self) result(answer) + + implicit none + + class(config_type), intent(in) :: self + + integer(i_def) :: answer + + answer = 0 + if (allocated(self%nml_fullnames)) then + answer = size(self%nml_fullnames) + end if + +end function n_namelists + +!> @brief Queries the name of config_type. +!> @return name The name identifying this namelist collection +!> on initialisation. +!===================================================================== +function name(self) result(answer) + + implicit none + + class(config_type), intent(in) :: self + character(:), allocatable :: answer + + answer = self%config_name + +end function name + +!> @brief Extracts namelist names in config_type. +!> @param listname Optional: if specified, returns entries +!> begining with this string. +!> @return namelist_names Array of unique names of namelists in the +!> collection. +!===================================================================== +function contents(self, listname) result(namelist_names) + + implicit none + + class(config_type), intent(in) :: self + + character(*), optional, intent(in) :: listname + + character(str_def), allocatable :: namelist_names(:) + + character(str_def), allocatable :: tmp(:) + character(str_def) :: tmp_str + integer(i_def) :: n_found, i, start_index + + if (allocated(namelist_names)) deallocate(namelist_names) + + n_found = 0 + if (present(listname)) then + + allocate(tmp(size(self%nml_fullnames))) + + do i=1, size(self%nml_fullnames) + if (index(trim(self%nml_fullnames(i)), trim(listname)) > 0) then + tmp_str = trim(self%nml_fullnames(i)) + start_index = index(tmp_str, ':') + n_found = n_found + 1_i_def + tmp(n_found) = trim(tmp_str(start_index+1:)) + end if + end do + + allocate(namelist_names(n_found)) + namelist_names = tmp(1:n_found) + deallocate(tmp) + + else + + allocate(namelist_names, source=self%nml_fullnames) + + end if + +end function contents + + +!> @brief Clears all items from the namelist collection. +!===================================================================== +subroutine clear(self) + + implicit none + + class(config_type), intent(inout) :: self + + ! Namlists which may have multiple instances per configuration + if (allocated(self%bar)) call self%bar%clear() + if (allocated(self%pot)) call self%pot%clear() + + if (allocated(self%foo)) deallocate(self%foo) + if (allocated(self%bar)) deallocate(self%bar) + if (allocated(self%moo)) deallocate(self%moo) + if (allocated(self%pot)) deallocate(self%pot) + + if (allocated(self%nml_fullnames)) deallocate(self%nml_fullnames) + + self%config_name = cmdi + self%isinitialised = .false. + +end subroutine clear + + +!> @brief Destructor for the namelist collection +!===================================================================== +subroutine config_destructor(self) + + implicit none + + type(config_type), intent(inout) :: self + + call self%clear() + +end subroutine config_destructor + + +!> @brief Adds namelist identifier to the to list on namelists stored. +!> @param [in] nml_full_name Namelists identifier to be added. +!===================================================================== +subroutine update_contents(self, nml_full_name) + + implicit none + + class(config_type), intent(inout) :: self + + character(*), intent(in) :: nml_full_name + + character(str_def), allocatable :: tmp_str(:) + integer(i_def) :: n_entries + + if (allocated(self%nml_fullnames)) then + + n_entries = size(self%nml_fullnames) + allocate(tmp_str, source=self%nml_fullnames) + deallocate(self%nml_fullnames) + allocate(self%nml_fullnames(n_entries+1)) + self%nml_fullnames(1:n_entries) = tmp_str(:) + self%nml_fullnames(n_entries+1) = nml_full_name + + else + + allocate(self%nml_fullnames(1)) + self%nml_fullnames(1) = trim(nml_full_name) + + end if + +end subroutine update_contents + +end module config_mod diff --git a/infrastructure/build/tools/configurator/tests/app_config/pot_nml_iterator_mod.f90 b/infrastructure/build/tools/configurator/tests/app_config/pot_nml_iterator_mod.f90 new file mode 100644 index 000000000..9d598b07c --- /dev/null +++ b/infrastructure/build/tools/configurator/tests/app_config/pot_nml_iterator_mod.f90 @@ -0,0 +1,113 @@ +!----------------------------------------------------------------------------- +! (C) Crown copyright 2025 Met Office. All rights reserved. +! The file LICENCE, distributed with this code, contains details of the terms +! under which the code may be used. +!----------------------------------------------------------------------------- +! +!> @brief Provides functionality for iterating over all members of a defined +!> namelist (pot) collection. +!> +!> @details Provides functionality for iteratively returning every member +!> of the defined namelist (pot) collection. The order of +!> the namelists returned is not defined and can change if the +!> implementation of the namelist collection is changed. +! +module pot_nml_iterator_mod + + use constants_mod, only: l_def + use linked_list_mod, only: linked_list_type, & + linked_list_item_type + + use pot_nml_mod, only: pot_nml_type + + implicit none + + private + public :: pot_nml_iterator_type + + !----------------------------------------------------------------------------- + ! Type that iterates through a linked list of only pot_nml_type + !----------------------------------------------------------------------------- + type :: pot_nml_iterator_type + + private + + !> A pointer to the namelist list being iterated over + type(linked_list_type), pointer :: pot_list + + !> A pointer to the linked list item within the + !> linked list that will contain the next namelist + !> to be returned + type(linked_list_item_type), pointer :: current + + contains + + procedure, public :: initialise + procedure, public :: next + procedure, public :: has_next + + end type pot_nml_iterator_type + +contains + +!> @brief Initialise a pot namelist collection iterator +!> @param [in] nml_list Linked list containing only +!> pot_nml_types to iterate over. +subroutine initialise(self, nml_list) + + implicit none + + class(pot_nml_iterator_type), intent(inout) :: self + type(linked_list_type), intent(in), target :: nml_list + + ! Store a pointer to the collection being iterated over + self%pot_list => nml_list + + ! Start the iterator at the beginning of the nml_list. + nullify(self%current) + self%current => self%pot_list%get_head() + +end subroutine initialise + +!> @brief Returns the next pot namelist from the collection +!> @return A pointer to the next pot namelist in the collection +function next(self) result (nml_obj) + + implicit none + + class(pot_nml_iterator_type), intent(inout), target :: self + type(pot_nml_type), pointer :: nml_obj + + nml_obj => null() + + ! Empty lists are valid + ! + if (.not. associated(self%current)) return + + ! Extract a pointer to the current namelist + select type(list_nml => self%current%payload) + type is (pot_nml_type) + nml_obj => list_nml + end select + + ! Move the current item pointer onto the next item + self%current => self%current%next + +end function next + +!> @brief Checks if there are any further namelists in the collection +!> being iterated over. +!> @return next .true. if there is another namelist in the collection. +function has_next(self) result(next) + + implicit none + + class(pot_nml_iterator_type), intent(in) :: self + logical(l_def) :: next + + next = .true. + if (.not.associated(self%current)) next = .false. + +end function has_next + +end module pot_nml_iterator_mod diff --git a/infrastructure/build/tools/configurator/tests/app_config/test_app_config.py b/infrastructure/build/tools/configurator/tests/app_config/test_app_config.py new file mode 100644 index 000000000..f5094edac --- /dev/null +++ b/infrastructure/build/tools/configurator/tests/app_config/test_app_config.py @@ -0,0 +1,50 @@ +#!/usr/bin/env python3 +############################################################################## +# (c) Crown copyright 2025 Met Office. All rights reserved. +# The file LICENCE, distributed with this code, contains details of the terms +# under which the code may be used. +############################################################################## +""" +Unit tests Application Configuration Object generator. +""" + +from pathlib import Path + +import configurator.config_type as AppConfig + +HERE = Path(__file__).resolve().parent + + +class TestAppConfig: + """ + Tests generation of application configuration object. + """ + + def test_with_content(self, tmp_path: Path): # pylint: disable=no-self-use + """ + Generating application configuration object. + """ + uut = AppConfig.AppConfiguration("config_mod") + uut.add_namelist("foo", duplicate=False) + uut.add_namelist("bar", duplicate=True) + uut.add_namelist("moo", duplicate=False) + uut.add_namelist("pot", duplicate=True) + output_file = tmp_path / "content_mod.f90" + uut.write_module(output_file) + + expected_file = HERE / "content_mod.f90" + assert output_file.read_text( + encoding="ascii" + ) + "\n" == expected_file.read_text(encoding="ascii") + + output_file = tmp_path / "bar_nml_iterator_mod.f90" + expected_file = HERE / "bar_nml_iterator_mod.f90" + assert output_file.read_text( + encoding="ascii" + ) + "\n" == expected_file.read_text(encoding="ascii") + + output_file = tmp_path / "pot_nml_iterator_mod.f90" + expected_file = HERE / "pot_nml_iterator_mod.f90" + assert output_file.read_text( + encoding="ascii" + ) + "\n" == expected_file.read_text(encoding="ascii") diff --git a/infrastructure/build/tools/configurator/tests/configuration_loader/content_mod.f90 b/infrastructure/build/tools/configurator/tests/configuration_loader/content_mod.f90 index 2d1e31285..2a4164c97 100644 --- a/infrastructure/build/tools/configurator/tests/configuration_loader/content_mod.f90 +++ b/infrastructure/build/tools/configurator/tests/configuration_loader/content_mod.f90 @@ -13,6 +13,9 @@ module content_mod use namelist_collection_mod, only: namelist_collection_type use namelist_mod, only: namelist_type + use config_mod, only: config_type + + use foo_nml_mod, only: foo_nml_type use foo_config_mod, only : read_foo_namelist, & postprocess_foo_namelist, & @@ -20,7 +23,8 @@ module content_mod foo_is_loaded, & foo_reset_load_status, & foo_final, & - get_foo_nml + get_foo_nml, & + get_new_foo_nml implicit none @@ -33,33 +37,60 @@ module content_mod ! ! [in] filename File holding the namelists. ! - ! TODO: Assumes namelist tags come at the start of lines. ! TODO: Support "namelist file" namelists which recursively call this ! procedure to load other namelist files. ! - subroutine read_configuration( filename, nml_bank ) + subroutine read_configuration( filename, configuration, config ) use io_utility_mod, only : open_file, close_file implicit none character(*), intent(in) :: filename - type(namelist_collection_type), intent(inout) :: nml_bank + + type(namelist_collection_type), optional, intent(inout) :: configuration + type(config_type), optional, intent(inout) :: config integer(i_def) :: local_rank character(str_def), allocatable :: namelists(:) - integer(i_def) :: unit = -1 + integer(i_def) :: unit + + if (.not. present(configuration) .and. .not. present(config)) then + write(log_scratch_space,'(A)') & + 'At least one optional argument must be provided for ' //& + 'read_configuration.' + call log_event(log_scratch_space, log_level_error) + end if local_rank = global_mpi%get_comm_rank() + unit = -1 if (local_rank == 0) unit = open_file( filename ) call get_namelist_names( unit, local_rank, namelists ) - call read_configuration_namelists( unit, local_rank, & - namelists, filename, & - nml_bank ) + if (present(configuration) .and. present(config)) then + ! TODO Transition, remove when all code ported to config + ! access pattern + call read_configuration_namelists( unit, local_rank, & + namelists, filename, & + nml_bank=configuration, & + config=config ) + + else if (present(configuration) .and. .not. present(config)) then + ! TODO Deprecated, remove when all code ported to config + ! access pattern + call read_configuration_namelists( unit, local_rank, & + namelists, filename, & + nml_bank=configuration ) + + else if (.not. present(configuration) .and. present(config)) then + call read_configuration_namelists( unit, local_rank, & + namelists, filename, & + config=config ) + + end if if (local_rank == 0) call close_file( unit ) @@ -97,8 +128,7 @@ subroutine get_namelist_names( unit, local_rank, names ) continue_read = read_line( unit, buffer ) if ( .not. continue_read ) exit text_line_loop - ! TODO: Assumes namelist tags are at the start of lines. #1753 - ! + buffer = adjustl(buffer) if (buffer(1:1) == '&') then namecount = namecount + 1 allocate(names_temp(namecount)) @@ -153,6 +183,7 @@ function ensure_configuration( names, success_mask ) select case(trim( names(i) )) case ('foo') configuration_found = foo_is_loaded() + case default write( log_scratch_space, '(A)' ) & 'Tried to ensure unrecognised namelist "'// & @@ -170,7 +201,7 @@ end function ensure_configuration subroutine read_configuration_namelists( unit, local_rank, & namelists, filename, & - nml_bank ) + nml_bank, config ) implicit none integer(i_def), intent(in) :: unit @@ -178,9 +209,11 @@ subroutine read_configuration_namelists( unit, local_rank, & character(str_def), intent(in) :: namelists(:) character(*), intent(in) :: filename - type(namelist_collection_type), intent(inout) :: nml_bank + type(namelist_collection_type), optional, intent(inout) :: nml_bank + type(config_type), optional, intent(inout) :: config type(namelist_type) :: nml_obj + type(foo_nml_type) :: foo_nml_obj integer(i_def) :: i, j @@ -202,13 +235,23 @@ subroutine read_configuration_namelists( unit, local_rank, & do i=1, size(namelists) select case (trim(namelists(i))) + case ('foo') if (foo_is_loadable()) then call read_foo_namelist( unit, local_rank, scan ) if (.not. scan) then call postprocess_foo_namelist() - nml_obj = get_foo_nml() - call nml_bank%add_namelist(nml_obj) + + if (present(nml_bank)) then + nml_obj = get_foo_nml() + call nml_bank%add_namelist(nml_obj) + end if + + if (present(config)) then + foo_nml_obj = get_new_foo_nml() + call config%add_namelist(foo_nml_obj) + end if + end if else write( log_scratch_space, '(A)' ) & @@ -216,6 +259,7 @@ subroutine read_configuration_namelists( unit, local_rank, & '" can not be read. Too many instances?' call log_event( log_scratch_space, LOG_LEVEL_ERROR ) end if + case default write( log_scratch_space, '(A)' ) & 'Unrecognised namelist "'//trim(namelists(i))// & diff --git a/infrastructure/build/tools/configurator/tests/configuration_loader/empty_mod.f90 b/infrastructure/build/tools/configurator/tests/configuration_loader/empty_mod.f90 deleted file mode 100644 index 132a84345..000000000 --- a/infrastructure/build/tools/configurator/tests/configuration_loader/empty_mod.f90 +++ /dev/null @@ -1,216 +0,0 @@ -!----------------------------------------------------------------------------- -! (C) Crown copyright 2022 Met Office. All rights reserved. -! The file LICENCE, distributed with this code, contains details of the terms -! under which the code may be used. -!----------------------------------------------------------------------------- -! Handles the loading of namelists. -! -module empty_mod - - use constants_mod, only : i_def, l_def, str_def, str_max_filename - use lfric_mpi_mod, only : global_mpi - use log_mod, only : log_scratch_space, log_event, LOG_LEVEL_ERROR - - use namelist_collection_mod, only: namelist_collection_type - use namelist_mod, only: namelist_type - - implicit none - - private - public :: read_configuration, ensure_configuration, final_configuration - -contains - - ! Reads configuration namelists from a file. - ! - ! [in] filename File holding the namelists. - ! - ! TODO: Assumes namelist tags come at the start of lines. - ! TODO: Support "namelist file" namelists which recursively call this - ! procedure to load other namelist files. - ! - subroutine read_configuration( filename, nml_bank ) - - use io_utility_mod, only : open_file, close_file - - implicit none - - character(*), intent(in) :: filename - type(namelist_collection_type), intent(inout) :: nml_bank - - integer(i_def) :: local_rank - - character(str_def), allocatable :: namelists(:) - integer(i_def) :: unit = -1 - - local_rank = global_mpi%get_comm_rank() - - if (local_rank == 0) unit = open_file( filename ) - - call get_namelist_names( unit, local_rank, namelists ) - - call read_configuration_namelists( unit, local_rank, & - namelists, filename, & - nml_bank ) - - if (local_rank == 0) call close_file( unit ) - - end subroutine read_configuration - - ! Finds names of all namelists present in file. - ! - ! [in] unit File holding namelists. - ! [out] names of namelist in file (in order). - ! - subroutine get_namelist_names( unit, local_rank, names ) - - use io_utility_mod, only : read_line - - implicit none - - integer(i_def), intent(in) :: unit - integer(i_def), intent(in) :: local_rank - character(str_def), intent(inout), allocatable :: names(:) - - character(str_def), allocatable :: names_temp(:) - ! TODO: Buffer is large enough for a fair sized string and a filename. - ! Ideally it should be dynamically sized for the length of the - ! incoming data but I'm not sure how best to achieve that at the - ! moment. #1752 - character(str_def + str_max_filename) :: buffer - logical(l_def) :: continue_read - ! Number of names - integer(i_def) :: namecount(1) - - namecount = 0 - if (local_rank == 0) then - text_line_loop: do - - continue_read = read_line( unit, buffer ) - if ( .not. continue_read ) exit text_line_loop - - ! TODO: Assumes namelist tags are at the start of lines. #1753 - ! - if (buffer(1:1) == '&') then - namecount = namecount + 1 - allocate(names_temp(namecount)) - if (namecount > 1) then - names_temp(1:namecount-1) = names - end if - names_temp(namecount) = trim(buffer(2:)) - call move_alloc(names_temp, names) - end if - end do text_line_loop - rewind(unit) - end if - - call global_mpi%broadcast( namecount, 0 ) - - if (local_rank /= 0) then - allocate(names(namecount)) - end if - - call global_mpi%broadcast( names, namecount*str_def, 0 ) - - end subroutine get_namelist_names - - ! Checks that the requested namelists have been loaded. - ! - ! [in] names List of namelists. - ! [out] success_mask Marks corresponding namelists as having failed. - ! - ! [return] Overall success. - ! - function ensure_configuration( names, success_mask ) - - implicit none - - character(*), intent(in) :: names(:) - logical(l_def), optional, intent(out) :: success_mask(:) - logical(l_def) :: ensure_configuration - - integer(i_def) :: i - logical :: configuration_found = .True. - - if (present(success_mask) & - .and. (size(success_mask, 1) /= size(names, 1))) then - call log_event( 'Arguments "names" and "success_mask" to function' & - // '"ensure_configuration" are different shapes', & - LOG_LEVEL_ERROR ) - end if - - ensure_configuration = .True. - - name_loop: do i = 1, size(names) - select case(trim( names(i) )) - case default - write( log_scratch_space, '(A)' ) & - 'Tried to ensure unrecognised namelist "'// & - trim(names(i))//'" was loaded.' - call log_event( log_scratch_space, LOG_LEVEL_ERROR ) - end select - - ensure_configuration = ensure_configuration .and. configuration_found - - if (present(success_mask)) success_mask(i) = configuration_found - - end do name_loop - - end function ensure_configuration - - subroutine read_configuration_namelists( unit, local_rank, & - namelists, filename, & - nml_bank ) - implicit none - - integer(i_def), intent(in) :: unit - integer(i_def), intent(in) :: local_rank - character(str_def), intent(in) :: namelists(:) - character(*), intent(in) :: filename - - type(namelist_collection_type), intent(inout) :: nml_bank - - type(namelist_type) :: nml_obj - - integer(i_def) :: i, j - - logical :: scan - - ! Read the namelists - do j=1, 2 - - select case(j) - case(1) - scan = .true. - case(2) - scan = .false. - end select - - do i=1, size(namelists) - - select case (trim(namelists(i))) - case default - write( log_scratch_space, '(A)' ) & - 'Unrecognised namelist "'//trim(namelists(i))// & - '" found in file '//trim(filename)//'.' - call log_event( log_scratch_space, LOG_LEVEL_ERROR ) - end select - - end do ! Namelists - - if ( local_rank == 0 ) then - rewind( unit ) - end if - - end do ! Reading passes - - end subroutine read_configuration_namelists - - subroutine final_configuration() - - implicit none - - return - end subroutine final_configuration - -end module empty_mod diff --git a/infrastructure/build/tools/configurator/tests/configuration_loader/test_configuration_loader.py b/infrastructure/build/tools/configurator/tests/configuration_loader/test_configuration_loader.py index 3c51b695b..14b43b40e 100644 --- a/infrastructure/build/tools/configurator/tests/configuration_loader/test_configuration_loader.py +++ b/infrastructure/build/tools/configurator/tests/configuration_loader/test_configuration_loader.py @@ -20,19 +20,6 @@ class TestLoader: Tests generation of configuration loader. """ - def test_empty(self, tmp_path: Path): # pylint: disable=no-self-use - """ - Generating configuration loader for no configuration. - """ - output_file = tmp_path / "empty_mod.f90" - uut = loader.ConfigurationLoader("empty_mod") - uut.write_module(output_file) - - expected_file = HERE / "empty_mod.f90" - assert output_file.read_text( - encoding="ascii" - ) + "\n" == expected_file.read_text(encoding="ascii") - def test_with_content(self, tmp_path: Path): # pylint: disable=no-self-use """ Generating configuration loader. diff --git a/infrastructure/build/tools/configurator/tests/extended_nml/one_each_mod.f90 b/infrastructure/build/tools/configurator/tests/extended_nml/one_each_mod.f90 new file mode 100644 index 000000000..f6c7e5807 --- /dev/null +++ b/infrastructure/build/tools/configurator/tests/extended_nml/one_each_mod.f90 @@ -0,0 +1,219 @@ +!----------------------------------------------------------------------------- +! (C) Crown copyright 2025 Met Office. All rights reserved. +! The file LICENCE, distributed with this code, contains details of the terms +! under which the code may be used. +!----------------------------------------------------------------------------- +!> Manages the one_of_each namelist. +!> +module one_of_each_nml_mod + + use constants_mod, only: i_def, & + i_long, & + i_short, & + l_def, & + r_def, & + r_double, & + r_second, & + r_single, & + str_def, & + str_max_filename + + use namelist_mod, only: namelist_type + + implicit none + + private + public :: one_of_each_nml_type + + type, extends(namelist_type) :: one_of_each_nml_type + private + contains + + procedure :: dint + procedure :: dlog + procedure :: dreal + procedure :: dstr + procedure :: enum + procedure :: fstr + procedure :: lint + procedure :: lreal + procedure :: sint + procedure :: sreal + procedure :: treal + procedure :: vint + procedure :: vreal + procedure :: vstr + + end type one_of_each_nml_type + +contains + + + function dint(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + integer(i_def) :: answer + + call self%get_value('dint', answer) + + end function dint + + + function dlog(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + logical(l_def) :: answer + + call self%get_value('dlog', answer) + + end function dlog + + + function dreal(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + real(r_def) :: answer + + call self%get_value('dreal', answer) + + end function dreal + + + function dstr(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + character(str_def) :: answer + + call self%get_value('dstr', answer) + + end function dstr + + + function enum(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + integer(i_def) :: answer + + call self%get_value('enum', answer) + + end function enum + + + function fstr(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + character(str_max_filename) :: answer + + call self%get_value('fstr', answer) + + end function fstr + + + function lint(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + integer(i_long) :: answer + + call self%get_value('lint', answer) + + end function lint + + + function lreal(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + real(r_double) :: answer + + call self%get_value('lreal', answer) + + end function lreal + + + function sint(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + integer(i_short) :: answer + + call self%get_value('sint', answer) + + end function sint + + + function sreal(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + real(r_single) :: answer + + call self%get_value('sreal', answer) + + end function sreal + + + function treal(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + real(r_second) :: answer + + call self%get_value('treal', answer) + + end function treal + + + function vint(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + integer(i_def) :: answer + + call self%get_value('vint', answer) + + end function vint + + + function vreal(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + real(r_def) :: answer + + call self%get_value('vreal', answer) + + end function vreal + + + function vstr(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + character(str_def) :: answer + + call self%get_value('vstr', answer) + + end function vstr + +end module one_of_each_nml_mod diff --git a/infrastructure/build/tools/configurator/tests/extended_nml/test_extended_nml.py b/infrastructure/build/tools/configurator/tests/extended_nml/test_extended_nml.py new file mode 100644 index 000000000..ae2a26971 --- /dev/null +++ b/infrastructure/build/tools/configurator/tests/extended_nml/test_extended_nml.py @@ -0,0 +1,53 @@ +#!/usr/bin/env python3 +############################################################################## +# (c) Crown copyright 2025 Met Office. All rights reserved. +# The file LICENCE, distributed with this code, contains details of the terms +# under which the code may be used. +############################################################################## +""" +Unit tests for Extended Namelist Specific Object generator. +""" + +from pathlib import Path + +import configurator.extended_namelist_type as ExtendedNml + +HERE = Path(__file__).resolve().parent + + +class TestExtendedNml: + """ + Tests generation of extended namelist specific object. + """ + + def test_write_one_of_each(self, tmp_path: Path): + # pylint: disable=no-self-use + """ + Generating extended namelist object with one of each + component member type. + """ + output_file = tmp_path / "one_of_each_mod.f90" + uut = ExtendedNml.NamelistDescription("one_of_each") + + uut.add_value("vint", "integer") + uut.add_value("dint", "integer", "default") + uut.add_value("sint", "integer", "short") + uut.add_value("lint", "integer", "long") + uut.add_value("dlog", "logical", "default") + uut.add_value("vreal", "real") + uut.add_value("dreal", "real", "default") + uut.add_value("sreal", "real", "single") + uut.add_value("lreal", "real", "double") + uut.add_value("treal", "real", "second") + uut.add_string("vstr") + uut.add_string("dstr", configure_string_length="default") + uut.add_string("fstr", configure_string_length="filename") + uut.add_enumeration("enum", enumerators=["one", "two", "three"]) + + uut.write_module(output_file) + + expected_file = HERE / "one_each_mod.f90" + assert ( + expected_file.read_text(encoding="ascii") + == output_file.read_text(encoding="ascii") + "\n" + ) diff --git a/infrastructure/build/tools/configurator/tests/namelist_description/array_mod.f90 b/infrastructure/build/tools/configurator/tests/namelist_description/array_mod.f90 index 2779e9c7a..ebbbb760b 100644 --- a/infrastructure/build/tools/configurator/tests/namelist_description/array_mod.f90 +++ b/infrastructure/build/tools/configurator/tests/namelist_description/array_mod.f90 @@ -27,7 +27,7 @@ module aerial_config_mod aerial_is_loadable, aerial_is_loaded, & aerial_reset_load_status, & aerial_multiples_allowed, aerial_final, & - get_aerial_nml + get_aerial_nml, get_new_aerial_nml integer(i_def), parameter, public :: max_array_size = 500 @@ -157,20 +157,20 @@ function get_aerial_nml() result(namelist_obj) type(namelist_type) :: namelist_obj type(namelist_item_type) :: members(5) - call members(1)%initialise( & - 'absolute', absolute ) + call members(1)%initialise( & + 'absolute', absolute ) - call members(2)%initialise( & - 'inlist', inlist ) + call members(2)%initialise( & + 'inlist', inlist ) - call members(3)%initialise( & - 'lsize', lsize ) + call members(3)%initialise( & + 'lsize', lsize ) - call members(4)%initialise( & - 'outlist', outlist ) + call members(4)%initialise( & + 'outlist', outlist ) - call members(5)%initialise( & - 'unknown', unknown ) + call members(5)%initialise( & + 'unknown', unknown ) if (trim(profile_name) /= trim(cmdi) ) then call namelist_obj%initialise( trim(listname), & @@ -183,6 +183,44 @@ function get_aerial_nml() result(namelist_obj) end function get_aerial_nml + !> @brief Returns a <> object populated with the + !> current contents of this configuration module. + !> @return namelist_obj <> with current namelist contents. + function get_new_aerial_nml() result(namelist_obj) + + use aerial_nml_mod, only: aerial_nml_type + + implicit none + + type(aerial_nml_type) :: namelist_obj + type(namelist_item_type) :: members(5) + + call members(1)%initialise( & + 'absolute', absolute ) + + call members(2)%initialise( & + 'inlist', inlist ) + + call members(3)%initialise( & + 'lsize', lsize ) + + call members(4)%initialise( & + 'outlist', outlist ) + + call members(5)%initialise( & + 'unknown', unknown ) + + if (trim(profile_name) /= trim(cmdi) ) then + call namelist_obj%initialise( trim(listname), & + members, & + profile_name = profile_name ) + else + call namelist_obj%initialise( trim(listname), & + members ) + end if + + end function get_new_aerial_nml + !> Performs any processing to be done once all namelists are loaded !> diff --git a/infrastructure/build/tools/configurator/tests/namelist_description/computed_mod.f90 b/infrastructure/build/tools/configurator/tests/namelist_description/computed_mod.f90 index 3b28a50a8..26c553d54 100644 --- a/infrastructure/build/tools/configurator/tests/namelist_description/computed_mod.f90 +++ b/infrastructure/build/tools/configurator/tests/namelist_description/computed_mod.f90 @@ -25,7 +25,7 @@ module teapot_config_mod teapot_is_loadable, teapot_is_loaded, & teapot_reset_load_status, & teapot_multiples_allowed, teapot_final, & - get_teapot_nml + get_teapot_nml, get_new_teapot_nml real(r_def), public, protected :: bar = rmdi real(r_def), public, protected :: foo = rmdi @@ -121,14 +121,14 @@ function get_teapot_nml() result(namelist_obj) type(namelist_type) :: namelist_obj type(namelist_item_type) :: members(3) - call members(1)%initialise( & - 'bar', bar ) + call members(1)%initialise( & + 'bar', bar ) - call members(2)%initialise( & - 'foo', foo ) + call members(2)%initialise( & + 'foo', foo ) - call members(3)%initialise( & - 'fum', fum ) + call members(3)%initialise( & + 'fum', fum ) if (trim(profile_name) /= trim(cmdi) ) then call namelist_obj%initialise( trim(listname), & @@ -141,6 +141,38 @@ function get_teapot_nml() result(namelist_obj) end function get_teapot_nml + !> @brief Returns a <> object populated with the + !> current contents of this configuration module. + !> @return namelist_obj <> with current namelist contents. + function get_new_teapot_nml() result(namelist_obj) + + use teapot_nml_mod, only: teapot_nml_type + + implicit none + + type(teapot_nml_type) :: namelist_obj + type(namelist_item_type) :: members(3) + + call members(1)%initialise( & + 'bar', bar ) + + call members(2)%initialise( & + 'foo', foo ) + + call members(3)%initialise( & + 'fum', fum ) + + if (trim(profile_name) /= trim(cmdi) ) then + call namelist_obj%initialise( trim(listname), & + members, & + profile_name = profile_name ) + else + call namelist_obj%initialise( trim(listname), & + members ) + end if + + end function get_new_teapot_nml + !> Performs any processing to be done once all namelists are loaded !> diff --git a/infrastructure/build/tools/configurator/tests/namelist_description/constants_mod.f90 b/infrastructure/build/tools/configurator/tests/namelist_description/constants_mod.f90 index e49f029c3..8bb06cefd 100644 --- a/infrastructure/build/tools/configurator/tests/namelist_description/constants_mod.f90 +++ b/infrastructure/build/tools/configurator/tests/namelist_description/constants_mod.f90 @@ -25,7 +25,7 @@ module cheese_config_mod cheese_is_loadable, cheese_is_loaded, & cheese_reset_load_status, & cheese_multiples_allowed, cheese_final, & - get_cheese_nml + get_cheese_nml, get_new_cheese_nml real(r_def), public, protected :: fred = rmdi real(r_def), public, protected :: wilma = rmdi @@ -116,11 +116,11 @@ function get_cheese_nml() result(namelist_obj) type(namelist_type) :: namelist_obj type(namelist_item_type) :: members(2) - call members(1)%initialise( & - 'fred', fred ) + call members(1)%initialise( & + 'fred', fred ) - call members(2)%initialise( & - 'wilma', wilma ) + call members(2)%initialise( & + 'wilma', wilma ) if (trim(profile_name) /= trim(cmdi) ) then call namelist_obj%initialise( trim(listname), & @@ -133,6 +133,35 @@ function get_cheese_nml() result(namelist_obj) end function get_cheese_nml + !> @brief Returns a <> object populated with the + !> current contents of this configuration module. + !> @return namelist_obj <> with current namelist contents. + function get_new_cheese_nml() result(namelist_obj) + + use cheese_nml_mod, only: cheese_nml_type + + implicit none + + type(cheese_nml_type) :: namelist_obj + type(namelist_item_type) :: members(2) + + call members(1)%initialise( & + 'fred', fred ) + + call members(2)%initialise( & + 'wilma', wilma ) + + if (trim(profile_name) /= trim(cmdi) ) then + call namelist_obj%initialise( trim(listname), & + members, & + profile_name = profile_name ) + else + call namelist_obj%initialise( trim(listname), & + members ) + end if + + end function get_new_cheese_nml + !> Performs any processing to be done once all namelists are loaded !> diff --git a/infrastructure/build/tools/configurator/tests/namelist_description/enum_only_mod.f90 b/infrastructure/build/tools/configurator/tests/namelist_description/enum_only_mod.f90 index 89d60df65..f0e028e71 100644 --- a/infrastructure/build/tools/configurator/tests/namelist_description/enum_only_mod.f90 +++ b/infrastructure/build/tools/configurator/tests/namelist_description/enum_only_mod.f90 @@ -26,7 +26,7 @@ module enum_config_mod enum_is_loadable, enum_is_loaded, & enum_reset_load_status, & enum_multiples_allowed, enum_final, & - get_enum_nml + get_enum_nml, get_new_enum_nml integer(i_def), public, parameter :: value_one = 1695414371 integer(i_def), public, parameter :: value_three = 839906103 @@ -210,8 +210,8 @@ function get_enum_nml() result(namelist_obj) type(namelist_type) :: namelist_obj type(namelist_item_type) :: members(1) - call members(1)%initialise( & - 'value', value ) + call members(1)%initialise( & + 'value', value ) if (trim(profile_name) /= trim(cmdi) ) then call namelist_obj%initialise( trim(listname), & @@ -224,6 +224,32 @@ function get_enum_nml() result(namelist_obj) end function get_enum_nml + !> @brief Returns a <> object populated with the + !> current contents of this configuration module. + !> @return namelist_obj <> with current namelist contents. + function get_new_enum_nml() result(namelist_obj) + + use enum_nml_mod, only: enum_nml_type + + implicit none + + type(enum_nml_type) :: namelist_obj + type(namelist_item_type) :: members(1) + + call members(1)%initialise( & + 'value', value ) + + if (trim(profile_name) /= trim(cmdi) ) then + call namelist_obj%initialise( trim(listname), & + members, & + profile_name = profile_name ) + else + call namelist_obj%initialise( trim(listname), & + members ) + end if + + end function get_new_enum_nml + !> Performs any processing to be done once all namelists are loaded !> diff --git a/infrastructure/build/tools/configurator/tests/namelist_description/first_growing_mod.f90 b/infrastructure/build/tools/configurator/tests/namelist_description/first_growing_mod.f90 index b5cb503bb..ed48b9f62 100644 --- a/infrastructure/build/tools/configurator/tests/namelist_description/first_growing_mod.f90 +++ b/infrastructure/build/tools/configurator/tests/namelist_description/first_growing_mod.f90 @@ -24,7 +24,7 @@ module test_config_mod test_is_loadable, test_is_loaded, & test_reset_load_status, & test_multiples_allowed, test_final, & - get_test_nml + get_test_nml, get_new_test_nml integer(i_def), public, protected :: foo = imdi @@ -113,8 +113,8 @@ function get_test_nml() result(namelist_obj) type(namelist_type) :: namelist_obj type(namelist_item_type) :: members(1) - call members(1)%initialise( & - 'foo', foo ) + call members(1)%initialise( & + 'foo', foo ) if (trim(profile_name) /= trim(cmdi) ) then call namelist_obj%initialise( trim(listname), & @@ -127,6 +127,32 @@ function get_test_nml() result(namelist_obj) end function get_test_nml + !> @brief Returns a <> object populated with the + !> current contents of this configuration module. + !> @return namelist_obj <> with current namelist contents. + function get_new_test_nml() result(namelist_obj) + + use test_nml_mod, only: test_nml_type + + implicit none + + type(test_nml_type) :: namelist_obj + type(namelist_item_type) :: members(1) + + call members(1)%initialise( & + 'foo', foo ) + + if (trim(profile_name) /= trim(cmdi) ) then + call namelist_obj%initialise( trim(listname), & + members, & + profile_name = profile_name ) + else + call namelist_obj%initialise( trim(listname), & + members ) + end if + + end function get_new_test_nml + !> Performs any processing to be done once all namelists are loaded !> diff --git a/infrastructure/build/tools/configurator/tests/namelist_description/one_each_mod.f90 b/infrastructure/build/tools/configurator/tests/namelist_description/one_each_mod.f90 index 41a5ddfae..677a0a38b 100644 --- a/infrastructure/build/tools/configurator/tests/namelist_description/one_each_mod.f90 +++ b/infrastructure/build/tools/configurator/tests/namelist_description/one_each_mod.f90 @@ -34,7 +34,7 @@ module test_config_mod test_is_loadable, test_is_loaded, & test_reset_load_status, & test_multiples_allowed, test_final, & - get_test_nml + get_test_nml, get_new_test_nml integer(i_def), public, parameter :: enum_one = 189779348 integer(i_def), public, parameter :: enum_three = 1061269036 @@ -301,47 +301,47 @@ function get_test_nml() result(namelist_obj) type(namelist_type) :: namelist_obj type(namelist_item_type) :: members(14) - call members(1)%initialise( & - 'dint', dint ) + call members(1)%initialise( & + 'dint', dint ) - call members(2)%initialise( & - 'dlog', dlog ) + call members(2)%initialise( & + 'dlog', dlog ) - call members(3)%initialise( & - 'dreal', dreal ) + call members(3)%initialise( & + 'dreal', dreal ) - call members(4)%initialise( & - 'dstr', dstr ) + call members(4)%initialise( & + 'dstr', dstr ) - call members(5)%initialise( & - 'enum', enum ) + call members(5)%initialise( & + 'enum', enum ) - call members(6)%initialise( & - 'fstr', fstr ) + call members(6)%initialise( & + 'fstr', fstr ) - call members(7)%initialise( & - 'lint', lint ) + call members(7)%initialise( & + 'lint', lint ) - call members(8)%initialise( & - 'lreal', lreal ) + call members(8)%initialise( & + 'lreal', lreal ) - call members(9)%initialise( & - 'sint', sint ) + call members(9)%initialise( & + 'sint', sint ) - call members(10)%initialise( & - 'sreal', sreal ) + call members(10)%initialise( & + 'sreal', sreal ) - call members(11)%initialise( & - 'treal', treal ) + call members(11)%initialise( & + 'treal', treal ) - call members(12)%initialise( & - 'vint', vint ) + call members(12)%initialise( & + 'vint', vint ) - call members(13)%initialise( & - 'vreal', vreal ) + call members(13)%initialise( & + 'vreal', vreal ) - call members(14)%initialise( & - 'vstr', vstr ) + call members(14)%initialise( & + 'vstr', vstr ) if (trim(profile_name) /= trim(cmdi) ) then call namelist_obj%initialise( trim(listname), & @@ -354,6 +354,71 @@ function get_test_nml() result(namelist_obj) end function get_test_nml + !> @brief Returns a <> object populated with the + !> current contents of this configuration module. + !> @return namelist_obj <> with current namelist contents. + function get_new_test_nml() result(namelist_obj) + + use test_nml_mod, only: test_nml_type + + implicit none + + type(test_nml_type) :: namelist_obj + type(namelist_item_type) :: members(14) + + call members(1)%initialise( & + 'dint', dint ) + + call members(2)%initialise( & + 'dlog', dlog ) + + call members(3)%initialise( & + 'dreal', dreal ) + + call members(4)%initialise( & + 'dstr', dstr ) + + call members(5)%initialise( & + 'enum', enum ) + + call members(6)%initialise( & + 'fstr', fstr ) + + call members(7)%initialise( & + 'lint', lint ) + + call members(8)%initialise( & + 'lreal', lreal ) + + call members(9)%initialise( & + 'sint', sint ) + + call members(10)%initialise( & + 'sreal', sreal ) + + call members(11)%initialise( & + 'treal', treal ) + + call members(12)%initialise( & + 'vint', vint ) + + call members(13)%initialise( & + 'vreal', vreal ) + + call members(14)%initialise( & + 'vstr', vstr ) + + if (trim(profile_name) /= trim(cmdi) ) then + call namelist_obj%initialise( trim(listname), & + members, & + profile_name = profile_name ) + else + call namelist_obj%initialise( trim(listname), & + members ) + end if + + end function get_new_test_nml + !> Performs any processing to be done once all namelists are loaded !> diff --git a/infrastructure/build/tools/configurator/tests/namelist_description/second_growing_mod.f90 b/infrastructure/build/tools/configurator/tests/namelist_description/second_growing_mod.f90 index f6a0d110e..970ed713c 100644 --- a/infrastructure/build/tools/configurator/tests/namelist_description/second_growing_mod.f90 +++ b/infrastructure/build/tools/configurator/tests/namelist_description/second_growing_mod.f90 @@ -25,7 +25,7 @@ module test_config_mod test_is_loadable, test_is_loaded, & test_reset_load_status, & test_multiples_allowed, test_final, & - get_test_nml + get_test_nml, get_new_test_nml real(r_def), public, protected :: bar = rmdi integer(i_def), public, protected :: foo = imdi @@ -121,11 +121,11 @@ function get_test_nml() result(namelist_obj) type(namelist_type) :: namelist_obj type(namelist_item_type) :: members(2) - call members(1)%initialise( & - 'bar', bar ) + call members(1)%initialise( & + 'bar', bar ) - call members(2)%initialise( & - 'foo', foo ) + call members(2)%initialise( & + 'foo', foo ) if (trim(profile_name) /= trim(cmdi) ) then call namelist_obj%initialise( trim(listname), & @@ -138,6 +138,35 @@ function get_test_nml() result(namelist_obj) end function get_test_nml + !> @brief Returns a <> object populated with the + !> current contents of this configuration module. + !> @return namelist_obj <> with current namelist contents. + function get_new_test_nml() result(namelist_obj) + + use test_nml_mod, only: test_nml_type + + implicit none + + type(test_nml_type) :: namelist_obj + type(namelist_item_type) :: members(2) + + call members(1)%initialise( & + 'bar', bar ) + + call members(2)%initialise( & + 'foo', foo ) + + if (trim(profile_name) /= trim(cmdi) ) then + call namelist_obj%initialise( trim(listname), & + members, & + profile_name = profile_name ) + else + call namelist_obj%initialise( trim(listname), & + members ) + end if + + end function get_new_test_nml + !> Performs any processing to be done once all namelists are loaded !> diff --git a/infrastructure/build/tools/configurator/tests/namelist_description/string_mod.f90 b/infrastructure/build/tools/configurator/tests/namelist_description/string_mod.f90 index c571d8b59..20b940cb5 100644 --- a/infrastructure/build/tools/configurator/tests/namelist_description/string_mod.f90 +++ b/infrastructure/build/tools/configurator/tests/namelist_description/string_mod.f90 @@ -26,7 +26,7 @@ module mirth_config_mod mirth_is_loadable, mirth_is_loaded, & mirth_reset_load_status, & mirth_multiples_allowed, mirth_final, & - get_mirth_nml + get_mirth_nml, get_new_mirth_nml integer(i_def), parameter, public :: max_array_size = 500 @@ -145,17 +145,17 @@ function get_mirth_nml() result(namelist_obj) type(namelist_type) :: namelist_obj type(namelist_item_type) :: members(4) - call members(1)%initialise( & - 'chortle', chortle ) + call members(1)%initialise( & + 'chortle', chortle ) - call members(2)%initialise( & - 'chuckle', chuckle ) + call members(2)%initialise( & + 'chuckle', chuckle ) - call members(3)%initialise( & - 'guffaw', guffaw ) + call members(3)%initialise( & + 'guffaw', guffaw ) - call members(4)%initialise( & - 'hysterics', hysterics ) + call members(4)%initialise( & + 'hysterics', hysterics ) if (trim(profile_name) /= trim(cmdi) ) then call namelist_obj%initialise( trim(listname), & @@ -168,6 +168,41 @@ function get_mirth_nml() result(namelist_obj) end function get_mirth_nml + !> @brief Returns a <> object populated with the + !> current contents of this configuration module. + !> @return namelist_obj <> with current namelist contents. + function get_new_mirth_nml() result(namelist_obj) + + use mirth_nml_mod, only: mirth_nml_type + + implicit none + + type(mirth_nml_type) :: namelist_obj + type(namelist_item_type) :: members(4) + + call members(1)%initialise( & + 'chortle', chortle ) + + call members(2)%initialise( & + 'chuckle', chuckle ) + + call members(3)%initialise( & + 'guffaw', guffaw ) + + call members(4)%initialise( & + 'hysterics', hysterics ) + + if (trim(profile_name) /= trim(cmdi) ) then + call namelist_obj%initialise( trim(listname), & + members, & + profile_name = profile_name ) + else + call namelist_obj%initialise( trim(listname), & + members ) + end if + + end function get_new_mirth_nml + !> Performs any processing to be done once all namelists are loaded !> diff --git a/infrastructure/build/tools/configurator/tests/namelist_description/two_enum_mod.f90 b/infrastructure/build/tools/configurator/tests/namelist_description/two_enum_mod.f90 index f1f8fbb2e..95e56b40a 100644 --- a/infrastructure/build/tools/configurator/tests/namelist_description/two_enum_mod.f90 +++ b/infrastructure/build/tools/configurator/tests/namelist_description/two_enum_mod.f90 @@ -27,7 +27,7 @@ module twoenum_config_mod twoenum_is_loadable, twoenum_is_loaded, & twoenum_reset_load_status, & twoenum_multiples_allowed, twoenum_final, & - get_twoenum_nml + get_twoenum_nml, get_new_twoenum_nml integer(i_def), public, parameter :: first_one = 1952457118 integer(i_def), public, parameter :: first_three = 1813125082 @@ -306,11 +306,11 @@ function get_twoenum_nml() result(namelist_obj) type(namelist_type) :: namelist_obj type(namelist_item_type) :: members(2) - call members(1)%initialise( & - 'first', first ) + call members(1)%initialise( & + 'first', first ) - call members(2)%initialise( & - 'second', second ) + call members(2)%initialise( & + 'second', second ) if (trim(profile_name) /= trim(cmdi) ) then call namelist_obj%initialise( trim(listname), & @@ -323,6 +323,35 @@ function get_twoenum_nml() result(namelist_obj) end function get_twoenum_nml + !> @brief Returns a <> object populated with the + !> current contents of this configuration module. + !> @return namelist_obj <> with current namelist contents. + function get_new_twoenum_nml() result(namelist_obj) + + use twoenum_nml_mod, only: twoenum_nml_type + + implicit none + + type(twoenum_nml_type) :: namelist_obj + type(namelist_item_type) :: members(2) + + call members(1)%initialise( & + 'first', first ) + + call members(2)%initialise( & + 'second', second ) + + if (trim(profile_name) /= trim(cmdi) ) then + call namelist_obj%initialise( trim(listname), & + members, & + profile_name = profile_name ) + else + call namelist_obj%initialise( trim(listname), & + members ) + end if + + end function get_new_twoenum_nml + !> Performs any processing to be done once all namelists are loaded !> diff --git a/infrastructure/build/tools/dependerator/analyser.py b/infrastructure/build/tools/dependerator/analyser.py index 60e4906d1..73a0ead17 100755 --- a/infrastructure/build/tools/dependerator/analyser.py +++ b/infrastructure/build/tools/dependerator/analyser.py @@ -464,6 +464,7 @@ def lines_of_code( for module_name in module_names: if module_name is not None: logger.info(" Depends on external " + module_name) + assert isinstance(program_unit, str) add_dependency(program_unit, module_name) continue diff --git a/infrastructure/integration-test/cli_mod_test.f90 b/infrastructure/integration-test/cli_test/cli_mod_test.f90 similarity index 85% rename from infrastructure/integration-test/cli_mod_test.f90 rename to infrastructure/integration-test/cli_test/cli_mod_test.f90 index 874e25b7e..4152e00cc 100644 --- a/infrastructure/integration-test/cli_mod_test.f90 +++ b/infrastructure/integration-test/cli_test/cli_mod_test.f90 @@ -7,13 +7,13 @@ program cli_mod_test use, intrinsic :: iso_fortran_env, only : output_unit - use cli_mod, only : get_initial_filename + use cli_mod, only : parse_command_line implicit none character(:), allocatable :: filename - call get_initial_filename( filename ) + call parse_command_line( filename ) write( output_unit, '(A)' ) filename end program cli_mod_test diff --git a/infrastructure/integration-test/cli_mod_test.py b/infrastructure/integration-test/cli_test/cli_mod_test.py similarity index 82% rename from infrastructure/integration-test/cli_mod_test.py rename to infrastructure/integration-test/cli_test/cli_mod_test.py index 4d3759ee8..915df2bd1 100755 --- a/infrastructure/integration-test/cli_mod_test.py +++ b/infrastructure/integration-test/cli_test/cli_mod_test.py @@ -24,7 +24,7 @@ class cli_mod_normal_test(Test): """ def __init__(self): - self._INJECT = "onwards/waffles.nml" + self._INJECT = "resources/cli_test.nml" super().__init__([sys.argv[1], self._INJECT]) def test(self, returncode, out, err): @@ -42,7 +42,29 @@ def test(self, returncode, out, err): ) ) - return "Filename extracted from command line" + return "Valid filename extracted from command line" + + +############################################################################## +class cli_mod_missing_file_test(Test): + """ + Tests the case where everything is normal and a filename is passed on the + command line, but that file doesn't exist. + """ + + def __init__(self): + self._INJECT = "onwards/waffles.nml" + super().__init__([sys.argv[1], self._INJECT]) + + def test(self, returncode, out, err): + if returncode == 0: + raise TestFailed( + "Unexpected success of test executable: {code}".format( + code=returncode + ) + ) + + return "Command line that refers to a missing file returned with error" ############################################################################## @@ -68,7 +90,7 @@ class cli_mod_too_many_test(Test): def __init__(self): super().__init__( - [sys.argv[1], "onwards/waffles.nml", "2"] + [sys.argv[1], "resources/cli_test.nml", "2"] ) def test(self, returncode, out, err): @@ -129,6 +151,7 @@ def test(self, returncode, out, err): ############################################################################## if __name__ == "__main__": TestEngine.run(cli_mod_normal_test()) + TestEngine.run(cli_mod_missing_file_test()) TestEngine.run(cli_mod_too_few_test()) TestEngine.run(cli_mod_too_many_test()) TestEngine.run(cli_mod_help_test()) diff --git a/infrastructure/integration-test/cli_test/resources/cli_test.nml b/infrastructure/integration-test/cli_test/resources/cli_test.nml new file mode 100644 index 000000000..e69de29bb diff --git a/infrastructure/source/configuration/configuration_mod.f90 b/infrastructure/source/configuration/configuration_mod.f90 new file mode 100644 index 000000000..c59109995 --- /dev/null +++ b/infrastructure/source/configuration/configuration_mod.f90 @@ -0,0 +1,24 @@ +!----------------------------------------------------------------------------- +! (C) Crown copyright 2025 Met Office. All rights reserved. +! The file LICENCE, distributed with this code, contains details of the terms +! under which the code may be used. +!----------------------------------------------------------------------------- +! +!> @brief Temporary module to redirect code that calls generated configuration +!> module. +!> @details This isolates the change to new namelist access pattern to core repository. +!> It allows inplementation in lfric apps repo to be done piecemeal +!> +!---------------------------------------------------------------------------- +module configuration_mod + + use config_loader_mod, only: read_configuration, & + ensure_configuration, & + final_configuration + + implicit none + + private + public :: read_configuration, ensure_configuration, final_configuration + +end module configuration_mod diff --git a/infrastructure/source/configuration/namelist_item_mod.f90 b/infrastructure/source/configuration/namelist_item_mod.f90 index f1c607e98..dad1610f7 100644 --- a/infrastructure/source/configuration/namelist_item_mod.f90 +++ b/infrastructure/source/configuration/namelist_item_mod.f90 @@ -723,16 +723,7 @@ subroutine value_str_arr( self, value ) class(namelist_item_type), intent(in) :: self - !> @todo This was applied with #3547. This would have been - !> similar to the scalar string: i.e. - !> - !> character(*), allocatable, intent(out) :: value(:) - !> - !> However, the revision of the Intel compiler on the XC40 - !> produced unexpected behaviour so the length has been - !> limited to str_def. This should be revisited when the - !> XC40 compilers are later than 17.0.0.098/5. - character(str_def), allocatable, intent(out) :: value(:) + character(*), allocatable, intent(out) :: value(:) integer :: arr_len integer :: i diff --git a/infrastructure/source/configuration/namelist_mod.F90 b/infrastructure/source/configuration/namelist_mod.F90 index f84ee19f4..81bc13e05 100644 --- a/infrastructure/source/configuration/namelist_mod.F90 +++ b/infrastructure/source/configuration/namelist_mod.F90 @@ -436,17 +436,7 @@ subroutine get_str_arr_value( self, name, value ) class(namelist_type), intent(in) :: self character(*), intent(in) :: name - !> @todo This was applied with #3547. This would have been - !> similar to the scalar string: i.e. - !> - !> character(*), allocatable, intent(out) :: value(:) - !> - !> However, the revision of the Intel compiler on the XC40 - !> produced unexpected behaviour so the length has been - !> limited to str_def. This should be revisited when the - !> XC40 compilers are later than 17.0.0.098/5. - character(str_def), intent(out), & - allocatable :: value(:) + character(*), intent(out), allocatable :: value(:) integer(i_def) :: i diff --git a/infrastructure/source/field/exchange_map_collection_mod.F90 b/infrastructure/source/field/exchange_map_collection_mod.F90 new file mode 100644 index 000000000..0b82c9602 --- /dev/null +++ b/infrastructure/source/field/exchange_map_collection_mod.F90 @@ -0,0 +1,246 @@ +!----------------------------------------------------------------------------- +! (C) Crown copyright Met Office. All rights reserved. +! The file LICENCE, distributed with this code, contains details of the terms +! under which the code may be used. +!----------------------------------------------------------------------------- +! +!> @brief Holds and manages a collection of exchange maps +! +module exchange_map_collection_mod + + use constants_mod, only: i_def, i_halo_index, l_def + use function_space_mod, only: function_space_type + use function_space_collection_mod, & + only: function_space_collection_type, & + function_space_collection + use halo_comms_mod, only: exchange_map_type + use mesh_mod, only: mesh_type + use log_mod, only: log_event, LOG_LEVEL_ERROR + use lfric_mpi_mod, only: global_mpi, get_lfric_datatype + use linked_list_mod, only: linked_list_type, & + linked_list_item_type + use linked_list_data_mod, only: linked_list_data_type + + implicit none + + private + + !collection type + type, public :: exchange_map_collection_type + private + type(linked_list_type) :: exchange_map_list + contains + procedure, public :: get_exchange_map + end type exchange_map_collection_type + interface exchange_map_collection_type + module procedure exchange_map_collection_constructor + end interface +contains + +!> \brief Constructor for an exchange_map_collection object. +!> +!> Initializes a new exchange_map_collection_type instance and +!> allocates an empty linked list inside the object. +!> +!> \return A fully initialised exchange_map_collection_type object. +function exchange_map_collection_constructor() result(self) + + implicit none + !> Constructed exchange_map_collection instance. + type(exchange_map_collection_type) :: self + + self%exchange_map_list = linked_list_type() + +end function exchange_map_collection_constructor + +!> \brief Retrieve or construct an exchange map for the given mesh +!! and finite-element parameters. +!> +!! This routine searches the collection for an existing +!! exchange_map_type object that matches the supplied parameters. +!! If no matching exchange map is found, a new one is constructed, +!! initialised, inserted into the collection, and then returned. +!> +!> \param[in] mesh The mesh object associated with the exchange map. +!> \param[in] element_order_h Horizontal element order. +!> \param[in] element_order_v Vertical element order. +!> \param[in] lfric_fs Identifier for the LFRic function space. +!> \param[in] ndata Number of data items per degree of freedom. +!> \param[in] halo_depth Number of halo layers to include. +!> +!> \return A pointer to the corresponding exchange_map_type object. +function get_exchange_map( self, & + mesh, & + element_order_h, & + element_order_v, & + lfric_fs, & + ndata, & + halo_depth ) result(exchange_maps) + implicit none + + class(exchange_map_collection_type), intent(inout) :: self + + type(exchange_map_type), pointer :: exchange_maps + + type(mesh_type), intent(in), pointer :: mesh + + integer(i_def), intent(in) :: ndata + integer(i_def), intent(in) :: halo_depth + integer(i_def), intent(in) :: element_order_v, element_order_h + integer(i_def), intent(in) :: lfric_fs + + type(function_space_type), pointer :: function_space + integer(i_halo_index), allocatable :: global_dof_id(:) + integer(i_def), allocatable :: halo_start(:) + integer(i_def), allocatable :: halo_finish(:) + integer(i_def) :: idepth + integer(i_def) :: last_owned_dof + integer(i_def) :: mesh_id + + nullify( function_space ) + + exchange_maps => get_exchange_maps_from_list( self, & + mesh, & + element_order_h, & + element_order_v, & + lfric_fs, & + ndata, & + halo_depth ) + + if (.not. associated(exchange_maps)) then + + !Get indices of owned and halo cells + function_space => function_space_collection%get_fs( mesh, element_order_h, & + element_order_v, & + lfric_fs, & + ndata) + + last_owned_dof = function_space%get_last_dof_owned() + + ! Set up the global dof index array + call function_space%get_global_dof_id(global_dof_id) + + ! Set up the boundaries of the different depths of halo + allocate( halo_start(halo_depth) ) + allocate( halo_finish(halo_depth) ) + + do idepth = 1, halo_depth + + halo_start(idepth) = function_space%get_last_dof_owned()+1 + halo_finish(idepth) = function_space%get_last_dof_halo(idepth) + ! The above assumes there is a halo cell following the last owned cell. + ! This might not be true (e.g. in a serial run), so fix the start/finish + ! points when that happens + if ( halo_start(idepth) > function_space%get_last_dof_halo(idepth) ) then + halo_start(idepth) = function_space%get_last_dof_halo(idepth) + halo_finish(idepth) = halo_start(idepth) - 1 + end if + + end do + + mesh_id = mesh%get_id() + call self%exchange_map_list%insert_item( exchange_map_type( global_dof_id,& + last_owned_dof,& + halo_start, & + halo_finish, & + mesh_id, & + element_order_h, & + element_order_v, & + lfric_fs, & + ndata, & + halo_depth )) + deallocate( halo_start, halo_finish, global_dof_id ) + + exchange_maps => get_exchange_maps_from_list( self, & + mesh, & + element_order_h, & + element_order_v, & + lfric_fs, & + ndata, & + halo_depth ) + + end if + + return +end function get_exchange_map + +!> \brief Search the exchange-map collection for a matching entry. +!! +!! This routine walks through the linked list stored inside the +!! exchange-map collection and checks whether an existing +!! exchange map matches the supplied data. +!! If a matching map is found, a pointer to it is returned. +!! If no match is found, the function returns a null pointer. +!> +!> \param[in,out] self The exchange-map collection to search. +!> \param[in] mesh The mesh used to identify the map. +!> \param[in] element_order_h Horizontal element order. +!> \param[in] element_order_v Vertical element order. +!> \param[in] lfric_fs Identifier for the LFRic function space. +!> \param[in] ndata Number of data items per degree of freedom. +!> \param[in] halo_depth Depth of the halo region. +!> +!> \return Pointer to an existing exchange map, or a null pointer if none match. +function get_exchange_maps_from_list(self, & + mesh, & + element_order_h, & + element_order_v, & + lfric_fs, & + ndata, & + halo_depth) & + result(instance) + + implicit none + + class(exchange_map_collection_type), intent(inout) :: self + + type(mesh_type), intent(in), pointer :: mesh + + integer(i_def), intent(in) :: ndata + integer(i_def), intent(in) :: halo_depth + integer(i_def), intent(in) :: element_order_h, element_order_v + integer(i_def), intent(in) :: lfric_fs + + type(exchange_map_type), pointer :: instance + + type(linked_list_item_type), pointer :: loop + + integer(i_def) :: mesh_id + + mesh_id = mesh%get_id() + ! Point to head of the exchange map linked list + loop => self%exchange_map_list%get_head() + + ! Loop through the linked list + do + if ( .not. associated(loop) ) then + ! Have reached the end of the list so either + ! the list is empty or at the end of list. + instance => null() + + loop => self%exchange_map_list%get_tail() + exit + end if + + ! 'cast' to the halo_routing_type + select type(listhalo_routing => loop%payload) + type is (exchange_map_type) + if ( mesh_id == listhalo_routing%get_exchange_map_mesh_id() .and. & + element_order_h == listhalo_routing%get_exchange_map_element_order_h() .and. & + element_order_v == listhalo_routing%get_exchange_map_element_order_v() .and. & + lfric_fs == listhalo_routing%get_exchange_map_lfric_fs() .and. & + ndata == listhalo_routing%get_exchange_map_ndata() .and. & + halo_depth == listhalo_routing%get_exchange_map_halo_depth() ) then + instance => listhalo_routing + exit + end if + end select + + loop => loop%next + end do + + nullify(loop) + return +end function get_exchange_maps_from_list + +end module exchange_map_collection_mod diff --git a/infrastructure/source/field/field_mod.t90 b/infrastructure/source/field/field_mod.t90 index 50eed4d7a..d7fdacc4c 100644 --- a/infrastructure/source/field/field_mod.t90 +++ b/infrastructure/source/field/field_mod.t90 @@ -42,6 +42,8 @@ module field_{{kind}}_mod use pure_abstract_field_mod, & only: pure_abstract_field_type + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF implicit none @@ -274,6 +276,9 @@ contains {{type}}({{kind}}) :: signalling_value ! Depth of halo to allocate data array integer(i_def) :: field_halo_depth + integer(tik) :: id + + if ( LPROF ) call start_timing(id, 'field.initialise') mesh => null() @@ -334,6 +339,8 @@ contains end if + if ( LPROF ) call stop_timing(id, 'field.initialise') + end subroutine field_initialiser !> Initialise a {{kind}} field pointer @@ -601,6 +608,9 @@ contains character(len=*), optional, intent(in) :: field_name character(str_def) :: name_used + integer(tik) :: id + + if ( LPROF ) call start_timing(id, 'field.write') if (present(field_name)) then @@ -624,6 +634,8 @@ contains ', write_method not set up', LOG_LEVEL_ERROR ) end if + if ( LPROF ) call stop_timing(id, 'field.write') + end subroutine write_field !> Calls the underlying IO implementation for reading into the field @@ -637,6 +649,9 @@ contains character(len=*), intent(in) :: field_name type( field_{{kind}}_proxy_type ) :: tmp_proxy + integer(tik) :: id + + if ( LPROF ) call start_timing(id, 'field.read') if (associated(self%read_method)) then @@ -655,6 +670,8 @@ contains ', read_method not set up', LOG_LEVEL_ERROR ) end if + if ( LPROF ) call stop_timing(id, 'field.read') + end subroutine read_field !> Reads a checkpoint file into the field @@ -669,7 +686,9 @@ contains character(len=*), intent(in) :: file_name type( field_{{kind}}_proxy_type ) :: tmp_proxy + integer(tik) :: id + if ( LPROF ) call start_timing(id, 'field.read_chkpt') if (associated(self%checkpoint_read_method)) then @@ -688,6 +707,8 @@ contains ', checkpoint_read_method not set up', LOG_LEVEL_ERROR ) end if + if ( LPROF ) call stop_timing(id, 'field.read_chkpt') + end subroutine read_checkpoint !> Writes a checkpoint file @@ -724,12 +745,18 @@ contains class( field_{{kind}}_proxy_type ), target, intent(inout) :: self integer(i_def), intent(in) :: depth type(halo_routing_type), pointer :: halo_routing => null() + character(len=str_def) :: timer_name + integer(tik) :: id if ( self%vspace%is_writable() ) then if ( depth > self%get_field_proxy_halo_depth() ) & call log_event( 'Error in field: '// & 'attempt to exchange halos with depth out of range.', & LOG_LEVEL_ERROR ) + write(timer_name, '(I4)') depth + timer_name = 'field.halo_ex_' // adjustl(trim(timer_name)) + if ( LPROF ) call start_timing(id, trim(adjustl(timer_name))) + ! Start a blocking (synchronous) halo exchange halo_routing => self%get_halo_routing() @@ -740,6 +767,9 @@ contains self%halo_dirty(1:depth) = 0 ! If a halo counter has been set up, increment it if (allocated(halo_calls)) call halo_calls%counter_inc() + + if ( LPROF ) call stop_timing(id, trim(adjustl(timer_name))) + else call log_event( 'Error in field: '// & 'attempt to exchange halos (a write operation) on a read-only field.', & diff --git a/infrastructure/source/field/halo_routing_collection_mod.f90 b/infrastructure/source/field/halo_routing_collection_mod.f90 index a9dd80612..1759bec76 100644 --- a/infrastructure/source/field/halo_routing_collection_mod.f90 +++ b/infrastructure/source/field/halo_routing_collection_mod.f90 @@ -19,10 +19,13 @@ module halo_routing_collection_mod use function_space_collection_mod, & only: function_space_collection_type, & function_space_collection - use halo_comms_mod, only: halo_routing_type + use halo_comms_mod, only: halo_routing_type, exchange_map_type use linked_list_mod, only: linked_list_type, & linked_list_item_type use mesh_mod, only: mesh_type + use exchange_map_collection_mod, only: exchange_map_collection_type + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF implicit none @@ -35,6 +38,8 @@ module halo_routing_collection_mod private !> Linked list which will hold the halo_routing objects type(linked_list_type) :: halo_routing_list + ! Cache of exchange maps + type(exchange_map_collection_type) :: exchange_map_collection contains !> Extracts a specific halo_routing object from the list procedure, public :: get_halo_routing @@ -66,6 +71,8 @@ function halo_routing_collection_constructor() result(self) self%halo_routing_list = linked_list_type() + self%exchange_map_collection = exchange_map_collection_type() + end function halo_routing_collection_constructor !> Function to get an instance of a halo_routing object from the linked list @@ -114,9 +121,13 @@ function get_halo_routing( self, & integer(i_halo_index), allocatable :: global_dof_id(:) integer(i_def), allocatable :: halo_start(:) integer(i_def), allocatable :: halo_finish(:) + type(exchange_map_type), pointer :: exchange_maps integer(i_def) :: idepth integer(i_def) :: last_owned_dof integer(i_def) :: mesh_id + integer(tik) :: id + + if ( LPROF ) call start_timing(id, 'halo_routing_creation') nullify( function_space ) @@ -164,18 +175,29 @@ function get_halo_routing( self, & mesh_id = mesh%get_id() - call self%halo_routing_list%insert_item( halo_routing_type( global_dof_id, & - last_owned_dof, & - halo_start, & - halo_finish, & - mesh_id, & - element_order_h, & - element_order_v, & - lfric_fs, & - ndata, & - fortran_type, & - fortran_kind, & - halo_depth ) ) + exchange_maps => self%exchange_map_collection%get_exchange_map( & + mesh, & + element_order_h, & + element_order_v, & + lfric_fs, & + ndata, & + halo_depth ) + + call self%halo_routing_list%insert_item( & + halo_routing_type( global_dof_id, & + last_owned_dof, & + halo_start, & + halo_finish, & + mesh_id, & + element_order_h, & + element_order_v, & + lfric_fs, & + ndata, & + fortran_type, & + fortran_kind, & + halo_depth, & + exchange_maps) & + ) deallocate( halo_start, halo_finish, global_dof_id ) halo_routing => get_halo_routing_from_list( self, & @@ -190,6 +212,8 @@ function get_halo_routing( self, & end if + if ( LPROF ) call stop_timing(id, 'halo_routing_creation') + return end function get_halo_routing diff --git a/infrastructure/source/function_space/function_space_mod.F90 b/infrastructure/source/function_space/function_space_mod.F90 index 4fa65796e..03e74bdaf 100644 --- a/infrastructure/source/function_space/function_space_mod.F90 +++ b/infrastructure/source/function_space/function_space_mod.F90 @@ -35,6 +35,8 @@ module function_space_mod use linked_list_data_mod, only : linked_list_data_type use linked_list_mod, only : linked_list_type, linked_list_item_type use mesh_collection_mod, only : mesh_collection + use timing_mod, only : start_timing, stop_timing, & + tik, LPROF implicit none @@ -443,6 +445,9 @@ function fs_constructor( mesh_id, & type(function_space_type) :: instance integer(i_def) :: id + integer(tik) :: t_id + + if ( LPROF ) call start_timing(t_id, 'fs.constructor') if ( present(ndata_first) ) then instance%ndata_first = ndata_first @@ -474,6 +479,8 @@ function fs_constructor( mesh_id, & end if call init_function_space(instance) + if ( LPROF ) call stop_timing(t_id, 'fs.constructor') + end function fs_constructor diff --git a/infrastructure/source/io/ncdf_quad_mod.F90 b/infrastructure/source/io/ncdf_quad_mod.F90 index c83aec22b..b887bcd7e 100644 --- a/infrastructure/source/io/ncdf_quad_mod.F90 +++ b/infrastructure/source/io/ncdf_quad_mod.F90 @@ -2873,9 +2873,9 @@ subroutine write_mesh( self, & node_coordinates_ncdf(:,:) = real( node_coordinates(:,:), kind=r_ncdf ) face_coordinates_ncdf(:,:) = real( face_coordinates(:,:), kind=r_ncdf ) - self%geometry = geometry - self%topology = topology - self%coord_sys = coord_sys + self%geometry = trim(geometry) + self%topology = trim(topology) + self%coord_sys = trim(coord_sys) self%npanels = npanels ! Determine if the contents of object is a global/regional model. @@ -2899,7 +2899,7 @@ subroutine write_mesh( self, & self%mesh_extents = GLOBAL_MESH_FLAG end if - self%mesh_name = mesh_name + self%mesh_name = trim(mesh_name) self%north_pole(:) = north_pole(:) self%null_island(:) = null_island(:) self%equatorial_latitude = equatorial_latitude diff --git a/infrastructure/source/kernel_metadata/argument_mod.F90 b/infrastructure/source/kernel_metadata/argument_mod.F90 index 1d58541b0..6a8e585bf 100644 --- a/infrastructure/source/kernel_metadata/argument_mod.F90 +++ b/infrastructure/source/kernel_metadata/argument_mod.F90 @@ -46,6 +46,7 @@ module argument_mod !> @defgroup argument_type Enumeration of argument type property descriptors. !> @{ integer, public, parameter :: GH_SCALAR = 397 + integer, public, parameter :: GH_SCALAR_ARRAY = 973 integer, public, parameter :: GH_FIELD = 507 integer, public, parameter :: GH_OPERATOR = 735 integer, public, parameter :: GH_COLUMNWISE_OPERATOR = 841 diff --git a/infrastructure/source/mesh/global_mesh_mod.F90 b/infrastructure/source/mesh/global_mesh_mod.F90 index 178f6d818..1dbcb74f0 100644 --- a/infrastructure/source/mesh/global_mesh_mod.F90 +++ b/infrastructure/source/mesh/global_mesh_mod.F90 @@ -1019,16 +1019,19 @@ end function get_equatorial_latitude !> !> @note For a cubed -sphere mesh, this will only return correct cell IDs if !> the offset cell remains on same the cubed-sphere "face" as the - !> start cell. + !> start cell unless check_orientation is specified. !> !> @param[in] cell_number ID of the anchor element. !> @param[in] x_cells Offset in the E/W direction. !> @param[in] y_cells Offset in the N/S direction. + !> @param[in] check_orientation Switch to check for orientation changes + !! such as when crossing panel boundaries !> !> @return cell_id ID of the cell at the given offset to the start cell. !> function get_cell_id( self, cell_number, & - x_cells, y_cells ) result ( cell_id ) + x_cells, y_cells, & + check_orientation ) result ( cell_id ) use reference_element_mod, only : W, S, E, N @@ -1036,62 +1039,84 @@ function get_cell_id( self, cell_number, & class(global_mesh_type), intent(in) :: self - integer(i_def), intent(in) :: cell_number - integer(i_def), intent(in) :: x_cells, y_cells + integer(i_def), intent(in) :: cell_number + integer(i_def), intent(in) :: x_cells, y_cells + logical(l_def), optional, intent(in) :: check_orientation - integer(i_def) :: cell_id + integer(i_def) :: cell_id, old_cell_id - integer(i_def) :: index_x, dist_x - integer(i_def) :: index_y, dist_y - integer(i_def) :: i + integer(i_def) :: x_index, y_index, x_dist, y_dist, i, j + integer(i_def) :: opposite(4), rotate(4) - cell_id = cell_number + logical(l_def) :: check - ! Determine march along local x-axis - if (x_cells > 0) then - index_x = E - dist_x = x_cells - else if (x_cells < 0) then - index_x = W - dist_x = abs(x_cells) + opposite = (/ E, N, W, S /) + rotate = (/ S, E, N, W /) + if ( present( check_orientation ) ) then + check = check_orientation else - index_x = W - dist_x = 0 + check = .false. end if - ! Determine march along local y-axis - if (y_cells > 0) then - index_y = N - dist_y = y_cells - else if (y_cells < 0) then - index_y = S - dist_y = abs(y_cells) + cell_id=cell_number + + if (x_cells >= 0 )then + x_index = E + x_dist = x_cells + else + x_index = W + x_dist = abs(x_cells) + end if + if (y_cells >= 0 )then + y_index = N + y_dist = y_cells else - index_y = S - dist_y = 0 + y_index = S + y_dist = abs(y_cells) end if - !======================================== - ! March from anchor along local x/y axes. - !======================================== - do i=1, dist_x + ! x_dist cells in the x-direction + do i = 1, x_dist + old_cell_id = cell_id + cell_id = self%cell_next_2d(x_index,cell_id) if (cell_id == self%void_cell) then ! The current cell is not on the domain write(log_scratch_space,'(A)') & 'No adjacent cell, the current cell is not on mesh domain' call log_event(log_scratch_space, LOG_LEVEL_ERROR) end if - cell_id = self%cell_next_2d(index_x, cell_id) + ! Check if we've changed direction + if ( check .and. self%cell_next_2d(opposite(x_index),cell_id) /= old_cell_id ) then + ! We have changed direction so we need to find the correct + ! index and reset + do j = 1,4 + if ( self%cell_next_2d(opposite(j),cell_id) == old_cell_id ) x_index = j + end do + end if end do - - do i=1, dist_y + ! y_dist cells in the y-direction + ! Since the direction may have changed we need to recompute + y_index = rotate(x_index) + if ( y_cells < 0 ) y_index = opposite(y_index) + + ! y_index and y_dist + do i = 1,y_dist + old_cell_id = cell_id + cell_id = self%cell_next_2d(y_index,cell_id) if (cell_id == self%void_cell) then ! The current cell is not on the domain write(log_scratch_space,'(A)') & 'No adjacent cell, the current cell is not on mesh domain' call log_event(log_scratch_space, LOG_LEVEL_ERROR) end if - cell_id = self%cell_next_2d(index_y, cell_id) + ! Check if we've changed direction + if ( check .and. self%cell_next_2d(opposite(y_index),cell_id) /= old_cell_id ) then + ! We have changed direction so we need to find the correct + ! index and reset + do j = 1,4 + if ( self%cell_next_2d(opposite(j),cell_id) == old_cell_id ) y_index = j + end do + end if end do end function get_cell_id diff --git a/infrastructure/source/mesh/panel_decomposition_mod.f90 b/infrastructure/source/mesh/panel_decomposition_mod.f90 index 95ca50107..0c0545722 100644 --- a/infrastructure/source/mesh/panel_decomposition_mod.f90 +++ b/infrastructure/source/mesh/panel_decomposition_mod.f90 @@ -20,6 +20,7 @@ module panel_decomposition_mod type, public, abstract :: panel_decomposition_type contains procedure(get_partition_interface), deferred :: get_partition + procedure(get_nprocs_interface), deferred :: get_nprocs end type panel_decomposition_type !> @brief Decomposition that accepts user specified number of xprocs and yprocs @@ -27,6 +28,7 @@ module panel_decomposition_mod integer(i_def) :: num_xprocs, num_yprocs contains procedure, public :: get_partition => get_custom_partition + procedure, public :: get_nprocs => get_custom_nprocs end type custom_decomposition_type ! Constructor interface custom_decomposition_type @@ -37,24 +39,28 @@ module panel_decomposition_mod type, extends(panel_decomposition_type), public :: auto_decomposition_type contains procedure, public :: get_partition => get_auto_partition + procedure, public :: get_nprocs => get_auto_nprocs end type auto_decomposition_type !> @brief Decomposition only in x direction type, extends(panel_decomposition_type), public :: row_decomposition_type contains procedure, public :: get_partition => get_row_partition + procedure, public :: get_nprocs => get_row_nprocs end type row_decomposition_type !> @brief Decomposition only in y direction type, extends(panel_decomposition_type), public :: column_decomposition_type contains procedure, public :: get_partition => get_column_partition + procedure, public :: get_nprocs => get_column_nprocs end type column_decomposition_type !> @brief Decomposition that automatically generates a nonuniform decomposition type, extends(panel_decomposition_type), public :: auto_nonuniform_decomposition_type contains procedure, public :: get_partition => get_auto_nonuniform_partition + procedure, public :: get_nprocs => get_auto_nonuniform_nprocs end type auto_nonuniform_decomposition_type ! @brief Decomposition that accepts user specified number of xprocs to @@ -63,6 +69,7 @@ module panel_decomposition_mod integer(i_def) :: num_xprocs contains procedure, public :: get_partition => get_guided_nonuniform_partition + procedure, public :: get_nprocs => get_guided_nonuniform_nprocs end type guided_nonuniform_decomposition_type ! Constructor interface guided_nonuniform_decomposition_type @@ -105,6 +112,19 @@ end subroutine get_partition_interface end interface + abstract interface + + function get_nprocs_interface(self) result(nprocs) + use constants_mod, only: i_def + import :: panel_decomposition_type + + class(panel_decomposition_type), intent(in) :: self + + integer(i_def) :: nprocs(2) + end function get_nprocs_interface + + end interface + contains !> @brief Partition the panel into a given number of x and y processes @@ -184,7 +204,6 @@ subroutine get_custom_partition( self, & end subroutine get_custom_partition - !> @brief Constructor for custom_decomposition_type !> @param[in] xprocs The requested number of partitions in the x direction !> @param[in] yprocs The requested number of partitions in the y direction @@ -199,6 +218,19 @@ function custom_decomposition_constructor(xprocs, yprocs) result(self) end function custom_decomposition_constructor + !> @brief Get the number of processors in the x- and y-direction + !> @result nprocs Number of processors (x-dir, y-dir) + function get_custom_nprocs(self) result(nprocs) + use constants_mod, only: i_def + + class(custom_decomposition_type), intent(in) :: self + + integer(i_def) :: nprocs(2) + + nprocs(:) = (/ self%num_xprocs, self%num_yprocs /) + + end function get_custom_nprocs + !> @brief Partition the panel into an automatically determined number of x and ! y processes @@ -239,6 +271,8 @@ subroutine get_auto_partition( self, & partition_x_pos, & partition_y_pos + integer(i_def), parameter :: max_factor_iters = 10000 + integer(i_def) :: num_xprocs, num_yprocs integer(i_def) :: mp_num_cells_x, mp_num_cells_y integer(i_def) :: start_xprocs, start_width, i @@ -328,6 +362,24 @@ subroutine get_auto_partition( self, & end subroutine get_auto_partition + !> @brief Get the number of processors in the x- and y-direction. + !! For this class the function is not needed and so only + !! returns default values + !> @result nprocs Number of processors (x-dir, y-dir) + function get_auto_nprocs(self) result(nprocs) + use constants_mod, only: i_def + + class(auto_decomposition_type), intent(in) :: self + + integer(i_def) :: nprocs(2) + + ! These values aren't needed for auto decomposition + ! (and aren't available until get_auto_partition has been called) + ! so just return something that won't break the code + nprocs(:) = (/ 1, 1 /) + + end function get_auto_nprocs + !> @brief Partition the panel only in the x direction !> @param[in] relative_rank The number of this rank in the order of all @@ -400,6 +452,24 @@ subroutine get_row_partition( self, & end subroutine get_row_partition + !> @brief Get the number of processors in the x- and y-direction. + !! For this class the function is not needed and so only + !! returns default values + !> @result nprocs Number of processors (x-dir, y-dir) + function get_row_nprocs(self) result(nprocs) + use constants_mod, only: i_def + + class(row_decomposition_type), intent(in) :: self + + integer(i_def) :: nprocs(2) + + ! These values aren't needed for row decomposition + ! (and arenn't available until get_row_partition has been called) + ! so just return something that won't break the code + nprocs(:) = (/ 1, 1 /) + + end function get_row_nprocs + !> @brief Partition the panel only in the y direction !> @param[in] relative_rank The number of this rank in the order of all @@ -472,6 +542,24 @@ subroutine get_column_partition( self, & end subroutine get_column_partition + !> @brief Get the number of processors in the x- and y-direction. + !! For this class the function is not needed and so only + !! returns default values + !> @result nprocs Number of processors (x-dir, y-dir) + function get_column_nprocs(self) result(nprocs) + use constants_mod, only: i_def + + class(column_decomposition_type), intent(in) :: self + + integer(i_def) :: nprocs(2) + + ! These values aren't needed for column decomposition + ! (and aren't available until get_column_partition has been called) + ! so just return something that won't break the code + nprocs(:) = (/ 1, 1 /) + + end function get_column_nprocs + !> @brief Partition the panel into an automatically determined number of ! columns of partitions of variable size. !> @param[in] relative_rank The number of this rank in the order of all @@ -570,6 +658,24 @@ subroutine get_auto_nonuniform_partition( self, & end subroutine get_auto_nonuniform_partition + !> @brief Get the number of processors in the x- and y-direction. + !! For this class the function is not needed and so only + !! returns default values + !> @result nprocs Number of processors (x-dir, y-dir) + function get_auto_nonuniform_nprocs(self) result(nprocs) + use constants_mod, only: i_def + + class(auto_nonuniform_decomposition_type), intent(in) :: self + + integer(i_def) :: nprocs(2) + + ! These values aren't needed for auto_nonuniform decomposition + ! (and aren't available until get_auto_nonuniform_partition has been called) + ! so just return something that won't break the code + nprocs(:) = (/ 1, 1 /) + + end function get_auto_nonuniform_nprocs + !> @brief Partition the panel into a given number of columns of partitions of ! variable size. !> @param[in] relative_rank The number of this rank in the order of all @@ -661,6 +767,24 @@ function guided_nonuniform_decomposition_constructor( xprocs ) result(self) end function guided_nonuniform_decomposition_constructor + !> @brief Get the number of processors in the x- and y-direction. + !! For this class the function is not needed and so only + !! returns default values + !> @result nprocs Number of processors (x-dir, y-dir) + function get_guided_nonuniform_nprocs(self) result(nprocs) + use constants_mod, only: i_def + + class(guided_nonuniform_decomposition_type), intent(in) :: self + + integer(i_def) :: nprocs(2) + + ! These values aren't needed for guided_nonuniform decomposition + ! (and aren't available until get_guided_nonuniform_partition has been called) + ! so just return something that won't break the code + nprocs(:) = (/ 1, 1 /) + + end function get_guided_nonuniform_nprocs + !> @brief Helper function for generating identical partitions arranged in a ! rectangular grid @@ -876,10 +1000,9 @@ function calc_mapping_factor( global_mesh_collection, global_mesh ) result(mp) end if end do - ! If no meshes were found, return 1. This is relevant for JEDI where mesh - ! initialisation is run twice. + ! If no meshes were found, or if this_panel_width < shortest_panel_width, then return 1. if ( shortest_panel_width < huge(0_i_def) ) then - mp = this_panel_width / shortest_panel_width + mp = max(1, this_panel_width / shortest_panel_width) else mp = 1 end if @@ -959,4 +1082,4 @@ function calc_panel_width( global_mesh ) result(panel_edge_ncells_x) end function calc_panel_width -end module panel_decomposition_mod \ No newline at end of file +end module panel_decomposition_mod diff --git a/infrastructure/source/mesh/partition_mod.F90 b/infrastructure/source/mesh/partition_mod.F90 index 3348427a6..a9ff9097e 100644 --- a/infrastructure/source/mesh/partition_mod.F90 +++ b/infrastructure/source/mesh/partition_mod.F90 @@ -25,6 +25,7 @@ module partition_mod use sort_mod, only : bubble_sort use log_mod, only : log_event, & log_scratch_space, & + LOG_LEVEL_INFO, & LOG_LEVEL_ERROR, & LOG_LEVEL_DEBUG use constants_mod, only: i_def, r_def, l_def @@ -524,11 +525,6 @@ subroutine partitioner_cubedsphere( global_mesh, & ! A cubed sphere has 6 panels num_panels = 6 - !check that we have a number of ranks that is compatible with this partitioner - if( modulo(total_ranks,num_panels) /= 0 ) call log_event( & - 'The cubed-sphere partitioner requires a multiple of six processors.', & - LOG_LEVEL_ERROR ) - call partitioner_rectangular_panels( global_mesh, & num_panels, & decomposition, & @@ -676,18 +672,20 @@ subroutine partitioner_rectangular_panels( global_mesh, & ! but not in the partitioned domain logical(l_def), intent(in) :: generate_inner_halos ! Flag to control the generation of inner halos - integer(i_def) :: face ! which face of the cube is implied by local_rank (0->5) - integer(i_def) :: start_cell ! lowest cell id of the face implaced by local_rank - integer(i_def) :: start_rank ! The number of the first rank on the face implied by local_rank - integer(i_def) :: panel_ranks! The number of ranks per panel on the mesh - integer(i_def) :: relative_rank ! The position of the current rank relative to the first rank in its panel - integer(i_def) :: start_x ! global cell id of start of the domain on this partition in x-dirn - integer(i_def) :: num_x ! number of cells in the domain on this partition in x-dirn - integer(i_def) :: start_y ! global cell id of start of the domain on this partition in y-dirn - integer(i_def) :: num_y ! number of cells in the domain on this partition in y-dirn - integer(i_def) :: ix, iy ! loop counters over cells on this partition in x- and y-dirns - integer(i_def) :: void_cell ! Cell id that marks the cell as a cell outside of the partition. - logical :: any_maps ! Whether there exist maps between meshes, meaning their partitions must align. + integer(i_def) :: face ! which face of the cube is implied by local_rank (0->5) + integer(i_def) :: start_cell ! lowest cell id of the face implaced by local_rank + integer(i_def) :: start_rank ! The number of the first rank on the face implied by local_rank + integer(i_def) :: panel_ranks ! The number of ranks per panel on the mesh + integer(i_def) :: relative_rank ! The position of the current rank relative to the first rank in its panel + integer(i_def) :: start_x ! global cell id of start of the domain on this partition in x-dirn + integer(i_def) :: num_x ! number of cells in the domain on this partition in x-dirn + integer(i_def) :: start_y ! global cell id of start of the domain on this partition in y-dirn + integer(i_def) :: num_y ! number of cells in the domain on this partition in y-dirn + integer(i_def) :: ix, iy ! loop counters over cells on this partition in x- and y-dirns + integer(i_def) :: void_cell ! Cell id that marks the cell as a cell outside of the partition. + logical :: any_maps ! Whether there exist maps between meshes, meaning their partitions must align. + integer(i_def) :: start1, end1, inc1 ! Loop indices for inserting cells into the partition + integer(i_def) :: start2, end2, inc2 ! Loop indices for inserting cells into the partition ! Create linked lists @@ -699,26 +697,38 @@ subroutine partitioner_rectangular_panels( global_mesh, & type(linked_list_item_type), pointer :: insert_point ! where to insert in a list type(linked_list_item_type), pointer :: loop ! temp ptr to loop through list - integer :: i, j ! loop counters - integer :: cells(4) ! The cells around the vertex being queried - integer :: oth1, oth2 ! When querying a cell around a vertex, these are - ! the indices of the other two cells + integer :: i, j ! loop counters + integer :: cells(4) ! The cells around the vertex being queried + integer :: oth1, oth2 ! When querying a cell around a vertex, these are + ! the indices of the other two cells integer, allocatable :: sw_corner_cells(:) - ! List of cells at the SW corner of the panels - integer :: panel ! panel number - integer :: cell ! starting point for num_cells_x calculation - integer :: cell_next(4) ! The cells around the cell being queried - integer :: cell_next_e ! The cell to the east of the cell being queried - integer :: num_cells_x ! number of cells across a panel in x-direction - integer :: num_cells_y ! number of cells across a panel in y-direction + ! List of cells at the SW corner of the panels + integer :: panel ! panel number + integer :: cell ! starting point for num_cells_x calculation + integer :: cell_next(4) ! The cells around the cell being queried + integer :: cell_next_e ! The cell to the east of the cell being queried + integer :: num_cells_x ! number of cells across a panel in x-direction + integer :: num_cells_y ! number of cells across a panel in y-direction integer :: start_sort, end_sort ! range over which to sort cells - integer :: depth ! counter over the halo depths - integer :: orig_num_in_list ! number of cells in list before halos are added + integer :: depth ! counter over the halo depths + integer :: orig_num_in_list ! number of cells in list before halos are added + integer :: ncell ! Number of cells + integer :: cell_id ! Id of cell in the partition + logical :: cross_panels ! Flag for partitioning across multiple cubed sphere panels + logical :: check_orientation ! Check for orientation changes when getting cell id's + integer :: n_cross_panels ! number of panels to decompose across + integer, allocatable :: face_of_combined_panels(:) + ! The first face in sections of combined cubed sphere panels + integer :: nprocs(2) ! number of processors in the x- & y-direction + integer :: xproc ! number of processsors in x-direction + integer :: yproc ! number of processsors in y-direction integer(i_def) :: num_apply logical(l_def) :: periodic_xy(2) ! Periodic in the x/y-axes periodic_xy = global_mesh%get_mesh_periodicity() void_cell = global_mesh%get_void_cell() + cross_panels = .false. + n_cross_panels = 1 any_maps = global_mesh%get_nmaps() > 0 nullify( last ) @@ -726,6 +736,10 @@ subroutine partitioner_rectangular_panels( global_mesh, & nullify( insert_point ) nullify( loop ) + nprocs = decomposition%get_nprocs() + xproc = nprocs(1) + yproc = nprocs(2) + if (num_panels==1) then ! A single panelled mesh might be rectangluar - so find the dimensions ! First determine the southwest corner cell depending on periodicity. If @@ -780,12 +794,55 @@ subroutine partitioner_rectangular_panels( global_mesh, & num_cells_y=global_mesh%get_ncells()/num_cells_x else - ! For multi-panel meshes, the panels must be square - num_cells_x = nint(sqrt( real(global_mesh%get_ncells(), kind=r_def)/ & - real(num_panels, kind=r_def) )) - num_cells_y = num_cells_x + if( num_panels == 6 .and. & + xproc*yproc*2 == total_ranks .and. & + modulo(total_ranks,2) == 0 ) then + ncell = nint(sqrt( real(global_mesh%get_ncells(), kind=r_def)/ & + real(num_panels, kind=r_def) )) + ! We will partition across 3 panels giving 2 'super' panels of 3 cubed-sphere panels each + cross_panels = .true. + n_cross_panels = 2 + num_cells_x = ncell * 3 + num_cells_y = ncell + allocate( face_of_combined_panels(n_cross_panels) ) + ! Super panels consist of faces (1, 2, 3), (6, 4, 5) + ! In terms of the panel numbers used here is then + ! (3, 2, 6), (5, 4, 1) + face_of_combined_panels(:) = (/ 3, 5 /) + elseif( num_panels == 6 .and. & + xproc*yproc*3 == total_ranks .and. & + modulo(total_ranks,3) == 0 ) then + ncell = nint(sqrt( real(global_mesh%get_ncells(), kind=r_def)/ & + real(num_panels, kind=r_def) )) + ! We will partition across 2 panels giving 3 'super' panels of 2 cubed-sphere panels each + cross_panels = .true. + n_cross_panels = 3 + num_cells_x = ncell * 2 + num_cells_y = ncell + allocate( face_of_combined_panels(n_cross_panels) ) + ! Super panels consist of faces (1, 2), (4,5) & (6,3) + ! In terms of the panel numbers used here is then + ! (3, 2), (4, 1), (5, 6) + face_of_combined_panels(:) = (/ 3, 4, 5 /) + elseif( modulo(total_ranks,num_panels) == 0 ) then + ! For multi-panel meshes, the panels must be square + num_cells_x = nint(sqrt( real(global_mesh%get_ncells(), kind=r_def)/ & + real(num_panels, kind=r_def) )) + num_cells_y = num_cells_x + else + write(log_scratch_space,*) 'Unable to find a partition strategy. Total ranks (',& + total_ranks,') needs to either have a factor of ', num_panels, & + ' or if num_panels = 6 and custom decomposition is used then total ranks needs to have a factor of 2 or 3' + call log_event(log_scratch_space, LOG_LEVEL_ERROR) + end if ! Calculate the South West corner cells of all the panels in the global mesh + ! Note the 'panel' numbers used here do not correspond to the panel numbers + ! used in the rest of the model as this uses the vertex index to find + ! the cell in the corner of each panel and it is not true that the first corner + ! cell found in this manner will correspond to panel 1. + ! In fact for the cubed sphere meshes used the relationship is: + ! SW corner cells are on panels: (5, 2, 1, 4, 6, 3) allocate(sw_corner_cells(num_panels)) panel=1 do i=1,global_mesh%get_nverts() @@ -812,11 +869,18 @@ subroutine partitioner_rectangular_panels( global_mesh, & endif - face = ((num_panels * local_rank) / total_ranks) + 1 - panel_ranks = total_ranks / num_panels + if ( cross_panels ) then + face = ((n_cross_panels * local_rank) / total_ranks) + 1 + panel_ranks = total_ranks / n_cross_panels + else + face = ((num_panels * local_rank) / total_ranks) + 1 + panel_ranks = total_ranks / num_panels + end if start_rank = panel_ranks * (face - 1) relative_rank = local_rank - start_rank + 1 + ! Work out the start index and number of cells (in x- and y-dirn) for + ! the local partition call decomposition%get_partition( relative_rank, & panel_ranks, & mapping_factor, & @@ -829,7 +893,41 @@ subroutine partitioner_rectangular_panels( global_mesh, & start_y ) - start_cell = sw_corner_cells(face) + + ! Set up limits for finding cells + start1 = start_x + end1 = start_x + num_x - 1 + inc1 = 1 + start2 = start_y + end2 = start_y + num_y - 1 + inc2 = 1 + + if ( cross_panels ) then + ! Generally we want the start cell to be the SW corner cell + ! but there is an exception when we are spanning 3 panels and looking + ! at cubed sphere panels (6,4,5) when we want to start in the NW corner. + ! Cubed sphere panels (6,4,5) correspond to the indices (5, 4, 1) of the + ! sw_corner_cells array since the sw_corner_cells array indices (1,..,6) do not + ! correspond to cubed sphere panels (1,..,6) and are in fact + ! ordered (5, 2, 1, 4, 6, 3) + start_cell = sw_corner_cells(face_of_combined_panels(face)) + if (n_cross_panels == 2 .and. start_cell == sw_corner_cells(5) ) then + ! Start in the NW corner and go in (-y, x) direction + start_cell = global_mesh%get_cell_id(start_cell, 0, num_cells_y-1) + + num_y = num_cells_x / xproc + num_x = num_cells_y / yproc + start1 = start_y + end1 = start1 + num_x - 1 + inc1 = 1 + start2 = -start_x + 2 + end2 = start2 - num_y + 1 + inc2 = -1 + end if + deallocate( face_of_combined_panels ) + else + start_cell = sw_corner_cells(face) + end if deallocate(sw_corner_cells) write(log_scratch_space,"(a,i0,a,i0,a,i0,a,i0)") "start_x ", start_x, & @@ -837,53 +935,38 @@ subroutine partitioner_rectangular_panels( global_mesh, & " num_x ", num_x, & " num_y ", num_y call log_event( log_scratch_space, LOG_LEVEL_DEBUG ) + write(log_scratch_space,"(a,i0,a,i0)") "Number of cells in partition ", num_x, " X ", num_y + call log_event( log_scratch_space, lOG_LEVEL_INFO ) - ! Create a linked list of all cells that are part of this partition (not halos) - + ! Create a linked list of all cells in the partition and at the same time + ! create a linked-list of all edge cells known to the partition, excluding halos. partition = linked_list_type() + known_cells = linked_list_type() + + ! We only need to check for orientation changes in the partition + ! covers multiple panels + check_orientation = cross_panels + + do iy = start2, end2, inc2 + do ix = start1, end1, inc1 + cell_id = global_mesh%get_cell_id(start_cell, ix-1, iy-1, & + check_orientation) + call partition%insert_item( linked_list_int_type( cell_id ) ) + + ! If this is an edge cell then add it to the list of known edge cells + ! (if it is not already there) + if ( ix == start1 .or. ix == end1 .or. iy == start2 .or. iy == end2 ) then + if ( .not. known_cells%item_exists(cell_id) ) then + call known_cells%insert_item( linked_list_int_type( cell_id ) ) + end if + end if - do iy = start_y, start_y+num_y - 1 - do ix = start_x, start_x+num_x - 1 - call partition%insert_item( linked_list_int_type( & - global_mesh%get_cell_id(start_cell, ix-1, iy-1))) end do end do ! Create a linked-list of all cells known to the partition, including halos. ! This will be ordered as: ! inner n, inner n-1 ... inner 1, edge, halo 1 ... halo n-1, halo n - ! - ! Start with the edge cells - those cells owned by the partition - but are on - ! the edge of the partitioned domain, so may have dofs shared with halo cells - - known_cells = linked_list_type() - - ! Those cells along the top/bottom - - do ix = start_x, start_x+num_x-1 - ! start inserting the edge cells - call known_cells%insert_item(linked_list_int_type( & - global_mesh%get_cell_id(start_cell, ix-1, start_y-1))) - ! insert but check for duplicates between start and end of known_cells list - if(.not. (known_cells%item_exists(global_mesh%get_cell_id( & - start_cell, ix-1, start_y+num_y-2)) ) ) then - call known_cells%insert_item( linked_list_int_type( & - global_mesh%get_cell_id(start_cell, ix-1, start_y+num_y-2))) - end if - end do - ! Those along the left/right - do iy = start_y+1, start_y+num_y-2 - if(.not. (known_cells%item_exists(global_mesh%get_cell_id( & - start_cell, start_x-1, iy-1)) )) then - call known_cells%insert_item( linked_list_int_type( & - global_mesh%get_cell_id(start_cell, start_x-1, iy-1))) - end if - if(.not. (known_cells%item_exists(global_mesh%get_cell_id( & - start_cell, start_x+num_x-2, iy-1)) )) then - call known_cells%insert_item( linked_list_int_type( & - global_mesh%get_cell_id(start_cell, start_x+num_x-2, iy-1))) - end if - end do ! get the number of edge cells currently stored in the known_cells list num_edge = known_cells%get_length() diff --git a/infrastructure/source/utilities/cli_mod.f90 b/infrastructure/source/utilities/cli_mod.f90 index 144f252aa..f677a11e8 100644 --- a/infrastructure/source/utilities/cli_mod.f90 +++ b/infrastructure/source/utilities/cli_mod.f90 @@ -12,7 +12,7 @@ module cli_mod implicit none private - public :: get_initial_filename + public :: parse_command_line contains @@ -27,7 +27,7 @@ module cli_mod !> not specified, master namelist is assumed. !> @param [inout] component_name Optional component-component name !> - subroutine get_initial_filename( filename, description, component_name ) + subroutine parse_command_line( filename, description, component_name ) implicit none @@ -47,6 +47,11 @@ subroutine get_initial_filename( filename, description, component_name ) integer :: argument_tally integer :: iarg logical :: filename_set + logical :: file_exists + +! NOTE: This should be the first routine called by an LFRic application. +! That means it is called before logging has been initialised, hence +! it writes output to "error_unit" from the iso_fortran_env module if (present(description)) then allocate( filename_description, source=description ) @@ -112,7 +117,14 @@ subroutine get_initial_filename( filename, description, component_name ) if(allocated(oname))allocate(component_name,source=oname) end if - end subroutine get_initial_filename + ! Check if the provided filename exists + inquire(file=filename, exist=file_exists) + if(.not.file_exists)then + write( error_unit, '("File ",a," does not exist.")' )filename + stop 2 + end if + + end subroutine parse_command_line subroutine print_usage( to_unit, program_name, filename_description ) diff --git a/infrastructure/source/utilities/halo_comms_mod.F90 b/infrastructure/source/utilities/halo_comms_mod.F90 index 3f49a8590..2691e65ce 100644 --- a/infrastructure/source/utilities/halo_comms_mod.F90 +++ b/infrastructure/source/utilities/halo_comms_mod.F90 @@ -41,6 +41,60 @@ module halo_comms_mod perform_halo_exchange, perform_halo_exchange_start, & perform_halo_exchange_finish + !> @details A wrapper type for a YAXT xt_xmap object (which is used in the + !> generation of halo routing tables), along with metadata that describes + !> the fields for which it is valid + ! + type, extends(linked_list_data_type), public :: exchange_map_type + private + !> Id of the mesh used in the function space that this information + !> is valid for + integer(i_def) :: mesh_id + !> Order of the function space that this information is valid for + !integer(i_def) :: element_order + integer(i_def) :: element_order_h, element_order_v + !> Enumerated value representing the continutity of the function space + !> that this information is valid for + integer(i_def) :: lfric_fs + !> The number of multidata values per dof location that this information + !> is valid for + integer(i_def) :: ndata + !> Depth of halo this routing is computed to + integer(i_def) :: halo_depth + !> Number of redistribution map objects + integer(i_def) :: max_depth + !> YAXT redistribution map +#ifdef NO_MPI + ! If this is a non-mpi, serial build, redistribution maps are meaningless + ! so we don't need one, but we need something for get_redist to return + ! so just use an integer + integer(i_def), allocatable :: xmaps(:) +#else + type(xt_xmap), allocatable :: xmaps(:) +#endif + contains + !> Gets the xmap that is used to create a redistrubution map + procedure, public :: get_xmap + !> Gets the mesh_id for which the halo_routing object is valid + procedure, public :: get_exchange_map_mesh_id + !> Gets the element_order_h for which the halo_routing object is valid + procedure, public :: get_exchange_map_element_order_h + !> Gets the element_order_v for which the halo_routing object is valid + procedure, public :: get_exchange_map_element_order_v + !> Gets the function space continuity type for which the halo_routing + !> object is valid + procedure, public :: get_exchange_map_lfric_fs + !> Gets the number of multidata values per dof location for which the + !> halo_routing object is valid + procedure, public :: get_exchange_map_ndata + !> Get halo depth + procedure, public :: get_exchange_map_halo_depth + end type exchange_map_type + + interface exchange_map_type + module procedure exchange_map_constructor + end interface + !> @details A wrapper type for a YAXT xt_redist object (which holds a halo !> routing table), along with metadata that describes the fields for which !> that routing table is valid @@ -143,6 +197,50 @@ module halo_comms_mod end interface contains + !contains + function exchange_map_constructor( global_dof_id, & + last_owned_dof, & + halo_start, & + halo_finish, & + mesh_id, & + element_order_h, & + element_order_v, & + lfric_fs, & + ndata, & + halo_depth) & + result(self) + implicit none + integer(i_halo_index), intent(in) :: global_dof_id(:) + integer(i_def), intent(in) :: last_owned_dof + integer(i_def), intent(in) :: halo_start(:) + integer(i_def), intent(in) :: halo_finish(:) + integer(i_def), intent(in) :: mesh_id + integer(i_def), intent(in) :: ndata + integer(i_def), intent(in) :: halo_depth + type(exchange_map_type) :: self + integer(i_def) :: max_depth + integer(i_def) :: idepth + integer(i_def) :: element_order_h, element_order_v + integer(i_def) :: lfric_fs + self%mesh_id = mesh_id + self%element_order_h = element_order_h + self%element_order_v = element_order_v + self%lfric_fs = lfric_fs + self%ndata = ndata + self%halo_depth = halo_depth + max_depth = size(halo_start) + allocate( self%xmaps(max_depth) ) +#ifdef NO_MPI + self%xmaps(:) = 0 + idepth=0 ! Set local variables to avoid unused variable errors +#else + do idepth = 1 ,max_depth + self%xmaps(idepth) = generate_exchange_map(global_dof_id(1:last_owned_dof), & + global_dof_id( halo_start(idepth):halo_finish(idepth) )) + end do +#endif + end function exchange_map_constructor + !----------------------------------------------------------------------- ! Type bound procedures for the halo_routing type @@ -167,6 +265,9 @@ module halo_comms_mod !> information will be valid !> @param [in] fortran_kind The Fortran kind of the data for which this !> information will be valid +!> @param [in] halo_depth Depth of halo this routing is computed to +!> @param [in] xmaps Array of xt_xmap exchange objects in case of MPI build. +!> In case of Non-MPI build, it is defined as an array of integers. !> @return The new halo_routing object function halo_routing_constructor( global_dof_id, & last_owned_dof, & @@ -179,7 +280,8 @@ function halo_routing_constructor( global_dof_id, & ndata, & fortran_type, & fortran_kind, & - halo_depth ) result(self) + halo_depth, & + exchange_maps) result(self) implicit none @@ -195,10 +297,16 @@ function halo_routing_constructor( global_dof_id, & integer(i_def), intent(in) :: fortran_type integer(i_def), intent(in) :: fortran_kind integer(i_def), intent(in) :: halo_depth + type(exchange_map_type), intent(in), pointer, optional :: exchange_maps - type(halo_routing_type) :: self - integer(i_def) :: max_depth - integer(i_def) :: idepth + type(halo_routing_type) :: self + integer(i_def) :: max_depth + integer(i_def) :: idepth +#ifdef NO_MPI + integer(i_def) :: xmap +#else + type(xt_xmap) :: xmap +#endif max_depth = size(halo_start) @@ -217,13 +325,22 @@ function halo_routing_constructor( global_dof_id, & #ifdef NO_MPI self%redist(:) = 0 idepth=0 ! Set local variables to avoid unused variable errors + xmap=0 #else - do idepth = 1, max_depth +do idepth = 1 ,max_depth + + if (present(exchange_maps)) then + xmap = exchange_maps%get_xmap(idepth) + else + xmap = generate_exchange_map(global_dof_id(1:last_owned_dof), & + global_dof_id( halo_start(idepth):halo_finish(idepth) )) + end if ! Get the redistribution map objects for doing halo exchanges later self%redist(idepth) = generate_redistribution_map( & global_dof_id(1:last_owned_dof), & global_dof_id( halo_start(idepth):halo_finish(idepth) ), & - get_lfric_datatype( fortran_type, fortran_kind ) ) + get_lfric_datatype( fortran_type, fortran_kind ), & + xmap) end do #endif @@ -355,6 +472,93 @@ function get_redist(self, depth) result (redist) return end function get_redist +!---------------------------------------------------------------------- +! Getter functions for exchange map + +!> @brief Gets a YAXT xmap used to create the redistribution maps +!> @param [in] depth The depth of halo exchange that the redistribution map +!> will be used for +!> @return The YAXT xmap for a particular depth of halo +function get_xmap(self, depth) result (xmap) + + implicit none + + class(exchange_map_type), intent(in), target :: self + integer(i_def), intent(in) :: depth + +#ifdef NO_MPI + integer(i_def) :: xmap +#else + type(xt_xmap) :: xmap +#endif + + xmap = self%xmaps(depth) + + return +end function get_xmap + +!> @brief Gets the mesh_id for which this object is valid +!> @return Id of the mesh that this information is valid for +function get_exchange_map_mesh_id(self) result (mesh_id) + implicit none + class(exchange_map_type), intent(in) :: self + integer(i_def) :: mesh_id + mesh_id = self%mesh_id + return +end function get_exchange_map_mesh_id + +!> @brief Gets the element_order_h for which this object is valid +!> @return The element order that this information is valid for +function get_exchange_map_element_order_h(self) result (element_order_h) + implicit none + class(exchange_map_type), intent(in) :: self + integer(i_def) :: element_order_h + element_order_h = self%element_order_h + return +end function get_exchange_map_element_order_h + +!> @brief Gets the element_order_v for which this object is valid +!> @return The element order that this information is valid for +function get_exchange_map_element_order_v(self) result (element_order_v) + implicit none + class(exchange_map_type), intent(in) :: self + integer(i_def) :: element_order_v + element_order_v = self%element_order_v + return +end function get_exchange_map_element_order_v + +!> @brief Gets the function space continuity type for which this object is valid +!> @return The function space continuity type that this information is valid for +function get_exchange_map_lfric_fs(self) result (lfric_fs) + implicit none + class(exchange_map_type), intent(in) :: self + integer(i_def) :: lfric_fs + lfric_fs = self%lfric_fs + return +end function get_exchange_map_lfric_fs + +!> @brief Gets the number of multidata values per dof location for which this +!> object is valid +!> @return The number of multidata values per dof location that this +!> information is valid for +function get_exchange_map_ndata(self) result (ndata) + implicit none + class(exchange_map_type), intent(in) :: self + integer(i_def) :: ndata + ndata = self%ndata + return +end function get_exchange_map_ndata + +!> @brief Gets the halo depth for which this object is valid +!> @return The halo depth for which this object is valid +function get_exchange_map_halo_depth(self) result (halo_depth) + implicit none + class(exchange_map_type), intent(in) :: self + integer(i_def) :: halo_depth + halo_depth = self%halo_depth + return +end function get_exchange_map_halo_depth + !----------------------------------------------------------------------- ! Non-type-bound halo comms functionality @@ -609,25 +813,31 @@ end subroutine perform_halo_exchange_finish !> MPI task !> @param tgt_indices [in] The global indices of all the halo points in this !> MPI task -!> @param datatype [in] The MPI datatype of a single element in the data to be +!> @param xmap [in] xt_xmap exchange object in case of MPI build. +!> In case of Non-MPI build, it is defined as an integer. +!> @param datatype [in] The MPI datatype of a single element in the data to be !> exchanged !> @return redist The halo exchange redistribution object !> -function generate_redistribution_map(src_indices, tgt_indices, datatype) & +function generate_redistribution_map(src_indices, tgt_indices, datatype, xmap) & result(redist) implicit none integer(i_halo_index), intent(in) :: src_indices(:), tgt_indices(:) type(lfric_datatype_type), intent(in) :: datatype +#ifdef NO_MPI + ! xmaps are meaningless in a non-mpi build, create an integer for tests + integer(i_def) :: xmap +#else + type(xt_xmap) :: xmap +#endif #ifdef NO_MPI ! Redistribution maps are meaningless in a non-mpi build, so just return 0 integer(i_def) :: redist - redist = 0 #else type(xt_redist) :: redist type(xt_idxlist) :: src_idxlist, tgt_idxlist - type(xt_xmap) :: xmap integer(i_def), allocatable :: src_offsets(:) integer(i_def), allocatable :: tgt_offsets(:) integer(i_def) :: i @@ -658,9 +868,6 @@ function generate_redistribution_map(src_indices, tgt_indices, datatype) & datatype_mpi_val = datatype%get_datatype_mpi_val() redist = xt_redist_p2p_off_new(xmap, src_offsets,tgt_offsets, datatype_mpi_val) - call xt_xmap_delete(xmap) - call xt_idxlist_delete(tgt_idxlist) - call xt_idxlist_delete(src_idxlist) deallocate(src_offsets) deallocate(tgt_offsets) else @@ -672,4 +879,46 @@ function generate_redistribution_map(src_indices, tgt_indices, datatype) & end function generate_redistribution_map +!> Private function to generate an exchange map between +!> source and target indices. +!> +!> @param[in] src_indices Array of source indices. +!> @param[in] tgt_indices Array of target indices. +!> +!> @return xmap Exchange map (`xt_xmap`) or 0 if MPI is disabled. +!> +!> @note MPI must be initialised in an MPI-enabled build. +!> @warning Logs an error if MPI is not initialised. +function generate_exchange_map(src_indices, tgt_indices) result(xmap) + implicit none + integer(i_halo_index), intent(in) :: src_indices(:), tgt_indices(:) +#ifdef NO_MPI + ! xmaps are meaningless in a non-mpi build, so just return 0 + integer(i_def) :: xmap + + xmap = 0 +#else + type(xt_xmap) :: xmap + type(xt_idxlist) :: src_idxlist, tgt_idxlist + type(lfric_comm_type) :: comm + if( global_mpi%is_comm_set() )then + ! create decomposition descriptors + src_idxlist = xt_idxvec_new( src_indices, size(src_indices) ) + tgt_idxlist = xt_idxvec_new( tgt_indices, size(tgt_indices) ) + + ! generate exchange map + comm = global_mpi%get_comm() + xmap = xt_xmap_dist_dir_new( src_idxlist, tgt_idxlist, & + comm%get_comm_mpi_val() ) + call xt_idxlist_delete(tgt_idxlist) + call xt_idxlist_delete(src_idxlist) + else + call log_event( & + 'Call to generate_exchange_map failed. Must initialise mpi first',& + LOG_LEVEL_ERROR ) + end if +#endif + +end function generate_exchange_map + end module halo_comms_mod diff --git a/infrastructure/source/utilities/timing_mod.F90 b/infrastructure/source/utilities/timing_mod.F90 index 7031d6c46..42c62d5d4 100644 --- a/infrastructure/source/utilities/timing_mod.F90 +++ b/infrastructure/source/utilities/timing_mod.F90 @@ -3,153 +3,191 @@ ! For further details please refer to the file LICENCE which you should have ! received as part of this distribution. !----------------------------------------------------------------------------- -!> @brief Provides wrapper support for Vernier timings +!> @brief Provides wrapper support for profiler timings !> module timing_mod - use log_mod, only: log_event, log_scratch_space, & - LOG_LEVEL_DEBUG, LOG_LEVEL_WARNING - use constants_mod, only: i_def, IMDI + use log_mod, only: log_event, log_scratch_space, & + LOG_LEVEL_DEBUG, LOG_LEVEL_WARNING + use constants_mod, only: i_def, imdi, cmdi, str_def #ifdef VERNIER - !Vernier will only be loaded if the VERNIER environment variable is used - use vernier_mod, only: vernier_init, vernier_start, & - vernier_stop, vernier_write, & - vernier_finalize, vik + use vernier_mod, only: vernier_init, vernier_start, & + vernier_stop, vernier_write, & + vernier_finalize, vik + +#elif defined( LEGACY_TIMER ) + use timer_mod, only: timer, init_timer, output_timer #endif - implicit none + implicit none - public :: init_timing, final_timing, start_timing, stop_timing - public :: tik + public :: init_timing, final_timing, start_timing, stop_timing + public :: tik #ifdef VERNIER - !If Vernier is on then the calliper hash 'tik' is defined as Vernier's hash 'vik' - integer, parameter :: tik = vik + integer, parameter :: tik = vik + integer(tik), private :: global_timing_handle #else - integer, parameter :: tik = i_def + integer, parameter :: tik = i_def #endif -#ifndef TIMING_ON - !If the timing macro is not explicity turned on then the callipers won't be called - logical, public, parameter :: LPROF = .false. +#ifdef TIMING_ON + ! LPROF enables profiler timings. + logical, public, protected :: LPROF = .false. #else - !If the timing macro is defined/ turned on, LPROF will be defined later (by subroutine_timers) - logical, public :: LPROF + ! LPROF enables profiler timings. + ! The logical is declared as a parameter for this build + ! so compilers can easily optimise out the profiler + ! calliper calls from the code. + logical, public, parameter :: LPROF = .false. #endif contains !=============================================================================! -!> @brief Initialize timings -!> @param[in] communicator LFRic mpi communicator +!> @brief Initialise timings and start a global calliper +!> @param[in] communicator LFRic mpi communicator !> @param[in] lsubroutine_timers Runtime logical controlling timer use - subroutine init_timing( communicator, lsubroutine_timers ) - use lfric_mpi_mod, only: lfric_comm_type +!> @param[in] application_name String for the global calliper +!> @param[in] timer_output_path Temporary string used for the legacy timer path + subroutine init_timing( communicator, lsubroutine_timers, application_name, & + timer_output_path ) + use lfric_mpi_mod, only: lfric_comm_type - implicit none + implicit none - logical, intent(in) :: lsubroutine_timers - type( lfric_comm_type ), intent(in) :: communicator + type( lfric_comm_type ), intent(in) :: communicator + logical, intent(in) :: lsubroutine_timers + character(*), intent(in) :: application_name + character(*), intent(in), optional :: timer_output_path #ifdef TIMING_ON - !If timing is on, LPROF will be defined by subroutine_timers - LPROF = lsubroutine_timers + character(str_def) :: name - write(log_scratch_space, '(A)') 'Timing Mod: Runtime timing is turned on' - call log_event(log_scratch_space, LOG_LEVEL_DEBUG) + ! If timing is on, LPROF will be defined by subroutine_timers + LPROF = lsubroutine_timers + name = cmdi -#ifdef VERNIER - !If Timing and Vernier is on, Vernier will be initialised +#ifdef LEGACY_TIMER + name = 'Timer' + if ( LPROF ) then + if ( present ( timer_output_path ) ) then + call init_timer( timer_output_path ) + else + call init_timer( 'timer.txt' ) + end if - write(log_scratch_space, '(A)') 'Timing Mod: Vernier is turned on' - call log_event(log_scratch_space, LOG_LEVEL_DEBUG) + call timer( application_name ) - call vernier_init( communicator%get_comm_mpi_val() ) + end if - write(log_scratch_space, '(A)') 'Timing Mod: Vernier initialised' - call log_event(log_scratch_space, LOG_LEVEL_DEBUG) -#endif +#elif defined( VERNIER ) + name = 'Vernier' + if ( LPROF ) then + call vernier_init( communicator%get_comm_mpi_val(), & + tag=trim(application_name) ) + if ( LPROF ) call vernier_start( global_timing_handle, '__' // & + application_name // '__' ) -#ifndef VERNIER - !If Timing is on but Vernier is not on then a warning will be thrown - write(log_scratch_space, '(A)') 'Timing Mod: Runtime timing is turned on but no profiling tool (such as Vernier) is turned on!' - call log_event(log_scratch_space, LOG_LEVEL_WARNING) -#endif -#endif + end if -#ifndef TIMING_ON -#ifdef VERNIER - write(log_scratch_space, '(A)') 'Timing Mod: Vernier is on but Timing is not!' - call log_event(log_scratch_space, LOG_LEVEL_WARNING) #endif + + if ( LPROF ) then + if (trim( name ) == trim( cmdi )) then + call log_event('Subroutine timings unavailable, no profiler compiled', & + log_level_warning) + else + call log_event( trim( name ) // ' initialised', log_level_debug ) + end if + end if + #endif - end subroutine init_timing + end subroutine init_timing !=============================================================================! -!> @brief Output and finalize timings - subroutine final_timing() - - implicit none +!> @brief Output and finalise timings + subroutine final_timing( application_name ) + implicit none + character(*), intent(in) :: application_name #ifdef TIMING_ON #ifdef VERNIER - !If Vernier is on then it will write to a file and then finalise - call vernier_write() + ! If Vernier is on then it will write to a file and then finalise + if ( LPROF ) then + call vernier_stop( global_timing_handle ) + call vernier_write() + write(log_scratch_space, '(A)') 'Timing Mod: Vernier has written to file' + call log_event(log_scratch_space, LOG_LEVEL_DEBUG) + + call vernier_finalize() + write(log_scratch_space, '(A)') 'Timing Mod: Vernier finalised' + call log_event(log_scratch_space, LOG_LEVEL_DEBUG) + end if + +#elif defined(LEGACY_TIMER) + if ( LPROF ) then + call timer ( application_name ) + call output_timer() + + write(log_scratch_space, '(A)') 'Timing Mod: Legacy timing finalised' + call log_event(log_scratch_space, LOG_LEVEL_DEBUG) + end if - write(log_scratch_space, '(A)') 'Timing Mod: Vernier has written to file' - call log_event(log_scratch_space, LOG_LEVEL_DEBUG) - - call vernier_finalize() - - write(log_scratch_space, '(A)') 'Timing Mod: Vernier finalised' - call log_event(log_scratch_space, LOG_LEVEL_DEBUG) #endif #endif - - end subroutine final_timing + end subroutine final_timing !=============================================================================! !> @brief Start timings -!> @param[out] timing_section_handle The name of the section that is being timed -!> @param[in] timing_state_name Starting or stopping the given timing, either 'start' or 'stop' - subroutine start_timing( timing_section_handle, timing_section_name ) +!> @param[out] timing_section_handle The integer handle for timed region +!> @param[in] timing_state_name Name of the measured region + subroutine start_timing( timing_section_handle, timing_section_name ) - implicit none + implicit none - character(*), intent(in) :: timing_section_name - integer(tik), intent(out) :: timing_section_handle + integer(tik), intent(out) :: timing_section_handle + character(*), intent(in) :: timing_section_name + + timing_section_handle = imdi #ifdef VERNIER - !If Vernier is on will start a calliper - call vernier_start( timing_section_handle , timing_section_name ) -#else - timing_section_handle = IMDI + ! If Vernier is on will start a calliper + call vernier_start( timing_section_handle , timing_section_name ) + +#elif defined(LEGACY_TIMER) + call timer( timing_section_name ) + #endif - end subroutine start_timing + end subroutine start_timing - !=============================================================================! +!=============================================================================! !> @brief Stop timings -!> @param[in] timing_section_handle The name of the section that is being timed - subroutine stop_timing( timing_section_handle ) - - implicit none +!> @param[in] timing_section_handle The integer handle for timed region +!> @param[in] timing_state_name Optional, name of the measured region + subroutine stop_timing( timing_section_handle, timing_section_name ) + implicit none - integer(tik), intent(in) :: timing_section_handle - !Future callipers may require the section name as well as the handle + integer(tik), optional, intent(in) :: timing_section_handle + character(*), optional, intent(in) :: timing_section_name #ifdef VERNIER - !If Vernier is on will end a calliper - call vernier_stop( timing_section_handle ) + ! If Vernier is on will end a calliper + call vernier_stop( timing_section_handle ) + +#elif defined(LEGACY_TIMER) + call timer( timing_section_name ) + #endif - end subroutine stop_timing + end subroutine stop_timing end module timing_mod diff --git a/infrastructure/unit-test/mesh/panel_decomposition_mod_test.pf b/infrastructure/unit-test/mesh/panel_decomposition_mod_test.pf new file mode 100644 index 000000000..7f60ae364 --- /dev/null +++ b/infrastructure/unit-test/mesh/panel_decomposition_mod_test.pf @@ -0,0 +1,87 @@ +!----------------------------------------------------------------------------- +! Copyright (c) 2026, Met Office, on behalf of HMSO and Queen's Printer +! For further details please refer to the file LICENCE which you +! should have received as part of this distribution. +!----------------------------------------------------------------------------- + +!> Test the panel decomposition module +module panel_decomposition_mod_test + + use pfunit + use constants_mod, only: i_def + use panel_decomposition_mod, only: custom_decomposition_type, & + auto_decomposition_type, & + row_decomposition_type, & + column_decomposition_type, & + auto_nonuniform_decomposition_type, & + guided_nonuniform_decomposition_type + + implicit none + + private + public :: test_all + +contains + + @test + subroutine test_all + + implicit none + + type(custom_decomposition_type) :: custom_decomposition + type(auto_decomposition_type) :: auto_decomposition + type(row_decomposition_type) :: row_decomposition + type(column_decomposition_type) :: column_decomposition + type(auto_nonuniform_decomposition_type) :: auto_nonuniform_decomposition + type(guided_nonuniform_decomposition_type) :: guided_nonuniform_decomposition + + integer(i_def), parameter :: xprocs = 3 + integer(i_def), parameter :: yprocs = 4 + integer(i_def) :: nprocs(2) + + ! Test the custom decomposition type + custom_decomposition = custom_decomposition_type(xprocs, yprocs) + + nprocs = custom_decomposition%get_nprocs() + @assertEqual( xprocs, nprocs(1) ) + @assertEqual( yprocs, nprocs(2) ) + + ! Test the auto decomposition type + auto_decomposition = auto_decomposition_type() + + nprocs = auto_decomposition%get_nprocs() + @assertEqual( 1, nprocs(1) ) + @assertEqual( 1, nprocs(2) ) + + ! Test the row decomposition type + row_decomposition = row_decomposition_type() + + nprocs = row_decomposition%get_nprocs() + @assertEqual( 1, nprocs(1) ) + @assertEqual( 1, nprocs(2) ) + + ! Test the column decomposition type + column_decomposition = column_decomposition_type() + + nprocs = column_decomposition%get_nprocs() + @assertEqual( 1, nprocs(1) ) + @assertEqual( 1, nprocs(2) ) + + ! Test the auto_nonuniform decomposition type + auto_nonuniform_decomposition = auto_nonuniform_decomposition_type() + + nprocs = auto_nonuniform_decomposition%get_nprocs() + @assertEqual( 1, nprocs(1) ) + @assertEqual( 1, nprocs(2) ) + + ! Test the guided_nonuniform decomposition type + guided_nonuniform_decomposition = guided_nonuniform_decomposition_type(xprocs) + + nprocs = guided_nonuniform_decomposition%get_nprocs() + @assertEqual( 1, nprocs(1) ) + @assertEqual( 1, nprocs(2) ) + + end subroutine test_all + +end module panel_decomposition_mod_test + diff --git a/infrastructure/unit-test/mesh/partition_mod_test.pf b/infrastructure/unit-test/mesh/partition_mod_test.pf index bc698f2e7..1a40b4802 100644 --- a/infrastructure/unit-test/mesh/partition_mod_test.pf +++ b/infrastructure/unit-test/mesh/partition_mod_test.pf @@ -18,6 +18,7 @@ module partition_mod_test lfric_comm_type use partition_mod, only: partition_type, & partitioner_planar, & + partitioner_cubedsphere, & partitioner_cubedsphere_serial, & partitioner_interface use reference_element_mod, only: reference_cube_type @@ -85,7 +86,7 @@ contains !> Test partition module functionality !> - @Test(npes=[1, 4] ) + @Test(npes=[1, 3, 4] ) subroutine test_partition_BiPeriodic( this ) implicit none @@ -129,6 +130,9 @@ contains case (1) xproc = 1 yproc = 1 + case (3) + xproc = 3 + yproc = 1 case (4) xproc = 2 yproc = 2 @@ -160,11 +164,13 @@ contains local_rank, & total_ranks ) - ! Test functionality of the partition object we've just created on both 1 + ! Test functionality of the partition object we've just created on 1, 3 ! and 4 processes select case (num_processes) case (1) +! Testing over 1 (8x8) partition. All cells are owned - so no halo/ghost cells + num_cells_in_layer = partition%get_num_cells_in_layer() @assertEqual( 64, num_cells_in_layer ) @@ -195,7 +201,72 @@ contains num_cells_ghost = partition%get_num_cells_ghost() @assertEqual( 0, num_cells_ghost ) + case (3) +! Testing over 3 partitions will produce uneven partitions, PE1 and PE2 will be +! the same (3x8), but PE0 will be slightly smaller (2x8) + +! Start with quantities that will be the same for all PEs + inner_depth = partition%get_inner_depth() + @assertEqual( 2, inner_depth ) + + halo_depth = partition%get_halo_depth() + @assertEqual( 2, halo_depth ) + + num_cells_halo = partition%get_num_cells_halo(1) + @assertEqual( 16, num_cells_halo ) + +! Now check quantities that differ between PE0 and PE1/2 + select case (local_rank) + case(0) + num_cells_in_layer = partition%get_num_cells_in_layer() + @assertEqual( 48, num_cells_in_layer ) + + num_cells_inner = partition%get_num_cells_inner(1) + @assertEqual( 0, num_cells_inner ) + + last_inner_cell = partition%get_last_inner_cell(1) + @assertEqual( 0, last_inner_cell ) + + num_cells_edge = partition%get_num_cells_edge() + @assertEqual( 16, num_cells_edge ) + + last_edge_cell = partition%get_last_edge_cell() + @assertEqual( 16, last_edge_cell ) + + last_halo_cell = partition%get_last_halo_cell(1) + @assertEqual( 32, last_halo_cell ) + + num_cells_ghost = partition%get_num_cells_ghost() + @assertEqual( 16, num_cells_ghost ) + case(1, 2) + num_cells_in_layer = partition%get_num_cells_in_layer() + @assertEqual( 56, num_cells_in_layer ) + + num_cells_inner = partition%get_num_cells_inner(1) + @assertEqual( 6, num_cells_inner ) + + last_inner_cell = partition%get_last_inner_cell(1) + @assertEqual( 6, last_inner_cell ) + + num_cells_edge = partition%get_num_cells_edge() + @assertEqual( 18, num_cells_edge ) + + last_edge_cell = partition%get_last_edge_cell() + @assertEqual( 24, last_edge_cell ) + + num_cells_halo = partition%get_num_cells_halo(1) + @assertEqual( 16, num_cells_halo ) + + last_halo_cell = partition%get_last_halo_cell(1) + @assertEqual( 40, last_halo_cell ) + + num_cells_ghost = partition%get_num_cells_ghost() + @assertEqual( 8, num_cells_ghost ) + end select + case (4) +! Testing over four similar (4x4) partitions + num_cells_in_layer = partition%get_num_cells_in_layer() @assertEqual( 64, num_cells_in_layer ) @@ -230,7 +301,7 @@ contains end subroutine test_partition_BiPeriodic - @Test(npes=[1, 4] ) + @Test(npes=[1, 3, 4] ) subroutine test_partition_planar( this ) implicit none @@ -274,6 +345,9 @@ contains case (1) xproc = 1 yproc = 1 + case (3) + xproc = 3 + yproc = 1 case (4) xproc = 2 yproc = 2 @@ -306,11 +380,12 @@ contains generate_inner_halos, & local_rank, & total_ranks ) - ! Test functionality of the partition object we've just created on both 1 + ! Test functionality of the partition object we've just created on 1, 3 ! and 4 processes select case (num_processes) case (1) +! Testing over 1 (8x8) partition - no halo/ghost cells num_cells_in_layer = partition%get_num_cells_in_layer() @assertEqual( 64, num_cells_in_layer ) @@ -341,7 +416,102 @@ contains num_cells_ghost = partition%get_num_cells_ghost() @assertEqual( 0, num_cells_ghost ) + case (3) +! Testing over 3 partitions will produce uneven partitions, PE1 and PE2 will be +! the same (3x8) (with different halos), but PE0 will be slightly smaller (2x8) + +! Start with quantities that will be the same for all PEs + inner_depth = partition%get_inner_depth() + @assertEqual( 2, inner_depth ) + + halo_depth = partition%get_halo_depth() + @assertEqual( 2, halo_depth ) + +! Now check quantities that differ between the partitions + select case (local_rank) + case(0) + num_cells_in_layer = partition%get_num_cells_in_layer() + @assertEqual( 32, num_cells_in_layer ) + + num_cells_inner = partition%get_num_cells_inner(1) + @assertEqual( 0, num_cells_inner ) + + last_inner_cell = partition%get_last_inner_cell(1) + @assertEqual( 0, last_inner_cell ) + + num_cells_edge = partition%get_num_cells_edge() + @assertEqual( 16, num_cells_edge ) + + last_edge_cell = partition%get_last_edge_cell() + @assertEqual( 16, last_edge_cell ) + + num_cells_halo = partition%get_num_cells_halo(1) + @assertEqual( 8, num_cells_halo ) + + last_halo_cell = partition%get_last_halo_cell(1) + @assertEqual( 24, last_halo_cell ) + + num_cells_ghost = partition%get_num_cells_ghost() + @assertEqual( 8, num_cells_ghost ) + case(1) + num_cells_in_layer = partition%get_num_cells_in_layer() + @assertEqual( 56, num_cells_in_layer ) + + num_cells_inner = partition%get_num_cells_inner(1) + @assertEqual( 6, num_cells_inner ) + + last_inner_cell = partition%get_last_inner_cell(1) + @assertEqual( 6, last_inner_cell ) + + num_cells_edge = partition%get_num_cells_edge() + @assertEqual( 18, num_cells_edge ) + + last_edge_cell = partition%get_last_edge_cell() + @assertEqual( 24, last_edge_cell ) + + num_cells_halo = partition%get_num_cells_halo(1) + @assertEqual( 16, num_cells_halo ) + + num_cells_halo = partition%get_num_cells_halo(1) + @assertEqual( 16, num_cells_halo ) + + last_halo_cell = partition%get_last_halo_cell(1) + @assertEqual( 40, last_halo_cell ) + + num_cells_ghost = partition%get_num_cells_ghost() + @assertEqual( 8, num_cells_ghost ) + case(2) + num_cells_in_layer = partition%get_num_cells_in_layer() + @assertEqual( 40, num_cells_in_layer ) + + num_cells_inner = partition%get_num_cells_inner(1) + @assertEqual( 6, num_cells_inner ) + + last_inner_cell = partition%get_last_inner_cell(1) + @assertEqual( 6, last_inner_cell ) + + num_cells_edge = partition%get_num_cells_edge() + @assertEqual( 18, num_cells_edge ) + + last_edge_cell = partition%get_last_edge_cell() + @assertEqual( 24, last_edge_cell ) + + num_cells_halo = partition%get_num_cells_halo(1) + @assertEqual( 8, num_cells_halo ) + + num_cells_halo = partition%get_num_cells_halo(1) + @assertEqual( 8, num_cells_halo ) + + last_halo_cell = partition%get_last_halo_cell(1) + @assertEqual( 32, last_halo_cell ) + + num_cells_ghost = partition%get_num_cells_ghost() + @assertEqual( 8, num_cells_ghost ) + end select + case (4) +! Testing over four similar (4x4) partitions + num_cells_in_layer = partition%get_num_cells_in_layer() @assertEqual( 36, num_cells_in_layer ) @@ -376,7 +546,7 @@ contains end subroutine test_partition_planar - @Test(npes=[1, 4] ) + @Test(npes=[1, 3, 4] ) subroutine test_partition_trench_x( this ) implicit none @@ -420,6 +590,9 @@ contains case (1) xproc = 1 yproc = 1 + case (3) + xproc = 3 + yproc = 1 case (4) xproc = 2 yproc = 2 @@ -452,11 +625,13 @@ contains generate_inner_halos, & local_rank, & total_ranks ) - ! Test functionality of the partition object we've just created on both 1 + ! Test functionality of the partition object we've just created on 1, 3 ! and 4 processes select case (num_processes) case (1) +! Testing over 1 (8x8) partition. All cells are owned - so no halo/ghost cells + num_cells_in_layer = partition%get_num_cells_in_layer() @assertEqual( 64, num_cells_in_layer ) @@ -487,7 +662,72 @@ contains num_cells_ghost = partition%get_num_cells_ghost() @assertEqual( 0, num_cells_ghost ) + case (3) +! Testing over 3 partitions will produce uneven partitions, PE1 and PE2 will be +! the same (3x8), but PE0 will be slightly smaller (2x8) + +! Start with quantities that will be the same for all PEs + inner_depth = partition%get_inner_depth() + @assertEqual( 2, inner_depth ) + + halo_depth = partition%get_halo_depth() + @assertEqual( 2, halo_depth ) + + num_cells_halo = partition%get_num_cells_halo(1) + @assertEqual( 16, num_cells_halo ) + +! Now check quantities that differ between PE0 and PE1/2 + select case (local_rank) + case(0) + num_cells_in_layer = partition%get_num_cells_in_layer() + @assertEqual( 48, num_cells_in_layer ) + + num_cells_inner = partition%get_num_cells_inner(1) + @assertEqual( 0, num_cells_inner ) + + last_inner_cell = partition%get_last_inner_cell(1) + @assertEqual( 0, last_inner_cell ) + + num_cells_edge = partition%get_num_cells_edge() + @assertEqual( 16, num_cells_edge ) + + last_edge_cell = partition%get_last_edge_cell() + @assertEqual( 16, last_edge_cell ) + + last_halo_cell = partition%get_last_halo_cell(1) + @assertEqual( 32, last_halo_cell ) + + num_cells_ghost = partition%get_num_cells_ghost() + @assertEqual( 16, num_cells_ghost ) + case(1, 2) + num_cells_in_layer = partition%get_num_cells_in_layer() + @assertEqual( 56, num_cells_in_layer ) + + num_cells_inner = partition%get_num_cells_inner(1) + @assertEqual( 6, num_cells_inner ) + + last_inner_cell = partition%get_last_inner_cell(1) + @assertEqual( 6, last_inner_cell ) + + num_cells_edge = partition%get_num_cells_edge() + @assertEqual( 18, num_cells_edge ) + + last_edge_cell = partition%get_last_edge_cell() + @assertEqual( 24, last_edge_cell ) + + num_cells_halo = partition%get_num_cells_halo(1) + @assertEqual( 16, num_cells_halo ) + + last_halo_cell = partition%get_last_halo_cell(1) + @assertEqual( 40, last_halo_cell ) + + num_cells_ghost = partition%get_num_cells_ghost() + @assertEqual( 8, num_cells_ghost ) + end select + case (4) +! Testing over four similar (4x4) partitions + num_cells_in_layer = partition%get_num_cells_in_layer() @assertEqual( 48, num_cells_in_layer ) @@ -566,6 +806,9 @@ contains case (1) xproc = 1 yproc = 1 + case (3) + xproc = 3 + yproc = 1 case (4) xproc = 2 yproc = 2 @@ -598,11 +841,13 @@ contains generate_inner_halos, & local_rank, & total_ranks ) - ! Test functionality of the partition object we've just created on both 1 + ! Test functionality of the partition object we've just created on 1, 3 ! and 4 processes select case (num_processes) case (1) +! Testing over 1 (8x8) partition - no halo/ghost cells + num_cells_in_layer = partition%get_num_cells_in_layer() @assertEqual( 64, num_cells_in_layer ) @@ -633,7 +878,102 @@ contains num_cells_ghost = partition%get_num_cells_ghost() @assertEqual( 0, num_cells_ghost ) + case (3) +! Testing over 3 partitions will produce uneven partitions, PE1 and PE2 will be +! the same (3x8) (with different halos), but PE0 will be slightly smaller (2x8) + +! Start with quantities that will be the same for all PEs + inner_depth = partition%get_inner_depth() + @assertEqual( 2, inner_depth ) + + halo_depth = partition%get_halo_depth() + @assertEqual( 2, halo_depth ) + +! Now check quantities that differ between the partitions + select case (local_rank) + case(0) + num_cells_in_layer = partition%get_num_cells_in_layer() + @assertEqual( 32, num_cells_in_layer ) + + num_cells_inner = partition%get_num_cells_inner(1) + @assertEqual( 0, num_cells_inner ) + + last_inner_cell = partition%get_last_inner_cell(1) + @assertEqual( 0, last_inner_cell ) + + num_cells_edge = partition%get_num_cells_edge() + @assertEqual( 16, num_cells_edge ) + + last_edge_cell = partition%get_last_edge_cell() + @assertEqual( 16, last_edge_cell ) + + num_cells_halo = partition%get_num_cells_halo(1) + @assertEqual( 8, num_cells_halo ) + + last_halo_cell = partition%get_last_halo_cell(1) + @assertEqual( 24, last_halo_cell ) + + num_cells_ghost = partition%get_num_cells_ghost() + @assertEqual( 8, num_cells_ghost ) + case(1) + num_cells_in_layer = partition%get_num_cells_in_layer() + @assertEqual( 56, num_cells_in_layer ) + + num_cells_inner = partition%get_num_cells_inner(1) + @assertEqual( 6, num_cells_inner ) + + last_inner_cell = partition%get_last_inner_cell(1) + @assertEqual( 6, last_inner_cell ) + + num_cells_edge = partition%get_num_cells_edge() + @assertEqual( 18, num_cells_edge ) + + last_edge_cell = partition%get_last_edge_cell() + @assertEqual( 24, last_edge_cell ) + + num_cells_halo = partition%get_num_cells_halo(1) + @assertEqual( 16, num_cells_halo ) + + num_cells_halo = partition%get_num_cells_halo(1) + @assertEqual( 16, num_cells_halo ) + + last_halo_cell = partition%get_last_halo_cell(1) + @assertEqual( 40, last_halo_cell ) + + num_cells_ghost = partition%get_num_cells_ghost() + @assertEqual( 8, num_cells_ghost ) + case(2) + num_cells_in_layer = partition%get_num_cells_in_layer() + @assertEqual( 40, num_cells_in_layer ) + + num_cells_inner = partition%get_num_cells_inner(1) + @assertEqual( 6, num_cells_inner ) + + last_inner_cell = partition%get_last_inner_cell(1) + @assertEqual( 6, last_inner_cell ) + + num_cells_edge = partition%get_num_cells_edge() + @assertEqual( 18, num_cells_edge ) + + last_edge_cell = partition%get_last_edge_cell() + @assertEqual( 24, last_edge_cell ) + + num_cells_halo = partition%get_num_cells_halo(1) + @assertEqual( 8, num_cells_halo ) + + num_cells_halo = partition%get_num_cells_halo(1) + @assertEqual( 8, num_cells_halo ) + + last_halo_cell = partition%get_last_halo_cell(1) + @assertEqual( 32, last_halo_cell ) + + num_cells_ghost = partition%get_num_cells_ghost() + @assertEqual( 8, num_cells_ghost ) + end select + case (4) +! Testing over four similar (4x4) partitions + num_cells_in_layer = partition%get_num_cells_in_layer() @assertEqual( 48, num_cells_in_layer ) @@ -671,7 +1011,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Test partition_cubedsphere_serial (on a single process) ! - @Test( npes=[1] ) + @Test( npes=[1,6] ) subroutine test_partition_CubedSphere( this ) implicit none @@ -714,6 +1054,7 @@ contains local_rank = this%getProcessRank() total_ranks = this%getNumProcesses() max_stencil_depth = 2 + decomposition = custom_decomposition_type(xproc, yproc) generate_inner_halos = .true. @@ -725,77 +1066,97 @@ contains call global_mesh_collection%add_new_global_mesh( global_mesh ) global_mesh_ptr => global_mesh_collection%get_global_mesh( global_mesh_id ) - partitioner_ptr => partitioner_cubedsphere_serial - decomposition = custom_decomposition_type(xproc, yproc) + ! Test functionality of the partition object we've just created on 1 + ! and 6 processes + select case (total_ranks) - partition = partition_type( global_mesh_ptr, & - partitioner_ptr, & - decomposition, & - max_stencil_depth, & - generate_inner_halos, & - local_rank, & - total_ranks ) - ! - ! Test functionality of the partition object we've just created - num_cells_in_layer = partition%get_num_cells_in_layer() - @assertEqual( 96, num_cells_in_layer ) + case (1) +! Testing over one (4x4x6) partition - no halo/ghost cells + + partitioner_ptr => partitioner_cubedsphere_serial + partition = partition_type( global_mesh_ptr, & + partitioner_ptr, & + decomposition, & + max_stencil_depth, & + generate_inner_halos, & + local_rank, & + total_ranks ) + + ! Test functionality of the single partition object we've just created + num_cells_in_layer = partition%get_num_cells_in_layer() + @assertEqual( 96, num_cells_in_layer ) - inner_depth = partition%get_inner_depth() - @assertEqual( 2, inner_depth ) + inner_depth = partition%get_inner_depth() + @assertEqual( 2, inner_depth ) - num_cells_inner = partition%get_num_cells_inner(2) - @assertEqual( 96, num_cells_inner ) + num_cells_inner = partition%get_num_cells_inner(2) + @assertEqual( 96, num_cells_inner ) - last_inner_cell = partition%get_last_inner_cell(1) - @assertEqual( 96, last_inner_cell ) + last_inner_cell = partition%get_last_inner_cell(1) + @assertEqual( 96, last_inner_cell ) - num_cells_edge = partition%get_num_cells_edge() - @assertEqual( 0, num_cells_edge ) + num_cells_edge = partition%get_num_cells_edge() + @assertEqual( 0, num_cells_edge ) - last_edge_cell = partition%get_last_edge_cell() - @assertEqual( 96, last_edge_cell ) + last_edge_cell = partition%get_last_edge_cell() + @assertEqual( 96, last_edge_cell ) + + halo_depth = partition%get_halo_depth() + @assertEqual( 2, halo_depth ) + + num_cells_halo = partition%get_num_cells_halo(1) + @assertEqual( 0, num_cells_halo ) - halo_depth = partition%get_halo_depth() - @assertEqual( 2, halo_depth ) + last_halo_cell = partition%get_last_halo_cell(1) + @assertEqual( 96, last_halo_cell ) - num_cells_halo = partition%get_num_cells_halo(1) - @assertEqual( 0, num_cells_halo ) + num_cells_ghost = partition%get_num_cells_ghost() + @assertEqual( 0, num_cells_ghost ) + case (6) +! Testing over six (4x4) partitions - one per face of the cubedsphere - last_halo_cell = partition%get_last_halo_cell(1) - @assertEqual( 96, last_halo_cell ) + partitioner_ptr => partitioner_cubedsphere + partition = partition_type( global_mesh_ptr, & + partitioner_ptr, & + decomposition, & + max_stencil_depth, & + generate_inner_halos, & + local_rank, & + total_ranks ) - num_cells_ghost = partition%get_num_cells_ghost() - @assertEqual( 0, num_cells_ghost ) + ! Test functionality of the partition objects we've just created + num_cells_in_layer = partition%get_num_cells_in_layer() + @assertEqual( 48, num_cells_in_layer ) + inner_depth = partition%get_inner_depth() + @assertEqual( 2, inner_depth ) - !> @todo Can't test a parallel cubed-sphere partition at this time, details - !> are described in ticket #1985. - ! - ! !---------------------------------------- - ! !Test partition_cubedsphere (in parallel) - ! !---------------------------------------- - ! xproc = 2 - ! yproc = 2 - ! local_rank = this%getProcessRank() - ! total_ranks = this%getNumProcesses() - ! max_stencil_depth = 2 - ! - ! filename = 'data/ugrid_quads_2d.nc' - ! global_mesh = global_mesh_type( filename ) - ! partitioner_ptr => partitioner_cubedsphere - ! - ! partition = partition_type( global_mesh, & - ! partitioner_ptr, & - ! xproc, & - ! yproc, & - ! max_stencil_depth, & - ! generate_inner_halos, & - ! local_rank, & - ! total_ranks ) - ! ! - ! ! Test functionality of the partition object we've just created - ! ... + num_cells_inner = partition%get_num_cells_inner(1) + @assertEqual( 4, num_cells_inner ) + + last_inner_cell = partition%get_last_inner_cell(1) + @assertEqual( 4, last_inner_cell ) + + num_cells_edge = partition%get_num_cells_edge() + @assertEqual( 12, num_cells_edge ) + + last_edge_cell = partition%get_last_edge_cell() + @assertEqual( 16, last_edge_cell ) + + halo_depth = partition%get_halo_depth() + @assertEqual( 2, halo_depth ) + + num_cells_halo = partition%get_num_cells_halo(1) + @assertEqual( 16, num_cells_halo ) + + last_halo_cell = partition%get_last_halo_cell(1) + @assertEqual( 32, last_halo_cell ) + + num_cells_ghost = partition%get_num_cells_ghost() + @assertEqual( 16, num_cells_ghost ) + + end select end subroutine test_partition_CubedSphere diff --git a/infrastructure/unit-test/utilities/halo_comms_mod_test.pf b/infrastructure/unit-test/utilities/halo_comms_mod_test.pf index 57f53a8d4..24aa6c5f2 100644 --- a/infrastructure/unit-test/utilities/halo_comms_mod_test.pf +++ b/infrastructure/unit-test/utilities/halo_comms_mod_test.pf @@ -16,6 +16,7 @@ module halo_comms_mod_test use halo_comms_mod, only : initialise_halo_comms, & finalise_halo_comms, & halo_routing_type, & + exchange_map_type, & halo_exchange_id_type, & perform_halo_exchange, & perform_halo_exchange_start, & @@ -36,7 +37,7 @@ module halo_comms_mod_test implicit none private - public :: test_halo_routing, test_halo_comms + public :: test_halo_routing, test_halo_comms, test_exchange_map ! ! pFUnit depends on symbol spill ! @@ -53,6 +54,7 @@ module halo_comms_mod_test procedure tearDown procedure get_local_mesh_ptr procedure test_halo_routing + procedure test_exchange_map procedure test_halo_comms end type halo_comms_test_type @@ -118,6 +120,91 @@ contains end function get_local_mesh_ptr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + @Test( npes=[1] ) + subroutine test_exchange_map( this ) + + implicit none + + class(halo_comms_test_type), intent(inout) :: this + + type(exchange_map_type) :: exchange_map + type(function_space_type), pointer :: function_space + integer(i_halo_index), allocatable :: global_dof_id(:) + integer(i_def), allocatable :: halo_start(:) + integer(i_def), allocatable :: halo_finish(:) + integer(i_def) :: idepth + integer(i_def) :: last_owned_dof + integer(i_def) :: ndata + integer(i_def) :: result + type(mesh_type), pointer :: mesh + + mesh => mesh_collection%get_mesh(this%mesh_id) + + ndata = 2 + + ! Get indices of owned and halo cells + function_space => function_space_collection%get_fs( mesh, & + 0, 0,& + W3, & + ndata = ndata ) + + last_owned_dof = function_space%get_last_dof_owned() + + ! Set up the global dof index array + call function_space%get_global_dof_id(global_dof_id) + + ! Set up the boundaries of the different depths of halo + allocate( halo_start(mesh%get_halo_depth()) ) + allocate( halo_finish(mesh%get_halo_depth()) ) + + do idepth = 1, mesh%get_halo_depth() + + halo_start(idepth) = function_space%get_last_dof_owned()+1 + halo_finish(idepth) = function_space%get_last_dof_halo(idepth) + ! If this is a serial run (no halos), halo_start will be out of + ! bounds, so re-initialise halo_start and halo_finish specifically + ! for a serial run + if ( halo_start(idepth) > function_space%get_last_dof_halo(idepth) ) then + halo_start(idepth) = function_space%get_last_dof_halo(idepth) + halo_finish(idepth) = halo_start(idepth) - 1 + end if + + end do + + ! Create a exchange map object with a particular mesh_id, element_order_h, + ! element_order_v, lfric_fs, ndata + exchange_map = exchange_map_type( global_dof_id, & + last_owned_dof, & + halo_start, & + halo_finish, & + this%mesh_id, & + 0, 0, & + W3, & + ndata, & + mesh%get_halo_depth() ) + + deallocate( halo_finish ) + deallocate( global_dof_id ) + + ! Test the getters on the exchange_map object return the correct values + result = exchange_map%get_exchange_map_mesh_id() + @assertEqual( this%mesh_id, result ) + + result = exchange_map%get_exchange_map_element_order_h() + @assertEqual( 0, result ) + + result = exchange_map%get_exchange_map_element_order_v() + @assertEqual( 0, result ) + + result = exchange_map%get_exchange_map_lfric_fs() + @assertEqual( W3, result ) + + result = exchange_map%get_exchange_map_ndata() + @assertEqual( 2, result ) + + mesh => null() + + end subroutine test_exchange_map @Test( npes=[1] ) subroutine test_halo_routing( this ) @@ -127,7 +214,7 @@ contains class(halo_comms_test_type), intent(inout) :: this type(halo_routing_type) :: halo_routing - type(function_space_type), pointer :: function_space => null() + type(function_space_type), pointer :: function_space integer(i_halo_index), allocatable :: global_dof_id(:) integer(i_def), allocatable :: halo_start(:) integer(i_def), allocatable :: halo_finish(:) @@ -135,7 +222,7 @@ contains integer(i_def) :: last_owned_dof integer(i_def) :: ndata integer(i_def) :: result - type(mesh_type), pointer :: mesh => null() + type(mesh_type), pointer :: mesh mesh => mesh_collection%get_mesh(this%mesh_id) diff --git a/mesh_tools/rose-meta/lfric-mesh_tools/version30_31.py b/mesh_tools/rose-meta/lfric-mesh_tools/version30_31.py new file mode 100644 index 000000000..6849d9a1d --- /dev/null +++ b/mesh_tools/rose-meta/lfric-mesh_tools/version30_31.py @@ -0,0 +1,43 @@ +import re +import sys + +from metomi.rose.upgrade import MacroUpgrade + +from .version22_30 import * + + +class UpgradeError(Exception): + """Exception created when an upgrade fails.""" + + def __init__(self, msg): + self.msg = msg + + def __repr__(self): + sys.tracebacklimit = 0 + return self.msg + + __str__ = __repr__ + + +""" +Copy this template and complete to add your macro +class vnXX_txxx(MacroUpgrade): + # Upgrade macro for by + BEFORE_TAG = "vnX.X" + AFTER_TAG = "vnX.X_txxx" + def upgrade(self, config, meta_config=None): + # Add settings + return config, self.reports +""" + + +class vn30_t306(MacroUpgrade): + """Upgrade macro for ticket TTTT by Unknown.""" + + BEFORE_TAG = "vn3.0" + AFTER_TAG = "vn3.1" + + def upgrade(self, config, meta_config=None): + # Commands From: rose-meta/lfric-mesh_tools + # Blank Upgrade Macro + return config, self.reports diff --git a/mesh_tools/rose-meta/lfric-mesh_tools/versions.py b/mesh_tools/rose-meta/lfric-mesh_tools/versions.py index 152c043d0..01798ad2b 100644 --- a/mesh_tools/rose-meta/lfric-mesh_tools/versions.py +++ b/mesh_tools/rose-meta/lfric-mesh_tools/versions.py @@ -1,8 +1,8 @@ import sys -from metomi.rose.upgrade import MacroUpgrade +from metomi.rose.upgrade import MacroUpgrade # noqa: F401 -from .version22_30 import * +from .version30_31 import * class UpgradeError(Exception): diff --git a/mesh_tools/rose-meta/lfric-mesh_tools/vn3.1/rose-meta.conf b/mesh_tools/rose-meta/lfric-mesh_tools/vn3.1/rose-meta.conf new file mode 100644 index 000000000..9f3b12dd5 --- /dev/null +++ b/mesh_tools/rose-meta/lfric-mesh_tools/vn3.1/rose-meta.conf @@ -0,0 +1,630 @@ +[env=mesh_generator] +compulsory=true +ns=namelist/mesh +sort-key=Panel-A01 +trigger=namelist:cubedsphere_mesh: Cubed-Sphere ; + =namelist:planar_mesh: Planar ; +values=Cubed-Sphere, Planar + +[namelist:cubedsphere_mesh] +compulsory=true +description=Cubed-Sphere mesh configuration +ns=namelist/mesh/cubed-sphere +sort-key=Section-A02 +title=Cubed-Sphere + +[namelist:cubedsphere_mesh=edge_cells] +!bounds=namelist:mesh=n_meshes +compulsory=true +description=Edge cells along mesh panel edge +fail-if=len(this) != len(namelist:mesh=mesh_names) ; +help=Number of cells on a panel edge, Cubed-Sphere is made + =up of 6 rectangular panels with equal numbers of cells + =on each panels edge. +!kind=default +length=: +range=1: +sort-key=Panel-A01 +type=integer + +[namelist:cubedsphere_mesh=equatorial_latitude] +compulsory=true +description=Latitude of the equator of the mesh, in degrees, following the + =Schmidt stretching transform +fail-if=this >= 90.0 + =this <= -90.0 +help=Applies the Schmidt transform, which stretches the mesh towards to North + =or South pole. This is described by the latitude that the equator is + =moved to. +!kind=default +range=-90.0:90.0 +sort-key=Panel-A04 +type=real + +[namelist:cubedsphere_mesh=smooth_passes] +compulsory=true +description=Number of smoothing iterations +fail-if=this < 0 +help=Smoothing is only applied the highest resolution mesh in a run configuration. +!kind=default +range=0: +sort-key=Panel-A02 +type=integer + +#==================================================== +# Mesh +#==================================================== +# Describes common mesh attributes for generation +# and triggers mesh specific namelists. +#==================================================== +[namelist:mesh] +title=Mesh + +[namelist:mesh=coord_sys] +compulsory=true +description=Mesh coodinate system +!enumeration=true +fail-if=namelist:mesh=geometry == "'spherical'" and this == "'xyz'" ; +help=Selects the coordinate system used to position mesh nodes. + = + = xyz: Uses cartesian x,y,z axes (m). + = ll: Uses spherical latitude, longitude (degrees). + = + =Currently unsupported option: + = xyz & spherical geometry +!kind=default +sort-key=Panel-B01 +trigger=namelist:mesh=rotate_mesh: this == "'ll'" ; +value-titles=XYZ, LL +values='xyz', 'll' + +[namelist:mesh=geometry] +compulsory=true +description=Geometry of mesh domain. +!enumeration=true +help=Will be used to specify the shape of the domain surface. + = + =++++++++++++++++++++++++++++++ + =At present, this is only used to trigger the rose-gui panels + =to select between the cubed-sphere (spherical) and LAM (Planar) + =meshes. + =++++++++++++++++++++++++++++++ + = + =It is anticipated that it will be used when the + =cubedsphere_mesh_generator and planar_mesh_generators are merged. + = +ns=namelist/mesh +sort-key=Panel-C01 +trigger=namelist:mesh=rotate_mesh: this == "'spherical'" ; +value-titles=Planar, Sphere +values='planar', 'spherical' + +[namelist:mesh=mesh_file_prefix] +compulsory=true +description=Output UGRID filename. +help=This file will contain all requested meshes/maps from the mesh generators. + =All meshes contained within the file will relate to the requested base class + =of mesh. +sort-key=Panel-A02 +!string_length=filename +type=character + +[namelist:mesh=mesh_maps] +!bounds=int(gamma( real(namelist:mesh=n_meshes) )) +compulsory=true +description=Intergrid mesh mappings +!fail-if=len(namelist:mesh=mesh_names) < 2 and len(this) > 0 ; +help=This list defines mesh-mesh mappings that are to be + =included in the mesh UGRID file. + = + =Maps ares defined by individual list items in the form + = + = : + = + =which will produce a mesh map in each direction, A->B and B->A. + =All mesh names listed in map creation must have been requested + =for mesh generation, i.e. in the variable namelist:mesh=mesh_names + = +length=: +sort-key=Panel-F03 +!string_length=default +type=character + +[namelist:mesh=mesh_names] +!bounds=namelist:mesh=n_meshes +compulsory=true +description=Mesh topology name(s). +fail-if=len(this) < 1 ; + =len(this) != namelist:mesh=n_meshes ; +help=These mesh names are used as variable names to identify + =meshes in UGRID conformant, NetCDF output file. + = + =The length of this list should match the number of meshes + =requested (namelist:mesh=n_meshes). +length=: +sort-key=Panel-F02 +!string_length=default +trigger=namelist:mesh=mesh_maps: len(this) > 1 ; +type=character + +[namelist:mesh=n_meshes] +compulsory=true +description=Number of meshes to generate. +fail-if=this < 1 +help=Specifies number of meshes to create. +!kind=default +range=1: +sort-key=Panel-F01 +trigger=namelist:mesh=mesh_maps: this > 1 ; +type=integer + +[namelist:mesh=partition_mesh] +compulsory=true +description=Create partitioned meshes. +help=Meshes are partitioned and written to file with the required local mesh object information. + =These can be read directly to populate a local mesh object and remove the need to partition + =the mesh at runtime, i.e. allows for the use of prepartitioned meshes. +!kind=default +sort-key=Panel-A03 +trigger=namelist:partitions: .true. ; +type=logical + +[namelist:mesh=rotate_mesh] +compulsory=true +description=Perform rotated pole transformations. +help=Enables options for rotating the base mesh generation strategy. + =This is done in two stages using the North pole location as a + =reference. + = + = 1. The mesh is rotated about the reference pole. This is to allow for + = meshes which are not symmetrical about the pole axis, e.g. Cubesphere + = 2. The reference pole is rotated to a new pole location while maintaining + = the mesh position relative to the reference pole. + = +sort-key=Panel-D01 +trigger=namelist:rotation: .true. ; +type=logical + +[namelist:mesh=topology] +compulsory=true +description=Describes connectivity of mesh domain. +!enumeration=true +fail-if=this == "'channel'" and (namelist:planar_mesh=periodic_x == ".true." and namelist:planar_mesh=periodic_y == ".true.") ; + =this == "'channel'" and (namelist:planar_mesh=periodic_x == ".false." and namelist:planar_mesh=periodic_y == ".false.") ; +help= + = +ns=namelist/mesh +sort-key=Panel-C01 +value-titles=Non Periodic, Channel, Periodic +values='non_periodic', 'channel', 'periodic' + +#============================================================================== +# GLOBAL MESH PARTITIONING +#============================================================================== +[namelist:partitions] +compulsory=true +description=Global mesh partitioning. +help=For parallel computing, the 2D global mesh is divided up into partitions. + =Each process rank runs an instance of the model on one partition. The + =partition decompostion is specified on a `per panel` basis. + =i.e. The cubedsphere has six panels; the planar mesh has one panel. +ns=namelist/mesh/partitions +sort-key=Section-A05 +title=Partitions + +[namelist:partitions=generate_inner_halos] +compulsory=true +description=Generate inner halo regions +help=In order to overlap comms & compute, the owned cells are reordered + =so that they consist of a number of layers of inner halos. These owned + =cells correspond to the halo cells on neighbouring MPI regions. +sort-key=Panel-A05 +type=logical + +[namelist:partitions=max_stencil_depth] +compulsory=true +description=Stencil depth [cells] +fail-if=this < 1 ; +help=Max extent of stencil in cells from the looping cell +!kind=default +range=1: +sort-key=Panel-A05 +type=integer + +[namelist:partitions=n_partitions] +compulsory=true +description=Number of partitions/meshes to create. +fail-if=this < 1 ; +help=The number of local meshes (partitions) to split global mesh into. + =This is NOT the same as the partition range to process. +range=1: +sort-key=Panel-A01 +type=integer + +[namelist:partitions=panel_decomposition] +compulsory=true +description=Panel partition decomposition +!enumeration=true +help=Partitioner will attempt to generate partitioned panels based + =on the given enumeration choices: + = + = * auto: Decompose domain as close to square decompositions. + = * row: Single row of partitions. + = * column: Single column of partitions. + = * custom: x/y decompositions explicitly requested using + = namelist:partitions=panel_xproc, + = namelist:partitions=panel_yproc. + = * auto_nonuniform: As auto but allow columns of partitions + = of differing heights. + = * guided_nonuniform: Partition into columns according to + = namelist:partitions=panel_xproc but of different heights + = +!kind=default +sort-key=Panel-A02 +trigger=namelist:partitions=panel_xproc: this == "'custom'" or this == "'guided_nonuniform'" ; + =namelist:partitions=panel_yproc: this == "'custom'" ; +value-titles=Auto, Single row, Single column, Custom, Auto nonuniform, Guided nonuniform +values='auto', 'row', 'column', 'custom', 'auto_nonuniform', 'guided_nonuniform' + +[namelist:partitions=panel_xproc] +compulsory=true +description=Panel partitions in x-direction. +fail-if=this < 1 ; +help=Number of partitions to generate across the x-direction of a mesh panel. +!kind=default +range=1: +sort-key=Panel-A03 +type=integer + +[namelist:partitions=panel_yproc] +compulsory=true +description=Panel partitions in y-direction. +fail-if=this < 1 ; +help=Number of partitions to generate across the y-direction of a mesh panel. +!kind=default +range=1: +sort-key=Panel-A04 +type=integer + +[namelist:partitions=partition_range] +compulsory=true +description=Specified range of partitions to output. +fail-if=this(1) < 0 ; + =this(2) < 0 ; + =this(1) >= namelist:partitions=n_partitions ; + =this(2) >= namelist:partitions=n_partitions ; + =this(1) > this(2) ; +help=This variable specifies the [lower bound, upper bound] of + =the range of consecutive partition IDs to be output to file. + =The bounds are given as partition IDs which range from 0 to + =n_partitions-1. + = + =E.g. partition_range=[1,3] would produce local mesh + = partition IDs 0 to 2, each in their own mesh file. +length=2 +range=0: +sort-key=Panel-A05 +type=integer + +#==================================================== +# Planar Mesh +#==================================================== +# Describes mesh attributes specific to the +# planar mesh. +#==================================================== +[namelist:planar_mesh] +compulsory=true +description=Planar mesh configuration +ns=namelist/mesh/planar +sort-key=Section-A03 +title=Planar + +[namelist:planar_mesh=apply_stretch_transform] +compulsory=true +description=Apply stretched grid transformation. +help=Enables using a larger cell spacing in the outer region of the domain, + =compared to the inner region. +!kind=default +sort-key=Panel-D01 +trigger=namelist:stretch_transform: .true.; +type=logical + +[namelist:planar_mesh=create_lbc_mesh] +compulsory=true +description=Create LBC mesh +help=Enables options for a Lateral Boundary Condition(LBC) mesh to be created + =The LBC mesh locates driver model data around the LAM domain boundaries + =for a specified depth in cells. +!kind=default +sort-key=Panel-A13 +trigger=namelist:planar_mesh=lbc_parent_mesh: .true. ; + =namelist:planar_mesh=lbc_rim_depth: .true. ; +type=logical + +[namelist:planar_mesh=domain_centre] +compulsory=true +description=Co-ordinates of domain centre [x-axis,y-axis]. +fail-if=namelist:mesh=coord_sys == 'll' and this(1) < -180.0 ; + =namelist:mesh=coord_sys == 'll' and this(1) > 180.0 ; + =namelist:mesh=coord_sys == 'll' and this(2) < -90.0 ; + =namelist:mesh=coord_sys == 'll' and this(2) > 90.0 ; +help=Domain centre coordinates + = + = For spherical coordinates + =---------------------------- + =Values are taken as [longitude,latitude], positive as + =degrees east, degrees_west respectively. + = + = Co-ordinate ranges are: + = + = longitude: -180.0 : 180.0 + = latitude: -90.0 : 90.0 + = + =Cordinates are taken on as being on a unrotated frame of reference. + = + = For cartesian coordinates + =---------------------------- + = Values are taken as [m,m], positive in x/y directions. + = +!kind=default +length=2 +sort-key=Panel-A01 +type=real + +[namelist:planar_mesh=domain_size] +compulsory=true +description=Domain size,[x-axis,y-axis] +fail-if=this <= 0.0 +help=Grid domain size of mesh in [x-axis,y-axis]. + =Units of values are dependant on choice of coordinate system + = * Spherical: [longitude, latitiude] in degrees. + = * Cartesian: [m] along x/y-axes +!kind=default +length=2 +range=0.0: +sort-key=Panel-A02 +type=real + +[namelist:planar_mesh=edge_cells_x] +compulsory=true +description=Number of edges cells (x-axis). +fail-if=this < 2 and namelist:planar_mesh=periodic_x == ".true." ; + =this < 1 ; + =len(this) != len(namelist:mesh=mesh_names) ; +help=Number of edges cells are specified as a list of integers, one for each mesh requested. + =The ordering corresponds to the order of the meshes listed in namelist:mesh=mesh_names. + = + =The minimum number of edge cells on the x-axis for meshes which are periodic in + =the x direction (namelist:planar_mesh=periodic_x) is 2. This restriction is a limitation of + =the science code. +!kind=default +length=: +range=1: +sort-key=Panel-A05 +type=integer + +[namelist:planar_mesh=edge_cells_y] +compulsory=true +description=Number of edges cells (y-axis). +fail-if=this < 2 and namelist:planar_mesh=periodic_y == ".true." ; + =this < 1 ; + =len(this) != len(namelist:mesh=mesh_names) ; +help=Number of edges cells are specified as a list of integers, one for each mesh requested. + =The ordering corresponds to the order of the meshes listed in namelist:mesh=mesh_names. + = + =The minimum number of edge cells on the y-axis for meshes which are periodic in + =the y direction (namelist:planar_mesh=periodic_y) is 2. This restriction is a limitation of + =the science code. +!kind=default +length=: +range=1: +sort-key=Panel-A06 +type=integer + +[namelist:planar_mesh=lbc_parent_mesh] +compulsory=true +description=LBC parent LAM. +help=Specifies the name of the LAM mesh to base the + =LBC mesh upon. +!kind=default +sort-key=Panel-A14 +type=character + +[namelist:planar_mesh=lbc_rim_depth] +compulsory=true +description=Rim depth (cells). +fail-if=this < 1 ; +help=LBC mesh rim depth in cells. The rim depth should be + =less than half the minimum cell dimension of the parent + =LAM (namelist:planar_mesh=lbc_parent_mesh), otherwise + =there will be no inner domain. i.e. + = + = Rim depth < min(LAM n_xcells, LAM n_ycells)/2 + = +!kind=default +range=1: +sort-key=Panel-A15 +type=integer + +[namelist:planar_mesh=periodic_x] +compulsory=true +description=Periodic in x-axis +help=Specifies whether the topology of the mesh should be periodic in the x direction. + = + =A mesh which is periodic in the x-direction means that outflow across the domain's + =Eastern boundary would appear as inflow across the domain's Western boundary and + =vice versa. +!kind=default +sort-key=Panel-A09 +type=logical + +[namelist:planar_mesh=periodic_y] +compulsory=true +description=Periodic in y-axis +help=Specifies whether the topology of the mesh should be periodic in the y direction. + = + =A mesh which is periodic in the y-direction will mean that outflow across the domain's + =Northern boundary would appear as inflow across the domain's Southern boundary and + =vice versa. +!kind=default +sort-key=Panel-A10 +type=logical + +[namelist:rotation] +compulsory=true +ns=namelist/mesh/Rotation +sort-key=Section=A04 + +[namelist:rotation=rotation_target] +compulsory=true +description=Method used to specify the domain input. +!enumeration=true +help=LAM domains can be specified using the following input + = parameter sets: + = + = * north_pole: specify a target north pole for rotation. + = * null_island: specify a target null island for rotation. + = (i.e. the target location to position the + = intersection of the Prime Meridian and Equator) +!kind=default +sort-key=Panel-A02 +trigger=namelist:rotation=target_null_island: this == "'null_island'" ; + =namelist:rotation=target_north_pole: this == "'north_pole'" ; +value-titles=North pole, Null island +values='north_pole', 'null_island' + +[namelist:rotation=target_north_pole] +compulsory=true +description=Co-ordinates of target pole (degrees) +fail-if=namelist:rotation=target_north_pole(1) < -180.0 ; + =namelist:rotation=target_north_pole(1) > 180.0 ; + =namelist:rotation=target_north_pole(2) < -90.0 ; + =namelist:rotation=target_north_pole(2) > 90.0 ; +help=Target pole co-ordinates [longitude,latitude]. The mesh is transformed + =such that the reference pole (default: north pole) is relocated to the + =specified target pole co-ordinates. + = + =This is done such that the true North pole lies on longitude=0. + = + =Target pole co-ordinate ranges are: + = + = longitude: -180.0 : 180.0 + = latitude: -90.0 : 90.0 + = +!kind=default +length=2 +range=-180.0:180.0 +sort-key=Panel-A03 +type=real + +[namelist:rotation=target_null_island] +compulsory=true +description=Co-ordinates of target Null Island (degrees) +fail-if=namelist:rotation=target_null_island(1) < -180.0 ; + =namelist:rotation=target_null_island(1) > 180.0 ; + =namelist:rotation=target_null_island(2) < -90.0 ; + =namelist:rotation=target_null_island(2) > 90.0 ; +help=The Null Island is the intersection of the Prime Meridian and Equator on a given domain. + =The mesh is transformed such that an unrotated Null Island [0.0,0.0] is relocated to the + =specified target_null_island co-ordinates. + = + =This is done such that the true North pole lies on longitude=0. + = + =Target target_null_island co-ordinate ranges are: + = + = longitude: -180.0 : 180.0 + = latitude: -90.0 : 90.0 + = +!kind=default +length=2 +range=-180.0:180.0 +sort-key=Panel-A01 +type=real + +[namelist:stretch_transform] +compulsory=true +ns=namelist/mesh/stretch_transform +sort-key=Section=A04 + +[namelist:stretch_transform=cell_size_inner] +compulsory=true +description=Inner region cell size +fail-if=this(1) >= namelist:stretch_transform=cell_size_outer(1) ; + =this(2) >= namelist:stretch_transform=cell_size_outer(2) ; +help=[delta_x_inner, delta_y_inner] + =delta_x_inner needs to be smaller than delta_x_outer, and + =similarly for the y direction. + =Units are dependant on the coordinate system/geometry. +!kind=default +length=2 +range=0.0: +sort-key=Panel-A04 +type=real + +[namelist:stretch_transform=cell_size_outer] +compulsory=true +description=Outer region cell size +fail-if=this(1) < namelist:stretch_transform=cell_size_inner(1) ; + =this(2) < namelist:stretch_transform=cell_size_inner(2) ; +help=[delta_x_outer, delta_y_outer] + =delta_x_inner needs to be smaller than delta_x_outer, and + =similarly for the y direction. + =Units are dependant on the coordinate system/geometry. +!kind=default +length=2 +range=0.0: +sort-key=Panel-A04 +type=real + +[namelist:stretch_transform=n_cells_outer] +compulsory=true +description=Depth (in cells) of outer region +help=[n_outer_x, n_outer_y] + =This is the number of cells in an outer region + =near to a domain edge. i.e. There are + =2*n_cells_outer along the whole axis +!kind=default +length=2 +range=2: +sort-key=Panel-A04 +type=integer + +[namelist:stretch_transform=n_cells_stretch] +compulsory=true +description=Depth (in cells) of stretch region +help=[n_stretch_x, n_stretch_y] + =A stretch region is defined to be the + =cells in between the inner region and an + =outer region, and where the cell size is in + =between the inner and outer cell sizes. + =i.e. cell_size_outer > size > cell_size_inner + =and 2*n_cells_stretch along the whole axis +!kind=default +length=2 +range=0: +sort-key=Panel-A04 +type=integer + +[namelist:stretch_transform=stretching_on] +compulsory=true +description=Locations to map stretching function +!enumeration=true +help=lfric-cell-centres: The stretching function is mapped to the LFRic cell centres. + = cell-nodes: The stretching function is mapped to the LFRic cell nodes. + = p-points: The stretching function is mapped to a set of points such that the + = cell nodes are half way between these points. +!kind=default +sort-key=Panel-A04 +value-titles=cell-centres, cell-nodes, p-points +values='cell_centres','cell_nodes', 'p_points' + +[namelist:stretch_transform=transform_mesh] +compulsory=true +description=Mesh to apply transform to +help=Specifies the name of the main mesh to apply the transform to. + =Where inter-grid maps have been requested from the named mesh + =to coarser meshes, the coarse mesh nodes are updated to match + =the named mesh nodes. +!kind=default +sort-key=Panel-A04 +type=character diff --git a/mesh_tools/source/cubedsphere_mesh_generator.f90 b/mesh_tools/source/cubedsphere_mesh_generator.f90 index d67c2d32c..6447f856b 100644 --- a/mesh_tools/source/cubedsphere_mesh_generator.f90 +++ b/mesh_tools/source/cubedsphere_mesh_generator.f90 @@ -14,10 +14,11 @@ !----------------------------------------------------------------------------- program cubedsphere_mesh_generator - use cli_mod, only: get_initial_filename + use cli_mod, only: parse_command_line use constants_mod, only: i_def, l_def, r_def, str_def, & cmdi, imdi, emdi, str_max_filename - use configuration_mod, only: read_configuration, final_configuration + use config_loader_mod, only: read_configuration, final_configuration + use config_mod, only: config_type use coord_transform_mod, only: rebase_longitude_range use gencube_ps_mod, only: gencube_ps_type, & set_partition_parameters @@ -30,7 +31,6 @@ program cubedsphere_mesh_generator use halo_comms_mod, only: initialise_halo_comms, & finalise_halo_comms use io_utility_mod, only: open_file, close_file - use namelist_collection_mod, only: namelist_collection_type use lfric_mpi_mod, only: global_mpi, create_comm, & destroy_comm, lfric_comm_type use local_mesh_collection_mod, only: local_mesh_collection_type @@ -41,7 +41,6 @@ program cubedsphere_mesh_generator log_level_error, log_level_warning use namelist_collection_mod, only: namelist_collection_type - use namelist_mod, only: namelist_type use ncdf_quad_mod, only: ncdf_quad_type use omp_lib, only: omp_get_thread_num @@ -135,8 +134,8 @@ program cubedsphere_mesh_generator ! Counters. integer(i_def) :: i, j, k, l, n_voids + type(config_type), save :: config type(namelist_collection_type), save :: configuration - type(namelist_type), pointer :: nml_obj ! Configuration variables to obtain from configuration. character(str_max_filename) :: mesh_file_prefix @@ -170,7 +169,11 @@ program cubedsphere_mesh_generator character(9), parameter :: timer_file = 'timer.txt' nullify(partitioner_ptr) - nullify(nml_obj) + + !=================================================================== + ! Read in the control namelists from file. + !=================================================================== + call parse_command_line( filename ) !=================================================================== ! Set the logging level for the run, should really be able @@ -191,48 +194,40 @@ program cubedsphere_mesh_generator local_rank = global_mpi%get_comm_rank() call initialise_logging( communicator%get_comm_mpi_val(), 'CubeGen' ) - !=================================================================== - ! Read in the control namelists from file. - !=================================================================== - call get_initial_filename( filename ) call configuration%initialise( 'CubeGen', table_len=10 ) - call read_configuration( filename, configuration ) + call config%initialise( 'CubeGen' ) + + call read_configuration( filename, & + configuration=configuration, & + config=config ) deallocate( filename ) - if (configuration%namelist_exists('mesh')) then - nml_obj => configuration%get_namelist('mesh') - call nml_obj%get_value( 'mesh_file_prefix', mesh_file_prefix ) - call nml_obj%get_value( 'n_meshes', n_meshes ) - call nml_obj%get_value( 'mesh_names', mesh_names ) - call nml_obj%get_value( 'mesh_maps', mesh_maps ) - call nml_obj%get_value( 'partition_mesh', partition_mesh ) - call nml_obj%get_value( 'rotate_mesh', rotate_mesh ) - call nml_obj%get_value( 'coord_sys', coord_sys ) - call nml_obj%get_value( 'topology', topology ) - call nml_obj%get_value( 'geometry', geometry ) - end if + mesh_file_prefix = config%mesh%mesh_file_prefix() + n_meshes = config%mesh%n_meshes() + mesh_names = config%mesh%mesh_names() + mesh_maps = config%mesh%mesh_maps() + partition_mesh = config%mesh%partition_mesh() + rotate_mesh = config%mesh%rotate_mesh() + coord_sys = config%mesh%coord_sys() + topology = config%mesh%topology() + geometry = config%mesh%geometry() - if (configuration%namelist_exists('partitions')) then - nml_obj => configuration%get_namelist('partitions') - call nml_obj%get_value( 'max_stencil_depth', max_stencil_depth ) - call nml_obj%get_value( 'n_partitions', n_partitions ) - call nml_obj%get_value( 'partition_range', partition_range ) - call nml_obj%get_value( 'generate_inner_halos', generate_inner_halos ) - end if + edge_cells = config%cubedsphere_mesh%edge_cells() + smooth_passes = config%cubedsphere_mesh%smooth_passes() + equatorial_latitude = config%cubedsphere_mesh%equatorial_latitude() - if (configuration%namelist_exists('rotation')) then - nml_obj => configuration%get_namelist('rotation') - call nml_obj%get_value( 'rotation_target', rotation_target ) - call nml_obj%get_value( 'target_north_pole', target_north_pole ) - call nml_obj%get_value( 'target_null_island', target_null_island ) + if (partition_mesh) then + max_stencil_depth = config%partitions%max_stencil_depth() + n_partitions = config%partitions%n_partitions() + partition_range = config%partitions%partition_range() + generate_inner_halos = config%partitions%generate_inner_halos() end if - if (configuration%namelist_exists('cubedsphere_mesh')) then - nml_obj => configuration%get_namelist('cubedsphere_mesh') - call nml_obj%get_value( 'edge_cells', edge_cells ) - call nml_obj%get_value( 'smooth_passes', smooth_passes ) - call nml_obj%get_value( 'equatorial_latitude', equatorial_latitude ) + if (rotate_mesh) then + rotation_target = config%rotation%rotation_target() + target_north_pole = config%rotation%target_north_pole() + target_null_island = config%rotation%target_null_island() end if call init_timer(timer_file) diff --git a/mesh_tools/source/planar_mesh_generator.f90 b/mesh_tools/source/planar_mesh_generator.f90 index 93e6a16b8..6ac208821 100644 --- a/mesh_tools/source/planar_mesh_generator.f90 +++ b/mesh_tools/source/planar_mesh_generator.f90 @@ -15,10 +15,11 @@ !----------------------------------------------------------------------------- program planar_mesh_generator - use cli_mod, only: get_initial_filename + use cli_mod, only: parse_command_line use constants_mod, only: i_def, l_def, r_def, str_def, & cmdi, imdi, emdi, str_max_filename - use configuration_mod, only: read_configuration, final_configuration + use config_loader_mod, only: read_configuration, final_configuration + use config_mod, only: config_type use coord_transform_mod, only: rebase_longitude_range use gen_lbc_mod, only: gen_lbc_type use gen_planar_mod, only: gen_planar_type, & @@ -41,8 +42,6 @@ program planar_mesh_generator LOG_LEVEL_ERROR use namelist_collection_mod, only: namelist_collection_type - use namelist_mod, only: namelist_type - use ncdf_quad_mod, only: ncdf_quad_type use omp_lib, only: omp_get_thread_num use partition_mod, only: partition_type, partitioner_interface @@ -138,8 +137,8 @@ program planar_mesh_generator integer(i_def) :: i, j, k, l, n_voids ! Configuration variables - type(namelist_collection_type) :: configuration - type(namelist_type), pointer :: nml_obj + type(config_type), save :: config + type(namelist_collection_type), save :: configuration character(str_max_filename) :: mesh_file_prefix @@ -185,7 +184,11 @@ program planar_mesh_generator character(9), parameter :: timer_file = 'timer.txt' nullify(partitioner_ptr) - nullify(nml_obj) + + !=================================================================== + ! Read in the control namelists from file. + !=================================================================== + call parse_command_line( filename ) !=================================================================== ! Set the logging level for the run, should really be able @@ -208,61 +211,53 @@ program planar_mesh_generator local_rank = global_mpi%get_comm_rank() call initialise_logging( communicator%get_comm_mpi_val(), "PlanarGen" ) - - !=================================================================== - ! Read in the control namelists from file. - !=================================================================== - call get_initial_filename( filename ) call configuration%initialise( 'PlanarGen', table_len=10 ) - call read_configuration( filename, configuration ) + call config%initialise( 'PlanarGen' ) + + call read_configuration( filename, & + configuration=configuration, & + config=config ) deallocate( filename ) - if (configuration%namelist_exists('mesh')) then - nml_obj => configuration%get_namelist('mesh') - call nml_obj%get_value( 'mesh_file_prefix', mesh_file_prefix ) - call nml_obj%get_value( 'n_meshes', n_meshes ) - call nml_obj%get_value( 'mesh_names', mesh_names ) - call nml_obj%get_value( 'mesh_maps', mesh_maps ) - call nml_obj%get_value( 'partition_mesh', partition_mesh ) - call nml_obj%get_value( 'rotate_mesh', rotate_mesh ) - call nml_obj%get_value( 'coord_sys', coord_sys ) - call nml_obj%get_value( 'topology', topology ) - call nml_obj%get_value( 'geometry', geometry ) - end if - if (configuration%namelist_exists('partitions')) then - nml_obj => configuration%get_namelist('partitions') - call nml_obj%get_value( 'max_stencil_depth', max_stencil_depth ) - call nml_obj%get_value( 'n_partitions', n_partitions ) - call nml_obj%get_value( 'partition_range', partition_range ) - call nml_obj%get_value( 'partition_range', partition_range ) - call nml_obj%get_value( 'generate_inner_halos', generate_inner_halos ) - end if + mesh_file_prefix = config%mesh%mesh_file_prefix() + + n_meshes = config%mesh%n_meshes() + mesh_names = config%mesh%mesh_names() + mesh_maps = config%mesh%mesh_maps() + partition_mesh = config%mesh%partition_mesh() + rotate_mesh = config%mesh%rotate_mesh() + coord_sys = config%mesh%coord_sys() + topology = config%mesh%topology() + geometry = config%mesh%geometry() + + edge_cells_x = config%planar_mesh%edge_cells_x() + edge_cells_y = config%planar_mesh%edge_cells_y() + periodic_x = config%planar_mesh%periodic_x() + periodic_y = config%planar_mesh%periodic_y() + domain_size = config%planar_mesh%domain_size() + domain_centre = config%planar_mesh%domain_centre() + create_lbc_mesh = config%planar_mesh%create_lbc_mesh() + lbc_rim_depth = config%planar_mesh%lbc_rim_depth() + lbc_parent_mesh = config%planar_mesh%lbc_parent_mesh() + + apply_stretch_transform = config%planar_mesh%apply_stretch_transform() - if (configuration%namelist_exists('rotation')) then - nml_obj => configuration%get_namelist('rotation') - call nml_obj%get_value( 'rotation_target', rotation_target ) - call nml_obj%get_value( 'target_north_pole', target_north_pole ) - call nml_obj%get_value( 'target_null_island', target_null_island ) + if (partition_mesh) then + max_stencil_depth = config%partitions%max_stencil_depth() + n_partitions = config%partitions%n_partitions() + partition_range = config%partitions%partition_range() + generate_inner_halos = config%partitions%generate_inner_halos() end if - if (configuration%namelist_exists('planar_mesh')) then - nml_obj => configuration%get_namelist('planar_mesh') - call nml_obj%get_value( 'edge_cells_x', edge_cells_x ) - call nml_obj%get_value( 'edge_cells_y', edge_cells_y ) - call nml_obj%get_value( 'periodic_x', periodic_x ) - call nml_obj%get_value( 'periodic_y', periodic_y ) - call nml_obj%get_value( 'domain_size', domain_size ) - call nml_obj%get_value( 'domain_centre', domain_centre ) - call nml_obj%get_value( 'create_lbc_mesh', create_lbc_mesh ) - call nml_obj%get_value( 'lbc_rim_depth', lbc_rim_depth ) - call nml_obj%get_value( 'lbc_parent_mesh', lbc_parent_mesh ) - call nml_obj%get_value( 'apply_stretch_transform', apply_stretch_transform ) + if (rotate_mesh) then + rotation_target = config%rotation%rotation_target() + target_north_pole = config%rotation%target_north_pole() + target_null_island = config%rotation%target_null_island() end if - if (configuration%namelist_exists('stretch_transform')) then - nml_obj => configuration%get_namelist('stretch_transform') - call nml_obj%get_value( 'transform_mesh', transform_mesh ) + if (apply_stretch_transform) then + transform_mesh = config%stretch_transform%transform_mesh() end if call init_timer(timer_file) diff --git a/mesh_tools/source/summarise_ugrid.f90 b/mesh_tools/source/summarise_ugrid.f90 index fc2a0f1ee..9ae71b3cd 100644 --- a/mesh_tools/source/summarise_ugrid.f90 +++ b/mesh_tools/source/summarise_ugrid.f90 @@ -16,7 +16,7 @@ program summarise_ugrid use, intrinsic :: iso_fortran_env, only : output_unit - use cli_mod, only : get_initial_filename + use cli_mod, only : parse_command_line use constants_mod, only : i_def, r_def, str_def, str_long, str_longlong, & l_def use lfric_mpi_mod, only : global_mpi, create_comm, destroy_comm, & @@ -63,6 +63,8 @@ program summarise_ugrid integer(i_def) :: total_ranks, local_rank, nmaps type(lfric_comm_type) :: comm + ! Get filename from command line + call parse_command_line( filename, description='UGRID mesh file' ) ! Start up call create_comm(comm) @@ -71,9 +73,6 @@ program summarise_ugrid local_rank = global_mpi%get_comm_rank() call initialise_logging( comm%get_comm_mpi_val(), "summarise" ) - ! Get filename from command line - call get_initial_filename( filename, description='UGRID mesh file' ) - ! Create object to manipulate UGRID conforming NetCDF file allocate(ncdf_quad_type::ugrid_file) call infile%set_file_handler(ugrid_file) diff --git a/mesh_tools/source/support/gencube_ps_mod.F90 b/mesh_tools/source/support/gencube_ps_mod.F90 index b1bb088f1..3620b38ca 100644 --- a/mesh_tools/source/support/gencube_ps_mod.F90 +++ b/mesh_tools/source/support/gencube_ps_mod.F90 @@ -2050,9 +2050,28 @@ subroutine set_partition_parameters( decomposition, partitioner_ptr ) call log_event( "Using parallel cubed sphere partitioner", & LOG_LEVEL_INFO ) + else if( NPANELS == 6 .and. & + (mod(n_partitions, 3) == 0) .or. & + (mod(n_partitions, 2) == 0 ) ) then + ! Use the parallel cubed-sphere partitioner + partitioner_ptr => partitioner_cubedsphere + + select case(panel_decomposition) + case( panel_decomposition_custom ) + decomposition = custom_decomposition_type( panel_xproc, panel_yproc ) + case default + call log_event( "Decomposing across 2 or 3 panels requires "// & + "'custom' decomposition.", LOG_LEVEL_ERROR ) + end select + + call log_event( "Using parallel cubed sphere partitioner", & + LOG_LEVEL_INFO ) + else - call log_event( "Number of partitions must be 1 "// & - "or a multiple of the number of panels", & + call log_event( "Number of partitions must be 1 "// & + "or a multiple of the number of panels "// & + "or a multiple of 2 or 3 for 6 panels "// & + "and using 'custom' decomposition", & LOG_LEVEL_ERROR ) end if diff --git a/rose-stem/app/coupled/file/iodef.xml b/rose-stem/app/coupled/file/iodef.xml index a223c9ebc..76b7fa544 100644 --- a/rose-stem/app/coupled/file/iodef.xml +++ b/rose-stem/app/coupled/file/iodef.xml @@ -59,7 +59,7 @@ performance - 1.0 + 1.0 diff --git a/rose-stem/app/coupled/rose-app.conf b/rose-stem/app/coupled/rose-app.conf index 1b7910b57..38b1839b6 100644 --- a/rose-stem/app/coupled/rose-app.conf +++ b/rose-stem/app/coupled/rose-app.conf @@ -1,4 +1,4 @@ -meta=lfric-coupled/vn3.0 +meta=lfric-coupled/vn3.1 [command] default=rose app-run -C $CYLC_WORKFLOW_RUN_DIR/app/coupled -O lam -O LAM50x50-2x2 --install-only diff --git a/rose-stem/app/io_demo/file/iodef.xml b/rose-stem/app/io_demo/file/iodef.xml index f944d70c8..19a6dc5d2 100644 --- a/rose-stem/app/io_demo/file/iodef.xml +++ b/rose-stem/app/io_demo/file/iodef.xml @@ -25,7 +25,7 @@ performance - 1.0 + 1.0 diff --git a/rose-stem/app/io_demo/rose-app.conf b/rose-stem/app/io_demo/rose-app.conf index e92bdb229..27248bb13 100644 --- a/rose-stem/app/io_demo/rose-app.conf +++ b/rose-stem/app/io_demo/rose-app.conf @@ -1,4 +1,4 @@ -meta=lfric-io_demo/vn3.0 +meta=lfric-io_demo/vn3.1 [command] default=$CORE_ROOT_DIR/bin/tweak_iodef ; \ @@ -64,7 +64,7 @@ file_convention='UGRID' multifile_io=.false. !!nodal_output_on_w3=.false. subroutine_counters=.false. -subroutine_timers=.false. +subroutine_timers=.true. timer_output_path='timer.txt' use_xios_io=.true. write_diag=.false. diff --git a/rose-stem/app/lbc_demo/file/iodef.xml b/rose-stem/app/lbc_demo/file/iodef.xml index 2c60bbd11..05f272079 100644 --- a/rose-stem/app/lbc_demo/file/iodef.xml +++ b/rose-stem/app/lbc_demo/file/iodef.xml @@ -47,7 +47,7 @@ performance - 1.0 + 1.0 diff --git a/rose-stem/app/mesh/rose-app.conf b/rose-stem/app/mesh/rose-app.conf index 1653ef41b..dbbcbc865 100644 --- a/rose-stem/app/mesh/rose-app.conf +++ b/rose-stem/app/mesh/rose-app.conf @@ -1,4 +1,4 @@ -meta=lfric-mesh_tools/vn3.0 +meta=lfric-mesh_tools/vn3.1 [command] default=echo "There is no default mesh generator, please specify an optional configuration"; false diff --git a/rose-stem/app/mesh_tools/opt/rose-app-cubedsphere-op-2panels.conf b/rose-stem/app/mesh_tools/opt/rose-app-cubedsphere-op-2panels.conf new file mode 100644 index 000000000..b9fa6b5b1 --- /dev/null +++ b/rose-stem/app/mesh_tools/opt/rose-app-cubedsphere-op-2panels.conf @@ -0,0 +1,22 @@ +[env] +mesh_generator=Cubed-Sphere + +[namelist:cubedsphere_mesh] +edge_cells=6,3 + +[namelist:mesh] +coord_sys='ll' +geometry='spherical' +mesh_maps='C6:C3' +mesh_names='C6','C3' +partition_mesh=.true. +rotate_mesh=.false. + +[namelist:partitions] +n_partitions=2 +panel_decomposition='custom' +panel_xproc=1 +panel_yproc=1 +partition_range=0,1 + +[!!namelist:planar_mesh] diff --git a/rose-stem/app/mesh_tools/opt/rose-app-cubedsphere-op-3panels.conf b/rose-stem/app/mesh_tools/opt/rose-app-cubedsphere-op-3panels.conf new file mode 100644 index 000000000..e7ddad949 --- /dev/null +++ b/rose-stem/app/mesh_tools/opt/rose-app-cubedsphere-op-3panels.conf @@ -0,0 +1,22 @@ +[env] +mesh_generator=Cubed-Sphere + +[namelist:cubedsphere_mesh] +edge_cells=6,3 + +[namelist:mesh] +coord_sys='ll' +geometry='spherical' +mesh_maps='C6:C3' +mesh_names='C6','C3' +partition_mesh=.true. +rotate_mesh=.false. + +[namelist:partitions] +n_partitions=3 +panel_decomposition='custom' +panel_xproc=1 +panel_yproc=1 +partition_range=0,2 + +[!!namelist:planar_mesh] diff --git a/rose-stem/app/mesh_tools/rose-app.conf b/rose-stem/app/mesh_tools/rose-app.conf index 9c4dcec46..8a3ed2e72 100644 --- a/rose-stem/app/mesh_tools/rose-app.conf +++ b/rose-stem/app/mesh_tools/rose-app.conf @@ -1,4 +1,4 @@ -meta=lfric-mesh_tools/vn3.0 +meta=lfric-mesh_tools/vn3.1 [command] default=${BIN_DIR}/${APPLICATION} mesh_generation.nml diff --git a/rose-stem/app/simple_diffusion/file/iodef.xml b/rose-stem/app/simple_diffusion/file/iodef.xml index e616648cd..436ac43e7 100644 --- a/rose-stem/app/simple_diffusion/file/iodef.xml +++ b/rose-stem/app/simple_diffusion/file/iodef.xml @@ -25,7 +25,7 @@ performance - 1.0 + 1.0 diff --git a/rose-stem/app/simple_diffusion/rose-app.conf b/rose-stem/app/simple_diffusion/rose-app.conf index d7c6320ff..f710dfe34 100644 --- a/rose-stem/app/simple_diffusion/rose-app.conf +++ b/rose-stem/app/simple_diffusion/rose-app.conf @@ -1,4 +1,4 @@ -meta=lfric-simple_diffusion/vn3.0 +meta=lfric-simple_diffusion/vn3.1 [command] default=$CORE_ROOT_DIR/bin/tweak_iodef ; \ diff --git a/rose-stem/app/skeleton/file/iodef.xml b/rose-stem/app/skeleton/file/iodef.xml index 6ed58c278..ecbeb5424 100644 --- a/rose-stem/app/skeleton/file/iodef.xml +++ b/rose-stem/app/skeleton/file/iodef.xml @@ -59,7 +59,7 @@ performance - 1.0 + 1.0 diff --git a/rose-stem/app/skeleton/rose-app.conf b/rose-stem/app/skeleton/rose-app.conf index e7b3a52e4..7e966d0b7 100644 --- a/rose-stem/app/skeleton/rose-app.conf +++ b/rose-stem/app/skeleton/rose-app.conf @@ -1,4 +1,4 @@ -meta=lfric-skeleton/vn3.0 +meta=lfric-skeleton/vn3.1 [command] default=$LAUNCH_SCRIPT/launch-exe diff --git a/rose-stem/site/common/mesh_tools/tasks_mesh_tools.cylc b/rose-stem/site/common/mesh_tools/tasks_mesh_tools.cylc index a2a18705e..8e4e6d850 100644 --- a/rose-stem/site/common/mesh_tools/tasks_mesh_tools.cylc +++ b/rose-stem/site/common/mesh_tools/tasks_mesh_tools.cylc @@ -20,7 +20,9 @@ "opt_confs": task_ns.conf_name }) %} -{% elif task_ns.conf_name == "cubedsphere-op" %} +{% elif task_ns.conf_name == "cubedsphere-op" or + task_ns.conf_name == "cubedsphere-op-2panels" or + task_ns.conf_name == "cubedsphere-op-3panels" %} {% do task_dict.update({ "resolution": "", diff --git a/rose-stem/site/meto/common/default_directives.cylc b/rose-stem/site/meto/common/default_directives.cylc index f593ffab3..526a62d30 100644 --- a/rose-stem/site/meto/common/default_directives.cylc +++ b/rose-stem/site/meto/common/default_directives.cylc @@ -21,7 +21,7 @@ "tech-tests": { "tech-tests_wallclock": 15, "tech-tests_memory": [1, "GB"], - "tech-tests_cpus": 1, + "tech-tests_cpus": 6, }, }, "ex1a": { @@ -39,10 +39,10 @@ "tech-tests": { "tech-tests_wallclock": 15, "tech-tests_memory": [6, "GB"], - "tech-tests_cpus": 1, + "tech-tests_cpus": 6, }, }, }) %} -{% do LOG.debug("Finished in site/meto/common/default_directives.cylc") %} \ No newline at end of file +{% do LOG.debug("Finished in site/meto/common/default_directives.cylc") %} diff --git a/rose-stem/site/meto/common/suite_config_azspice.cylc b/rose-stem/site/meto/common/suite_config_azspice.cylc index 41f182ea7..6af6a464e 100644 --- a/rose-stem/site/meto/common/suite_config_azspice.cylc +++ b/rose-stem/site/meto/common/suite_config_azspice.cylc @@ -9,13 +9,13 @@ 'module purge ; '~ 'module use /home/users/lfricadmin/lmod ; ' %} -{% set azspice_compiler_gnu = 'module load lfric/vn3.0' %} +{% set azspice_compiler_gnu = 'module load lfric/vn3.1' %} {% set azspice_run = 'ulimit -s unlimited' %} {% set azspice_scitools = 'module load scitools/production-os47-1' %} -{% set azspice_tech = 'module load lfric/vn3.0' %} +{% set azspice_tech = 'module load lfric/vn3.1' %} {% set azspice_coupled_gnu = 'ml xios/2701-oasis ; '~ 'ml oasis/3-mct5.0' %} @@ -31,8 +31,8 @@ [[AZSPICE_BUILD]] [[[environment]]] - USE_VERNIER = yes - USE_TIMING_WRAPPER=yes + USE_VERNIER=true + USE_TIMING_WRAPPER=true [[[directives]]] --gres=tmp:1024 --export=NONE diff --git a/rose-stem/site/meto/common/suite_config_ex1a.cylc b/rose-stem/site/meto/common/suite_config_ex1a.cylc index 6b6901c31..2a7a108c4 100644 --- a/rose-stem/site/meto/common/suite_config_ex1a.cylc +++ b/rose-stem/site/meto/common/suite_config_ex1a.cylc @@ -5,17 +5,22 @@ {# ########################################################################### #} {% do LOG.debug("Entered site/meto/common/suite_config_ex1a.cylc") %} + +{% if site_vars.ex_trustzone == "collab" %} +{% set ex1a_base = 'module use /projects/metoff/spackadmin.mon/releases/2025.12.18/ngms' %} +{% else %} {% set ex1a_base = 'module use /common/internal/spack/releases/2025.10.1/ngms' %} +{% endif %} {% set ex1a_compiler_gnu = 'module switch cpe/22.11 cpe/23.05 ; ' ~ 'module load PrgEnv-gnu ; '~ 'module load gcc/12.2.0 ; '~ - 'module load lfric-gnu/12.2.0/3.0+ || true' %} + 'module load lfric-gnu/12.2.0/3.1 || true' %} {% set ex1a_compiler_cce = 'module switch PrgEnv-cray PrgEnv-cray/8.4.0 ; ' ~ 'module load cpe/23.05 ; '~ 'module switch cce cce/15.0.0 ; '~ - 'module load lfric-cray/15.0.0/3.0+ || true ' %} + 'module load lfric-cray/15.0.0/3.1 || true ' %} {% set set_ulimit = 'ulimit -s unlimited -c unlimited; '~ 'ulimit -a '%} @@ -50,7 +55,9 @@ [[EX1A_RUN]] [[[environment]]] {# BIG_DATA_DIR holds files for io tests #} -{% if site_vars["host_ex"] == "exz" %} +{% if site_vars["ex_trustzone"] == "collab" %} + BIG_DATA_DIR = '/data/users/lfricadmin.mon/data' +{% elif site_vars["host_ex"] == "exz" %} BIG_DATA_DIR = '/common/internal/lfricdir/data' {% else %} BIG_DATA_DIR = '/data/users/lfricadmin/data' @@ -131,6 +138,9 @@ {{ generate_script("pre-script", [ex1a_scitools, ex1a_tech]) }} + [[EX1A_SCRIPTS]] + inherit=EX1A_TECH + [[EX1A_PLOT]] inherit=EX1A_TECH_BASE {{ generate_script("pre-script", [ex1a_scitools]) }} @@ -141,8 +151,22 @@ [[EX1A_EXPORT-SOURCE]] inherit=METO_ORIG [[[environment]]] +{% if site_vars["ex_trustzone"] == "collab" %} + PLATFORM_SYNC = false +{% else %} hostname = $(rose host-select {{site_vars.host_ex}}) PLATFORM_SYNC = true +{% endif %} + + [[EX1A_REMOTE_INIT]] + inherit = EX1A_BASE + [[[directives]]] +{% if site_vars["ex_trustzone"] == "collab" %} + -q = collabshared +{% else %} + -q = shared +{% endif %} + -l ncpus=1 [[EX1A_HOUSEKEEPING]] inherit=EX1A_TECH_BASE diff --git a/rose-stem/site/meto/groups/group_lbc_demo.cylc b/rose-stem/site/meto/groups/group_lbc_demo.cylc index b9ef8faf5..7e6a0dd45 100644 --- a/rose-stem/site/meto/groups/group_lbc_demo.cylc +++ b/rose-stem/site/meto/groups/group_lbc_demo.cylc @@ -75,7 +75,6 @@ }) %} {# Platform Generic Groups #} -{% if site_vars.launch_platform == "azspice" %} {% do site_groups.update({ "lbc_demo_developer": [ "scripts", @@ -98,7 +97,6 @@ "lbc_demo_ex1a_canned", ], }) %} -{% endif %} {# Platform Generic Extends #} {% do site_groups.developer.extend(site_groups.lbc_demo_developer) %} diff --git a/rose-stem/site/meto/groups/group_mesh_tools.cylc b/rose-stem/site/meto/groups/group_mesh_tools.cylc index d3bee961e..64e88682f 100644 --- a/rose-stem/site/meto/groups/group_mesh_tools.cylc +++ b/rose-stem/site/meto/groups/group_mesh_tools.cylc @@ -49,6 +49,8 @@ "mesh_tools_cubedsphere-c2_azspice_gnu_fast-debug-64bit", "mesh_tools_cubedsphere-c3_azspice_gnu_fast-debug-64bit", "mesh_tools_cubedsphere-op_azspice_gnu_fast-debug-64bit", + "mesh_tools_cubedsphere-op-2panels_azspice_gnu_fast-debug-64bit", + "mesh_tools_cubedsphere-op-3panels_azspice_gnu_fast-debug-64bit", "mesh_tools_cubedsphere-op-nonuniform_azspice_gnu_fast-debug-64bit", "mesh_tools_cubedsphere-rotated_azspice_gnu_fast-debug-64bit", "mesh_tools_cubedsphere-maps_azspice_gnu_fast-debug-64bit", @@ -59,6 +61,8 @@ "mesh_tools_cubedsphere-c2_azspice_gnu_full-debug-64bit", "mesh_tools_cubedsphere-c3_azspice_gnu_full-debug-64bit", "mesh_tools_cubedsphere-op_azspice_gnu_full-debug-64bit", + "mesh_tools_cubedsphere-op-2panels_azspice_gnu_full-debug-64bit", + "mesh_tools_cubedsphere-op-3panels_azspice_gnu_full-debug-64bit", "mesh_tools_cubedsphere-op-nonuniform_azspice_gnu_full-debug-64bit", "mesh_tools_cubedsphere-rotated_azspice_gnu_full-debug-64bit", "mesh_tools_cubedsphere-maps_azspice_gnu_full-debug-64bit", @@ -127,6 +131,8 @@ "mesh_tools_cubedsphere-c2_ex1a_cce_full-debug-64bit", "mesh_tools_cubedsphere-c3_ex1a_gnu_fast-debug-64bit", "mesh_tools_cubedsphere-op_ex1a_gnu_fast-debug-64bit", + "mesh_tools_cubedsphere-op-2panels_ex1a_gnu_fast-debug-64bit", + "mesh_tools_cubedsphere-op-3panels_ex1a_gnu_fast-debug-64bit", "mesh_tools_cubedsphere-op-nonuniform_ex1a_gnu_fast-debug-64bit", "mesh_tools_cubedsphere-maps_ex1a_gnu_fast-debug-64bit", "mesh_tools_cubedsphere_ex1a_cce_fast-debug-64bit", diff --git a/rose-stem/site/meto/kgos/mesh_tools/azspice/mesh_cubedsphere-op-2panels_0-2.gnu.kgo.nc b/rose-stem/site/meto/kgos/mesh_tools/azspice/mesh_cubedsphere-op-2panels_0-2.gnu.kgo.nc new file mode 100644 index 000000000..3b5b015a1 Binary files /dev/null and b/rose-stem/site/meto/kgos/mesh_tools/azspice/mesh_cubedsphere-op-2panels_0-2.gnu.kgo.nc differ diff --git a/rose-stem/site/meto/kgos/mesh_tools/azspice/mesh_cubedsphere-op-2panels_1-2.gnu.kgo.nc b/rose-stem/site/meto/kgos/mesh_tools/azspice/mesh_cubedsphere-op-2panels_1-2.gnu.kgo.nc new file mode 100644 index 000000000..2bc19f124 Binary files /dev/null and b/rose-stem/site/meto/kgos/mesh_tools/azspice/mesh_cubedsphere-op-2panels_1-2.gnu.kgo.nc differ diff --git a/rose-stem/site/meto/kgos/mesh_tools/azspice/mesh_cubedsphere-op-3panels_0-3.gnu.kgo.nc b/rose-stem/site/meto/kgos/mesh_tools/azspice/mesh_cubedsphere-op-3panels_0-3.gnu.kgo.nc new file mode 100644 index 000000000..93d6526e9 Binary files /dev/null and b/rose-stem/site/meto/kgos/mesh_tools/azspice/mesh_cubedsphere-op-3panels_0-3.gnu.kgo.nc differ diff --git a/rose-stem/site/meto/kgos/mesh_tools/azspice/mesh_cubedsphere-op-3panels_1-3.gnu.kgo.nc b/rose-stem/site/meto/kgos/mesh_tools/azspice/mesh_cubedsphere-op-3panels_1-3.gnu.kgo.nc new file mode 100644 index 000000000..f69b9ec66 Binary files /dev/null and b/rose-stem/site/meto/kgos/mesh_tools/azspice/mesh_cubedsphere-op-3panels_1-3.gnu.kgo.nc differ diff --git a/rose-stem/site/meto/kgos/mesh_tools/azspice/mesh_cubedsphere-op-3panels_2-3.gnu.kgo.nc b/rose-stem/site/meto/kgos/mesh_tools/azspice/mesh_cubedsphere-op-3panels_2-3.gnu.kgo.nc new file mode 100644 index 000000000..ddefc38ce Binary files /dev/null and b/rose-stem/site/meto/kgos/mesh_tools/azspice/mesh_cubedsphere-op-3panels_2-3.gnu.kgo.nc differ diff --git a/rose-stem/site/meto/kgos/mesh_tools/ex1a/mesh_cubedsphere-op-2panels_0-2.gnu.kgo.nc b/rose-stem/site/meto/kgos/mesh_tools/ex1a/mesh_cubedsphere-op-2panels_0-2.gnu.kgo.nc new file mode 100644 index 000000000..b2dae2f3f Binary files /dev/null and b/rose-stem/site/meto/kgos/mesh_tools/ex1a/mesh_cubedsphere-op-2panels_0-2.gnu.kgo.nc differ diff --git a/rose-stem/site/meto/kgos/mesh_tools/ex1a/mesh_cubedsphere-op-2panels_1-2.gnu.kgo.nc b/rose-stem/site/meto/kgos/mesh_tools/ex1a/mesh_cubedsphere-op-2panels_1-2.gnu.kgo.nc new file mode 100644 index 000000000..8fc6536ff Binary files /dev/null and b/rose-stem/site/meto/kgos/mesh_tools/ex1a/mesh_cubedsphere-op-2panels_1-2.gnu.kgo.nc differ diff --git a/rose-stem/site/meto/kgos/mesh_tools/ex1a/mesh_cubedsphere-op-3panels_0-3.gnu.kgo.nc b/rose-stem/site/meto/kgos/mesh_tools/ex1a/mesh_cubedsphere-op-3panels_0-3.gnu.kgo.nc new file mode 100644 index 000000000..1668204d3 Binary files /dev/null and b/rose-stem/site/meto/kgos/mesh_tools/ex1a/mesh_cubedsphere-op-3panels_0-3.gnu.kgo.nc differ diff --git a/rose-stem/site/meto/kgos/mesh_tools/ex1a/mesh_cubedsphere-op-3panels_1-3.gnu.kgo.nc b/rose-stem/site/meto/kgos/mesh_tools/ex1a/mesh_cubedsphere-op-3panels_1-3.gnu.kgo.nc new file mode 100644 index 000000000..a8c3b6cd4 Binary files /dev/null and b/rose-stem/site/meto/kgos/mesh_tools/ex1a/mesh_cubedsphere-op-3panels_1-3.gnu.kgo.nc differ diff --git a/rose-stem/site/meto/kgos/mesh_tools/ex1a/mesh_cubedsphere-op-3panels_2-3.gnu.kgo.nc b/rose-stem/site/meto/kgos/mesh_tools/ex1a/mesh_cubedsphere-op-3panels_2-3.gnu.kgo.nc new file mode 100644 index 000000000..7de8f74a5 Binary files /dev/null and b/rose-stem/site/meto/kgos/mesh_tools/ex1a/mesh_cubedsphere-op-3panels_2-3.gnu.kgo.nc differ diff --git a/rose-stem/site/meto/macros/macros_ex1a.cylc b/rose-stem/site/meto/macros/macros_ex1a.cylc index 631427689..71c6df8d8 100644 --- a/rose-stem/site/meto/macros/macros_ex1a.cylc +++ b/rose-stem/site/meto/macros/macros_ex1a.cylc @@ -59,7 +59,11 @@ {% set lfric_nodes = possible_nodes %} {% endif %} + {% if site_vars["ex_trustzone"] == "collab" %} + -q=collabnormal + {% else %} -q=normal + {% endif %} -l select={{ lfric_nodes + ocean_nodes|int + river_nodes|int + @@ -68,7 +72,11 @@ {% macro shared_queue(cores) %} + {% if site_vars["ex_trustzone"] == "collab" %} + -q=collabshared + {% else %} -q=shared + {% endif %} -l ncpus={{ cores }} {% endmacro %} diff --git a/rose-stem/site/meto/variables.cylc b/rose-stem/site/meto/variables.cylc index 540674dbd..7e63329ce 100644 --- a/rose-stem/site/meto/variables.cylc +++ b/rose-stem/site/meto/variables.cylc @@ -21,8 +21,23 @@ {% do site_vars.update({"site_platforms": ["ex1a", "azspice"]}) %} -{% do site_vars.update({"launch_platform": "azspice"}) %} -{% do site_vars.update({"scripts_platform": "azspice"}) %} +{# Settings for EX Collab Zone #} +{% from "socket" import getfqdn %} +{% set hostname = getfqdn() %} +{% if "collab.sc" in hostname %} + {% do site_vars.update({"ex_trustzone": "collab"}) %} + {% do site_vars.update({"USE_TOKENS": true}) %} +{% else %} + {% do site_vars.update({"ex_trustzone": "research"}) %} +{% endif %} + +{% if site_vars["ex_trustzone"] == "collab" %} + {% do site_vars.update({"launch_platform": "ex1a"}) %} + {% do site_vars.update({"scripts_platform": "ex1a"}) %} +{% else %} + {% do site_vars.update({"launch_platform": "azspice"}) %} + {% do site_vars.update({"scripts_platform": "azspice"}) %} +{% endif %} {% do site_vars.update({"git_mirror_loc": "/data/users/gitassist/git_mirrors"}) %} @@ -30,8 +45,12 @@ {% do site_vars.update({"mesh_build": {"ex1a": "gnu_fast-debug-64bit", "azspice": "gnu_fast-debug-64bit"} }) %} +{% do site_vars.update({"remote_init_family": {"ex1a": "EX1A_REMOTE_INIT"} }) %} + {# Choose EX Host - default to random ab or cd #} -{% if USE_EXZ is defined and USE_EXZ %} +{% if site_vars["ex_trustzone"] == "collab" %} + {% do site_vars.update({"host_ex" : "ex"}) %} +{% elif USE_EXZ is defined and USE_EXZ %} {% do site_vars.update({"host_ex" : "exz"}) %} {% elif USE_EXAB is defined and USE_EXAB %} {% do site_vars.update({"host_ex": "exab"}) %} diff --git a/rose-stem/templates/default_directives.cylc b/rose-stem/templates/default_directives.cylc index aebc8752d..8b454cc5f 100644 --- a/rose-stem/templates/default_directives.cylc +++ b/rose-stem/templates/default_directives.cylc @@ -16,7 +16,7 @@ "mesh_cpus": 6, "tech-tests_memory": [6, "GB"], "tech-tests_wallclock": 20, - "tech-tests_cpus": 1, + "tech-tests_cpus": 6, } %} {% for item, value in defaults.items() %} @@ -38,4 +38,4 @@ {% endfor %} -{% do LOG.debug("Finished in templates/default_directives.cylc") %} \ No newline at end of file +{% do LOG.debug("Finished in templates/default_directives.cylc") %} diff --git a/rose-stem/templates/runtime/generate_runtime_control.cylc b/rose-stem/templates/runtime/generate_runtime_control.cylc index 02193d9c4..d69b6be46 100644 --- a/rose-stem/templates/runtime/generate_runtime_control.cylc +++ b/rose-stem/templates/runtime/generate_runtime_control.cylc @@ -31,7 +31,7 @@ ROSE_TASK_APP = extract_source DEPENDENCIES = {{dependencies}} USE_MIRRORS = {{USE_MIRRORS}} - USE_TOKENS = {{USE_TOKENS}} + USE_TOKENS = {{site_vars.get("USE_TOKENS", "false")}} {% if USE_MIRRORS %} {% if "git_mirror_loc" in site_vars %} GIT_MIRROR_LOC = {{site_vars.git_mirror_loc}} @@ -85,8 +85,14 @@ {% set platform = task.split('_')[1] %} + {% if "remote_init_family" in site_vars and platform in site_vars["remote_init_family"] %} + {% set remote_inherit = "EXPORT-SOURCE, "~site_vars["remote_init_family"][platform]~", CONTROL_TASK_RETRIES" %} + {% else %} + {% set remote_inherit = "EXPORT-SOURCE, "~platform|upper~"_BASE, CONTROL_TASK_RETRIES" %} + {% endif %} + [[{{task}}]] - inherit = EXPORT-SOURCE, {{platform|upper}}_BASE + inherit = {{remote_inherit}} script = true execution time limit = PT1M