From 08dae3b0742642def0ebc9cf98f896329cfa8927 Mon Sep 17 00:00:00 2001 From: Matthew Dimond Date: Fri, 30 Jun 2023 11:50:06 -0600 Subject: [PATCH 01/86] Fix MPAS field tests This commit fixes an issue with the field test functions in the test core. This arose when reading in threadErrs, but not setting it to zero. This means that the field tests will inheret the error codes from the halo exchange tests above. intent(out) also allows the compiler to do whatever it desires to the contents of that array as soon as it enters the function. This could lead to undefined behavior. The net reseult of this is that the field test codes are erroneously set to nonzero values while the tests are in fact passing. After setting all values to 0 before the tests run, the field tests now correctly show that they are passing. --- src/core_test/mpas_test_core_field_tests.F | 1 + 1 file changed, 1 insertion(+) diff --git a/src/core_test/mpas_test_core_field_tests.F b/src/core_test/mpas_test_core_field_tests.F index 54493fc39c..87fe23fa39 100644 --- a/src/core_test/mpas_test_core_field_tests.F +++ b/src/core_test/mpas_test_core_field_tests.F @@ -91,6 +91,7 @@ subroutine test_core_attribute_list_test(domain, threadErrs, ierr)!{{{ integer :: threadNum iErr = 0 + threadErrs = 0 threadNum = mpas_threading_get_thread_num() From 9db071dd70fc45772ad6abdd15e1791c0d0287ae Mon Sep 17 00:00:00 2001 From: Matthew Dimond Date: Fri, 30 Jun 2023 14:31:31 -0600 Subject: [PATCH 02/86] Fix out of bounds access in threadErrs on failure The "threadErrs" array is intended to hold the error code for each thread running a bank of tests. In the field tests, the thread number currently running the function is retrieved by "mpas_threading_get_thread_num", and stored in "threadNum". If the threadnum is 0, the tests are actually executed. However, because arrays in fortran are 1-indexed, when the tests fail and attempt to set threadErrs( threadNum ) to 1 it attempots to access threadErrs( 0 ), which is out of the array bounds. This is fixed by adding 1 to the thread number- this is done elsewhere in the halo exchange tests, but was omitted in this test suite. --- src/core_test/mpas_test_core_field_tests.F | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core_test/mpas_test_core_field_tests.F b/src/core_test/mpas_test_core_field_tests.F index 87fe23fa39..46a3a87e1d 100644 --- a/src/core_test/mpas_test_core_field_tests.F +++ b/src/core_test/mpas_test_core_field_tests.F @@ -93,9 +93,9 @@ subroutine test_core_attribute_list_test(domain, threadErrs, ierr)!{{{ iErr = 0 threadErrs = 0 - threadNum = mpas_threading_get_thread_num() + threadNum = mpas_threading_get_thread_num() + 1 - if ( threadNum == 0 ) then + if ( threadNum == 1 ) then allocate(srcList) nullify(destList) From 7bc8249d23becc8eefcd8c70133edbe7ee2ffd7a Mon Sep 17 00:00:00 2001 From: Matthew Dimond Date: Wed, 28 Jun 2023 10:45:12 -0600 Subject: [PATCH 03/86] Add mpas_modify_att() subroutines to mpas_attlist CF compliance requires certain attributes to be updated periodically throughout a run. The current attlist module only supports creation and retrieval of attributes. This commit addds this functionality, and some basic tests. The subroutines work very similarly to the "mpas_get_att" subroutines, but modifies the contents of the linked list node if the type and name match the expected type and name. If they do not, the subroutines will return a 1 in ierr. It is also noted that these procedures are not currently threadsafe. Future work may include threadsafe attribute modification and a more comprehensive test suite for all of the attlist procedures. --- src/core_test/mpas_test_core_field_tests.F | 63 +++++- src/framework/mpas_attlist.F | 218 +++++++++++++++++++++ 2 files changed, 276 insertions(+), 5 deletions(-) diff --git a/src/core_test/mpas_test_core_field_tests.F b/src/core_test/mpas_test_core_field_tests.F index 46a3a87e1d..50114398c6 100644 --- a/src/core_test/mpas_test_core_field_tests.F +++ b/src/core_test/mpas_test_core_field_tests.F @@ -82,11 +82,12 @@ subroutine test_core_attribute_list_test(domain, threadErrs, ierr)!{{{ integer, intent(out) :: ierr type ( att_list_type ), pointer :: srcList, destList - integer :: srcInt, destInt - integer, dimension(:), pointer :: srcIntA, destIntA - real (kind=RKIND) :: srcReal, destReal + integer :: srcInt, destInt, modifyInt + integer, dimension(:), pointer :: srcIntA, destIntA, modifyIntA + real (kind=RKIND) :: srcReal, destReal, modifyReal real (kind=RKIND), dimension(:), pointer :: srcRealA, destRealA - character (len=StrKIND) :: srcText, destText + real (kind=RKIND), dimension(:), pointer :: modifyRealA + character (len=StrKIND) :: srcText, destText, modifyText integer :: threadNum @@ -154,9 +155,61 @@ subroutine test_core_attribute_list_test(domain, threadErrs, ierr)!{{{ call mpas_log_write(' Duplicate string does not match', MPAS_LOG_ERR) end if + deallocate(destIntA) + deallocate(destRealA) + allocate(modifyIntA(3)) + allocate(modifyRealA(5)) + + modifyInt = 2 + modifyIntA(:) = 2 + modifyReal = 2.0_RKIND + modifyRealA(:) = 2.0_RKIND + modifyText = 'Modified' + + call mpas_modify_att(srcList, 'testInt', modifyInt) + call mpas_modify_att(srcList, 'testIntA', modifyIntA) + call mpas_modify_att(srcList, 'testReal', modifyReal) + call mpas_modify_att(srcList, 'testRealA', modifyRealA) + call mpas_modify_att(srcList, 'testText', modifyText) + + call mpas_get_att(srcList, 'testInt', destInt) + call mpas_get_att(srcList, 'testIntA', destIntA) + call mpas_get_att(srcList, 'testReal', destReal) + call mpas_get_att(srcList, 'testRealA', destRealA) + call mpas_get_att(srcList, 'testText', destText) + + if ( destInt /= modifyInt ) then + threadErrs( threadNum ) = 1 + call mpas_log_write(' Int not modified correctly', MPAS_LOG_ERR) + end if + + if (sum(destIntA) /= sum(modifyIntA)) then + threadErrs( threadNum ) = 1 + call mpas_log_write(' IntA not modified correctly', MPAS_LOG_ERR) + end if + + if ( destReal /= modifyReal ) then + threadErrs( threadNum ) = 1 + call mpas_log_write(' Real not modified correctly', MPAS_LOG_ERR) + end if + + if ( sum(destRealA) /= sum(modifyRealA) ) then + threadErrs( threadNum ) = 1 + call mpas_log_write(' RealA not modified correctly', MPAS_LOG_ERR) + end if + + if ( trim(destText) /= trim(modifyText) ) then + threadErrs( threadNum ) = 1 + call mpas_log_write(' Text not modified correctly', MPAS_LOG_ERR) + end if + call mpas_deallocate_attlist(srcList) call mpas_deallocate_attlist(destList) - + + deallocate(destIntA) + deallocate(destRealA) + deallocate(modifyRealA) + deallocate(modifyIntA) deallocate(srcIntA) deallocate(srcRealA) end if diff --git a/src/framework/mpas_attlist.F b/src/framework/mpas_attlist.F index bbebda1470..2ec70e1bf8 100644 --- a/src/framework/mpas_attlist.F +++ b/src/framework/mpas_attlist.F @@ -30,6 +30,14 @@ module mpas_attlist module procedure mpas_add_att_text end interface mpas_add_att + interface mpas_modify_att + module procedure mpas_modify_att_int0d + module procedure mpas_modify_att_int1d + module procedure mpas_modify_att_real0d + module procedure mpas_modify_att_real1d + module procedure mpas_modify_att_text + end interface mpas_modify_att + interface mpas_get_att module procedure mpas_get_att_int0d module procedure mpas_get_att_int1d @@ -253,6 +261,216 @@ subroutine mpas_add_att_text(attList, attName, attValue, ierr)!{{{ end subroutine mpas_add_att_text!}}} +!*********************************************************************** +! +! routine mpas_modify_att_text +! +! > \brief MPAS modify text attribute routine +! > \author Matthew Dimond +! > \date 06/27/23 +! > \details +! > This routine modifies a text attribute in the attribute list, +! > and returns a 1 in ierr if the attribute is not found, or the attribute +! > has a type incompatible with attValue. +! +!---------------------------------------------------------------------- + subroutine mpas_modify_att_text(attList, attName, attValue, ierr)!{{{ + + implicit none + + type (att_list_type), pointer :: attList !< Input/Output: Attribute List + character (len=*), intent(in) :: attName !< Input: Att. name to modify + character (len=*), intent(in) :: attValue !< Input: Updated Att. value + integer, intent(out), optional :: ierr !< Output: Error flag + + type (att_list_type), pointer :: cursor + + if (present(ierr)) ierr = 1 + + ! Traverse list looking for attName + cursor => attlist + do while (associated(cursor)) + if (trim(cursor % attName) == trim(attName)) then + if (cursor % attType == MPAS_ATT_TEXT) then + if (present(ierr)) ierr = 0 + write(cursor % attValueText,'(a)') trim(attValue) + end if + return + end if + cursor => cursor % next + end do + + end subroutine mpas_modify_att_text!}}} + + +!*********************************************************************** +! +! routine mpas_modify_att_int0d +! +! > \brief MPAS modify 0D integer attribute routine +! > \author Matthew Dimond +! > \date 06/27/23 +! > \details +! > This routine modifies a 0d integer attribute in the attribute list, +! > and returns a 1 in ierr if the attribute is not found, or the attribute +! > has a type incompatible with attValue. +! +!---------------------------------------------------------------------- + subroutine mpas_modify_att_int0d(attList, attName, attValue, ierr)!{{{ + + implicit none + + type (att_list_type), pointer :: attList !< Input/Output: Attribute List + character (len=*), intent(in) :: attName !< Input: Att. name to modify + integer, intent(in) :: attValue !< Input: Updated Att. value + integer, intent(out), optional :: ierr !< Output: Error flag + + type (att_list_type), pointer :: cursor + + if (present(ierr)) ierr = 1 + + ! Traverse list looking for attName + cursor => attlist + do while (associated(cursor)) + if (trim(cursor % attName) == trim(attName)) then + if (cursor % attType == MPAS_ATT_INT) then + if (present(ierr)) ierr = 0 + cursor % attValueInt = attValue + end if + return + end if + cursor => cursor % next + end do + + end subroutine mpas_modify_att_int0d!}}} + +!*********************************************************************** +! +! routine mpas_modify_att_int1d +! +! > \brief MPAS modify 1D integer attribute routine +! > \author Matthew Dimond +! > \date 06/27/23 +! > \details +! > This routine modifies a 1d integer attribute in the attribute list, +! > and returns a 1 in ierr if the attribute is not found, or the attribute +! > has a type incompatible with attValue. +! +!---------------------------------------------------------------------- + subroutine mpas_modify_att_int1d(attList, attName, attValue, ierr)!{{{ + + implicit none + + type (att_list_type), pointer :: attList !< Input/Output: Attribute List + character (len=*), intent(in) :: attName !< Input: Att. name to modify + integer, dimension(:), intent(in) :: attValue !< Input: Updated Att. value + integer, intent(out), optional :: ierr !< Output: Error flag + + type (att_list_type), pointer :: cursor + + if (present(ierr)) ierr = 1 + + ! Traverse list looking for attName + cursor => attlist + do while (associated(cursor)) + if (trim(cursor % attName) == trim(attName)) then + if (cursor % attType == MPAS_ATT_INTA) then + if (size(cursor % attValueIntA) == size(attValue)) then + if (present(ierr)) ierr = 0 + cursor % attValueIntA(:) = attValue(:) + end if + end if + return + end if + cursor => cursor % next + end do + + end subroutine mpas_modify_att_int1d!}}} + +!*********************************************************************** +! +! routine mpas_modify_att_real0d +! +! > \brief MPAS modify 0D real attribute routine +! > \author Matthew Dimond +! > \date 06/27/23 +! > \details +! > This routine modifies a 0d real attribute in the attribute list, +! > and returns a 1 in ierr if the attribute is not found, or the attribute +! > has a type incompatible with attValue. +! +!---------------------------------------------------------------------- + subroutine mpas_modify_att_real0d(attList, attName, attValue, ierr)!{{{ + + implicit none + + type (att_list_type), pointer :: attList !< Input/Output: Attribute List + character (len=*), intent(in) :: attName !< Input: Att. name to modify + real (kind=RKIND), intent(in) :: attValue !< Input: Updated Att. value + integer, intent(out), optional :: ierr !< Output: Error flag + + type (att_list_type), pointer :: cursor + + if (present(ierr)) ierr = 1 + + ! Traverse list looking for attName + cursor => attlist + do while (associated(cursor)) + if (trim(cursor % attName) == trim(attName)) then + if (cursor % attType == MPAS_ATT_REAL) then + if (present(ierr)) ierr = 0 + cursor % attValueReal = attValue + end if + return + end if + cursor => cursor % next + end do + + end subroutine mpas_modify_att_real0d!}}} + +!*********************************************************************** +! +! routine mpas_modify_att_real1d +! +! > \brief MPAS modify 1D real attribute routine +! > \author Matthew Dimond +! > \date 06/27/23 +! > \details +! > This routine modifies a 1d real attribute in the attribute list, +! > and returns a 1 in ierr if the attribute is not found, or the attribute +! > has a type incompatible with attValue. +! +!---------------------------------------------------------------------- + subroutine mpas_modify_att_real1d(attList, attName, attValue, ierr)!{{{ + + implicit none + + type (att_list_type), pointer :: attList !< Input/Output: Attribute List + character (len=*), intent(in) :: attName !< Input: Att. name to modify + real (kind=RKIND), dimension(:), intent(in) :: attValue !< Input: Updated Att. value + integer, intent(out), optional :: ierr !< Output: Error flag + + type (att_list_type), pointer :: cursor + + if (present(ierr)) ierr = 1 + + ! Traverse list looking for attName + cursor => attlist + do while (associated(cursor)) + if (trim(cursor % attName) == trim(attName)) then + if (cursor % attType == MPAS_ATT_REALA) then + if (size(cursor % attValueRealA) == size(attValue)) then + if (present(ierr)) ierr = 0 + cursor % attValueRealA(:) = attValue(:) + end if + end if + return + end if + cursor => cursor % next + end do + + end subroutine mpas_modify_att_real1d!}}} + !*********************************************************************** ! ! routine mpas_get_att_int0d From a799daf5308b1b0b628d34a892f0d0b45917a62a Mon Sep 17 00:00:00 2001 From: Matthew Dimond Date: Tue, 18 Jul 2023 13:51:35 -0600 Subject: [PATCH 04/86] Update fortprintf to support Fortran 2003 linebreaks This commit removes a lot of the logic that was required by the old Fortran 90 linebreak style. This logic was required to know if we were inside of and to keep track of the indices of those quotes, so that the quotes could be terminated before a multi line string could be created by concatenating two new strings together. The Fortran 2003 standard allows for character context strings to be continued by adding a leading ampersand, such as: str = 'This is a & &string' This allows us to not have to close quotes, and so makes the logic much simpler. The logic now looks only for being within quotes of any kind. The line is broken at the closest space to the maximum character limit, and ended with an ampersand. If we are within quotes and therefore a character context, we lead the new line with an ampersand. If not, we carry on in the next line as normal. Two tests were also added, and some incorrect test numbering was cleaned up in the same file. --- src/tools/registry/fortprintf.c | 49 ++++++++++++++++++++++----------- 1 file changed, 33 insertions(+), 16 deletions(-) diff --git a/src/tools/registry/fortprintf.c b/src/tools/registry/fortprintf.c index 0635146602..1c71fa6744 100644 --- a/src/tools/registry/fortprintf.c +++ b/src/tools/registry/fortprintf.c @@ -25,7 +25,7 @@ int nbuf = 0; int fortprintf(FILE * fd, char * str, ...)/*{{{*/ { - int i, nl, sp, sp_inquotes, inquotes, q; + int i, nl, sp, sp_inquotes, indoublequotes, inquotes; int lastchar; int errorcode; va_list ap; @@ -52,32 +52,36 @@ int fortprintf(FILE * fd, char * str, ...)/*{{{*/ nbuf = nbuf + i; inquotes = 0; - q = -1; + indoublequotes = 0; do { nl = sp = -1; - /* Scan through the max line length - 1 (since we may have to add an & character) or the end of the buffer, whichever comes first */ for (i=0; i= 0) { snprintf(printbuf, sp+2, "%s", fbuffer); i = sp+1; - if (sp_inquotes && (sp > q)) printbuf[i++] = '\''; printbuf[i++] = '&'; printbuf[i++] = '\n'; + + /* If we are in a character context, add an ampersand at the start + of the next line */ + if (sp_inquotes) { + printbuf[i++] = '&'; + } + printbuf[i++] = '\0'; fprintf(fd, "%s", printbuf); sp++; i = 0; - if (sp_inquotes && (sp > q)) { - inquotes = (inquotes + 1) % 2; - fbuffer[i++] = '/'; - fbuffer[i++] = '/'; - fbuffer[i++] = '\''; - } - /* Shift unprinted contents of fortran buffer to the beginning */ for ( ; sp Date: Wed, 26 Jul 2023 10:43:58 -0600 Subject: [PATCH 05/86] Remove the azure-pipelines.yml file, as it is no longer used --- azure-pipelines.yml | 141 -------------------------------------------- 1 file changed, 141 deletions(-) delete mode 100644 azure-pipelines.yml diff --git a/azure-pipelines.yml b/azure-pipelines.yml deleted file mode 100644 index c586773f9e..0000000000 --- a/azure-pipelines.yml +++ /dev/null @@ -1,141 +0,0 @@ -trigger: - branches: - include: - - master - - develop - - ocean/develop - - lanice/develop - - ocean/coastal - tags: - include: - - '*' -pr: - branches: - include: - - master - - develop - - ocean/develop - - lanice/develop - - ocean/coastal - -jobs: -- job: - displayName: docs - pool: - vmImage: 'ubuntu-16.04' - strategy: - matrix: - Python38: - python.version: '3.8' - - steps: - - bash: echo "##vso[task.prependpath]$CONDA/bin" - displayName: Add conda to PATH - - - bash: | - set -e - eval "$(conda shell.bash hook)" - conda config --add channels conda-forge - conda config --set channel_priority strict - displayName: Configure conda - - - bash: | - set -e - eval "$(conda shell.bash hook)" - conda create -y -n docs python=$PYTHON_VERSION sphinx mock sphinx_rtd_theme m2r - displayName: Create docs environment - - - bash: | - set -e - eval "$(conda shell.bash hook)" - conda activate docs - - echo "source branch: $(Build.SourceBranch)" - echo "repository: $(Build.Repository.Name)" - - tag=$(git describe --tags $(git rev-list --tags --max-count=1)) - echo "tag: $tag" - - REPO_PATH=$PWD - - if [[ "$(Build.SourceBranch)" == refs/tags/* ]]; then - echo "this is a tag build" - export DOCS_VERSION="$tag" - deploy=True - run=True - elif [[ "$(Build.SourceBranch)" == refs/heads/* ]]; then - branch="$(Build.SourceBranchName)" - echo "this is a merge build of $branch" - deploy=True - elif [[ "$(Build.SourceBranch)" == refs/pull/*/merge ]]; then - branch="$(System.PullRequest.TargetBranch)" - echo "this is a pull request into $branch" - deploy=False - fi - - if [ -n ${branch} ]; then - echo "This build is for branch $branch" - if [[ ${branch} == "master" ]]; then - export DOCS_VERSION="stable" - run=True - elif [[ ${branch} == "develop" ]]; then - export DOCS_VERSION="latest" - run=True - elif [[ ${branch} == "ocean/develop" ]]; then - export DOCS_VERSION="latest ocean" - run=True - elif [[ ${branch} == "ocean/coastal" ]]; then - export DOCS_VERSION="latest coastal" - run=True - elif [[ ${branch} == "landice/develop" ]]; then - export DOCS_VERSION="latest landice" - run=True - else - echo "We don't build docs for $branch" - deploy=False - run=False - fi - fi - - if [[ "${run}" == "False" ]]; then - echo "Not building docs for branch ${branch}" - exit 0 - fi - - echo "Docs version: $DOCS_VERSION" - echo "Deploy to gh-pages? $deploy" - cd docs || exit 1 - make html - - cd "$REPO_PATH" || exit 1 - - if [[ "$deploy" == "False" ]]; then - exit 0 - fi - - PUBLICATION_BRANCH=gh-pages - DOCS_PATH="${DOCS_VERSION// /_}" - # Checkout the branch - pushd $HOME || exit 1 - git clone --branch=$PUBLICATION_BRANCH https://$(GitHubToken)@github.com/$(Build.Repository.Name) publish - cd publish || exit 1 - - # Update pages - if [[ -d "$DOCS_PATH" ]]; then - git rm -rf "$DOCS_PATH" > /dev/null - fi - mkdir "$DOCS_PATH" - cp -r "$REPO_PATH"/docs/_build/html/* "$DOCS_PATH" - # Commit and push latest version - git add . - if git diff-index --quiet HEAD; then - echo "No changes in the docs." - else - git config --local user.name "Azure Pipelines" - git config --local user.email "azuredevops@microsoft.com" - git commit -m "[skip ci] Update $DOCS_VERSION" - git push -fq origin $PUBLICATION_BRANCH - fi - popd || exit 1 - displayName: build and deploy docs - From fac805836fd0a635a8dcb1c85000bdb0c71f3016 Mon Sep 17 00:00:00 2001 From: Matthew Dimond Date: Wed, 26 Jul 2023 09:23:42 -0600 Subject: [PATCH 06/86] Start mpas_string_utils Throughout the MPAS code, there are a number of utility functions and subroutines that deal with the manipulation of strings. As more procedures are added, it begins to make sense to have a common space for these things to be contained in. To this effect, we have added the "mpas_string_utils" module, and moved the "mpas_split_string" subroutine from mpas_timekeeping.F to this module. Future updates will include more functions and subroutines that allow further manipulation of strings. --- src/framework/Makefile | 5 ++- src/framework/framework.cmake | 1 + src/framework/mpas_string_utils.F | 66 +++++++++++++++++++++++++++++++ src/framework/mpas_timekeeping.F | 35 +--------------- 4 files changed, 71 insertions(+), 36 deletions(-) create mode 100644 src/framework/mpas_string_utils.F diff --git a/src/framework/Makefile b/src/framework/Makefile index 564dcfd5ac..ffe7df893b 100644 --- a/src/framework/Makefile +++ b/src/framework/Makefile @@ -34,7 +34,8 @@ OBJS = mpas_kind_types.o \ xml_stream_parser.o \ regex_matching.o \ mpas_log.o \ - mpas_halo.o + mpas_halo.o \ + mpas_string_utils.o all: framework $(DEPS) @@ -78,7 +79,7 @@ mpas_dmpar.o: mpas_sort.o mpas_kind_types.o mpas_derived_types.o mpas_hash.o mpa mpas_sort.o: mpas_kind_types.o mpas_log.o -mpas_timekeeping.o: mpas_kind_types.o mpas_derived_types.o mpas_dmpar.o mpas_threading.o mpas_log.o +mpas_timekeeping.o: mpas_string_utils.o mpas_kind_types.o mpas_derived_types.o mpas_dmpar.o mpas_threading.o mpas_log.o mpas_timer.o: mpas_kind_types.o mpas_dmpar.o mpas_threading.o mpas_log.o diff --git a/src/framework/framework.cmake b/src/framework/framework.cmake index f74747fb4f..1906dbe8cb 100644 --- a/src/framework/framework.cmake +++ b/src/framework/framework.cmake @@ -32,4 +32,5 @@ list(APPEND COMMON_RAW_SOURCES framework/regex_matching.c framework/mpas_field_accessor.F framework/mpas_log.F + framework/mpas_string_utils.F ) diff --git a/src/framework/mpas_string_utils.F b/src/framework/mpas_string_utils.F new file mode 100644 index 0000000000..fe503dc606 --- /dev/null +++ b/src/framework/mpas_string_utils.F @@ -0,0 +1,66 @@ +! Copyright (c) 2023 The University Corporation for Atmospheric Research (UCAR). +! +! Unless noted otherwise source code is licensed under the BSD license. +! Additional copyright and license information can be found in the LICENSE file +! distributed with this code, or at https://mpas-dev.github.io/license.html . +! +!----------------------------------------------------------------------- +! mpas_string_utils +! +!> \brief Collection of functions used for string manipulation +!> \author Matthew Dimond +!> \date 25 July 2023 +!> \details +!> This module provides functions and subroutines used for string +!> manipulations and utilities. +! +!----------------------------------------------------------------------- +module mpas_string_utils + + contains + + !----------------------------------------------------------------------- + ! routine mpas_split_string + ! + !> \brief This routine splits a string on a specified delimiting character + !> \author Michael Duda, Doug Jacobsen + !> \date 07/23/2014 + !> \details This routine splits the given "string" on the delimiter + !> character, and returns an array of pointers to the substrings + !> between the delimiting characters. + ! + !----------------------------------------------------------------------- + subroutine mpas_split_string(string, delimiter, subStrings) + + implicit none + + character(len=*), intent(in) :: string + character, intent(in) :: delimiter + character(len=*), pointer, dimension(:) :: subStrings + + integer :: i, start, index + + index = 1 + do i = 1, len(string) + if(string(i:i) == delimiter) then + index = index + 1 + end if + end do + + allocate(subStrings(1:index)) + + start = 1 + index = 1 + do i = 1, len(string) + if (string(i:i) == delimiter) then + subStrings(index) = string(start:i-1) + index = index + 1 + start = i + 1 + end if + end do + subStrings(index) = string(start:len(string)) + + end subroutine mpas_split_string + +end module mpas_string_utils + diff --git a/src/framework/mpas_timekeeping.F b/src/framework/mpas_timekeeping.F index 14a001039f..93fdb86336 100644 --- a/src/framework/mpas_timekeeping.F +++ b/src/framework/mpas_timekeeping.F @@ -12,6 +12,7 @@ module mpas_timekeeping use mpas_dmpar use mpas_threading use mpas_log + use mpas_string_utils, only : mpas_split_string use ESMF @@ -2108,40 +2109,6 @@ end function abs_ti ! ! end function mod - - subroutine mpas_split_string(string, delimiter, subStrings) - - implicit none - - character(len=*), intent(in) :: string - character, intent(in) :: delimiter - character(len=*), pointer, dimension(:) :: subStrings - - integer :: i, start, index - - index = 1 - do i = 1, len(string) - if(string(i:i) == delimiter) then - index = index + 1 - end if - end do - - allocate(subStrings(1:index)) - - start = 1 - index = 1 - do i = 1, len(string) - if(string(i:i) == delimiter) then - subStrings(index) = string(start:i-1) - index = index + 1 - start = i + 1 - end if - end do - subStrings(index) = string(start:len(string)) - - end subroutine mpas_split_string - - subroutine mpas_get_month_day(YYYY, DoY, month, day) implicit none From 05b77ea7827ebb37f2464e5a60a353da57c219ea Mon Sep 17 00:00:00 2001 From: Michael Duda Date: Fri, 28 Jul 2023 16:31:47 -0600 Subject: [PATCH 07/86] Remove original CMake build files Existing CMake build files were originally added in late 2019 to support E3SM. These build files didn't work for the 'atmosphere' and 'init_atmosphere' cores, and to make way for CMake build files that will support the 'atmosphere' and 'init_atmosphere' cores, this commit removes the previous CMakeLists.txt and *.cmake files. --- src/CMakeLists.txt | 97 --------------- src/build_core.cmake | 67 ----------- src/cmake_utils.cmake | 74 ------------ src/core_landice/landice.cmake | 79 ------------- src/core_ocean/ocean.cmake | 207 --------------------------------- src/core_seaice/seaice.cmake | 108 ----------------- src/framework/framework.cmake | 36 ------ src/operators/operators.cmake | 13 --- src/tools/CMakeLists.txt | 30 ----- 9 files changed, 711 deletions(-) delete mode 100644 src/CMakeLists.txt delete mode 100644 src/build_core.cmake delete mode 100644 src/cmake_utils.cmake delete mode 100644 src/core_landice/landice.cmake delete mode 100644 src/core_ocean/ocean.cmake delete mode 100644 src/core_seaice/seaice.cmake delete mode 100644 src/framework/framework.cmake delete mode 100644 src/operators/operators.cmake delete mode 100644 src/tools/CMakeLists.txt diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt deleted file mode 100644 index 41375a53d2..0000000000 --- a/src/CMakeLists.txt +++ /dev/null @@ -1,97 +0,0 @@ -# -# This is the interface between E3SM's new CMake-based build system and MPAS. -# -# The following CMake variables are expected to be defined: -# * CORES : A list of CORES to build, comma-separated (e.g. "ocean,seaice,landice") -# * Whatever CIME settings are setting to correctly resolve the ${CASEROOT}/Macros.cmake file -# - COMPILER, DEBUG, MPILIB, MACH, OS -# - -# Source CIME-generated Macros -include(${CASEROOT}/Macros.cmake) -# Load machine/compiler specific settings -set(COMPILER_SPECIFIC_DEPENDS ${CASEROOT}/Depends.${COMPILER}.cmake) -set(MACHINE_SPECIFIC_DEPENDS ${CASEROOT}/Depends.${MACH}.cmake) -set(PLATFORM_SPECIFIC_DEPENDS ${CASEROOT}/Depends.${MACH}.${COMPILER}.cmake) -set(TRY_TO_LOAD ${COMPILER_SPECIFIC_DEPENDS} ${MACHINE_SPECIFIC_DEPENDS} ${PLATFORM_SPECIFIC_DEPENDS}) -foreach(ITEM IN LISTS TRY_TO_LOAD) - if (EXISTS ${ITEM}) - include(${ITEM}) - endif() -endforeach() - -# -# General setup -# - -if (USE_ESMF_LIB) - set(ESMFDIR "esmf") -else() - set(ESMFDIR "noesmf") -endif() - -set(CMAKE_C_COMPILER ${MPICC}) -set(CMAKE_CXX_COMPILER ${MPICXX}) -set(CMAKE_Fortran_COMPILER ${MPIFC}) -set(CMAKE_EXE_LINKER_FLAGS "${LDFLAGS}") -set(CMAKE_VERBOSE_MAKEFILE TRUE) - -# Set up CPPDEFS -set(FILE_OFFSET "-DOFFSET64BIT") -if (CPPDEFS) - separate_arguments(CPPDEFS UNIX_COMMAND "${CPPDEFS}") -endif() -list(APPEND CPPDEFS "-DMPAS_NO_LOG_REDIRECT" "-DUSE_PIO2" "-DMPAS_NO_ESMF_INIT" "-DMPAS_ESM_SHR_CONST" "-DMPAS_PERF_MOD_TIMERS" "${MODEL_FORMULATION}" "${FILE_OFFSET}" "${ZOLTAN_DEFINE}" "-D_MPI" "-DMPAS_NAMELIST_SUFFIX=${NAMELIST_SUFFIX}" "-DMPAS_EXE_NAME=${EXE_NAME}") -if (DEBUG) - list(APPEND CPPDEFS "-DMPAS_DEBUG") -endif() -if (compile_threaded) - list(APPEND CPPDEFS "-DMPAS_OPENMP") -endif() - -set(INCLUDES "${INSTALL_SHAREDPATH}/include" "${INSTALL_SHAREDPATH}/${COMP_INTERFACE}/${ESMFDIR}/${NINST_VALUE}/csm_share" "${INSTALL_SHAREDPATH}/pio" "${PNETCDF_PATH}/include" "${CMAKE_CURRENT_SOURCE_DIR}/external/ezxml" "${CMAKE_BINARY_DIR}/framework" "${CMAKE_BINARY_DIR}/operators") -if (NETCDF_PATH) - list(APPEND INCLUDES ${NETCDF_PATH}/include) -else() - if (NETCDF_C_PATH) - list(APPEND INCLUDES ${NETCDF_C_PATH}/include) - endif() - if (NETCDF_FORTRAN_PATH) - list(APPEND INCLUDES ${NETCDF_FORTRAN_PATH}/include) - endif() -endif() - -if (USE_KOKKOS) - include(${INSTALL_SHAREDPATH}/kokkos_generated_settings.cmake) - string (REPLACE ";" " " KOKKOS_CXXFLAGS_STR "${KOKKOS_CXXFLAGS}") - set(CXXFLAGS "${CXXFLAGS} ${KOKKOS_CXXFLAGS_STR}") -endif() - -set(CMAKE_Fortran_FLAGS "${FFLAGS}") -set(CMAKE_C_FLAGS "${CFLAGS}") -set(CMAKE_CXX_FLAGS "${CXXFLAGS}") - -# Include custom cmake libraries used for mpas -include(${CMAKE_CURRENT_SOURCE_DIR}/cmake_utils.cmake) -include(${CMAKE_CURRENT_SOURCE_DIR}/build_core.cmake) - -# Add tools -add_subdirectory(tools) - -# Gather sources that are needed for all cores into "common" library - -set(COMMON_RAW_SOURCES external/ezxml/ezxml.c) -include(${CMAKE_CURRENT_SOURCE_DIR}/framework/framework.cmake) -include(${CMAKE_CURRENT_SOURCE_DIR}/operators/operators.cmake) - -add_library(common OBJECT) -target_compile_definitions(common PRIVATE ${CPPDEFS}) -target_include_directories(common PRIVATE ${INCLUDES}) - -genf90_targets("${COMMON_RAW_SOURCES}" "${INCLUDES}" "${CPPDEFS}" "" "") -target_sources(common PRIVATE ${SOURCES}) - -# Build cores! -foreach(CORE IN LISTS CORES) - build_core(${CORE}) -endforeach() diff --git a/src/build_core.cmake b/src/build_core.cmake deleted file mode 100644 index c2c36464cb..0000000000 --- a/src/build_core.cmake +++ /dev/null @@ -1,67 +0,0 @@ -function(build_core CORE) - set(EXE_NAME ${CORE}_model) - set(NAMELIST_SUFFIX ${CORE}) - - # Map the ESM component corresponding to each MPAS core - if (CORE STREQUAL "ocean") - set(COMPONENT "ocn") - elseif(CORE STREQUAL "landice") - set(COMPONENT "glc") - elseif(CORE STREQUAL "seaice") - set(COMPONENT "ice") - else() - message(FATAL_ERROR "Unrecognized core: ${CORE}") - endif() - - # Gather sources - set(CORE_BLDDIR ${CMAKE_BINARY_DIR}/core_${CORE}) - if (NOT EXISTS ${CORE_BLDDIR}) - file(MAKE_DIRECTORY ${CORE_BLDDIR}) - endif() - - set(CORE_INPUT_DIR ${CORE_BLDDIR}/default_inputs) - if (NOT EXISTS ${CORE_INPUT_DIR}) - file(MAKE_DIRECTORY ${CORE_INPUT_DIR}) - endif() - - # Provides us RAW_SOURCES, CPPDEFS, and INCLUDES - include(${CMAKE_CURRENT_SOURCE_DIR}/core_${CORE}/${CORE}.cmake) - - add_library(${COMPONENT}) - target_compile_definitions(${COMPONENT} PRIVATE ${CPPDEFS}) - target_include_directories(${COMPONENT} PRIVATE ${INCLUDES}) - - # Make .inc files - add_custom_command ( - OUTPUT ${CORE_BLDDIR}/Registry_processed.xml - COMMAND cpp -P -traditional ${CPPDEFS} -Uvector - ${CMAKE_CURRENT_SOURCE_DIR}/core_${CORE}/Registry.xml > Registry_processed.xml - DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/core_${CORE}/Registry.xml - WORKING_DIRECTORY ${CORE_BLDDIR} - ) - - set(INC_DIR ${CORE_BLDDIR}/inc) - if (NOT EXISTS ${INC_DIR}) - file(MAKE_DIRECTORY ${INC_DIR}) - endif() - - add_custom_command( - OUTPUT ${INC_DIR}/core_variables.inc - COMMAND ${CMAKE_BINARY_DIR}/mpas-source/src/tools/parse < ${CORE_BLDDIR}/Registry_processed.xml - DEPENDS parse ${CORE_BLDDIR}/Registry_processed.xml - WORKING_DIRECTORY ${INC_DIR} - ) - - # Disable qsmp for some files - if (FFLAGS MATCHES ".*-qsmp.*") - foreach(DISABLE_QSMP_FILE IN LISTS DISABLE_QSMP) - get_filename_component(SOURCE_EXT ${DISABLE_QSMP_FILE} EXT) - string(REPLACE "${SOURCE_EXT}" ".f90" SOURCE_F90 ${DISABLE_QSMP_FILE}) - set_property(SOURCE ${CMAKE_BINARY_DIR}/${SOURCE_F90} APPEND_STRING PROPERTY COMPILE_FLAGS " -qnosmp") - endforeach() - endif() - - genf90_targets("${RAW_SOURCES}" "${INCLUDES}" "${CPPDEFS}" "${NO_PREPROCESS}" "${INC_DIR}") - target_sources(${COMPONENT} PRIVATE ${SOURCES} $) - -endfunction(build_core) diff --git a/src/cmake_utils.cmake b/src/cmake_utils.cmake deleted file mode 100644 index c3a25f238d..0000000000 --- a/src/cmake_utils.cmake +++ /dev/null @@ -1,74 +0,0 @@ -# Function for handling nl and st gen -function(handle_st_nl_gen NL_GEN_ARGS ST_GEN_ARGS CORE_INPUT_DIR_ARG CORE_BLDDIR_ARG) - foreach(NL_GEN_ARG IN LISTS NL_GEN_ARGS) - separate_arguments(ITEMS UNIX_COMMAND "${NL_GEN_ARG}") - list(GET ITEMS 0 ITEM) - list(APPEND INPUTS ${ITEM}) - add_custom_command( - OUTPUT ${CORE_INPUT_DIR_ARG}/${ITEM} - COMMAND ${CMAKE_BINARY_DIR}/tools/namelist_gen ${CORE_BLDDIR_ARG}/Registry_processed.xml ${NL_GEN_ARG} - DEPENDS namelist_gen ${CORE_BLDDIR_ARG}/Registry_processed.xml - WORKING_DIRECTORY ${CORE_INPUT_DIR_ARG} - ) - endforeach() - - foreach(ST_GEN_ARG IN LISTS ST_GEN_ARGS) - separate_arguments(ITEMS UNIX_COMMAND "${ST_GEN_ARG}") - list(GET ITEMS 0 ITEM) - list(APPEND INPUTS ${ITEM}) - add_custom_command( - OUTPUT ${CORE_INPUT_DIR_ARG}/${ITEM} - COMMAND ${CMAKE_BINARY_DIR}/tools/streams_gen ${CORE_BLDDIR_ARG}/Registry_processed.xml ${ST_GEN_ARG} - DEPENDS streams_gen ${CORE_BLDDIR_ARG}/Registry_processed.xml - WORKING_DIRECTORY ${CORE_INPUT_DIR_ARG} - ) - endforeach() - - foreach(INPUT IN LISTS INPUTS) - add_custom_command( - OUTPUT ${CORE_BLDDIR_ARG}/${INPUT} - COMMAND ${CMAKE_COMMAND} -E copy ${CORE_INPUT_DIR_ARG}/${INPUT} ${CORE_BLDDIR_ARG}/${INPUT} - DEPENDS ${CORE_INPUT_DIR_ARG}/${INPUT} - WORKING_DIRECTORY ${CORE_BLDDIR_ARG} - ) - endforeach() -endfunction() - -# Function for generating f90 file targets, will add to parent's SOURCES var -function(genf90_targets RAW_SOURCES_ARG INCLUDES_ARG CPPDEFS_ARG NO_PREPROCESS_ARG CORE_INC_DIR_ARG) - # Add -I to includes so that they can used for cpp command - foreach(ITEM IN LISTS INCLUDES_ARG) - list(APPEND INCLUDES_I "-I${ITEM}") - endforeach() - - # Run all .F files through cpp to generate the f90 file - foreach(RAW_SOURCE_FILE IN LISTS RAW_SOURCES_ARG) - get_filename_component(SOURCE_EXT ${RAW_SOURCE_FILE} EXT) - if ( (SOURCE_EXT STREQUAL ".F" OR SOURCE_EXT STREQUAL ".F90") AND NOT RAW_SOURCE_FILE IN_LIST NO_PREPROCESS_ARG) - string(REPLACE "${SOURCE_EXT}" ".f90" SOURCE_F90 ${RAW_SOURCE_FILE}) - get_filename_component(DIR_RELATIVE ${SOURCE_F90} DIRECTORY) - set(DIR_ABSOLUTE ${CMAKE_BINARY_DIR}/${DIR_RELATIVE}) - if (NOT EXISTS ${DIR_ABSOLUTE}) - file(MAKE_DIRECTORY ${DIR_ABSOLUTE}) - endif() - if (CORE_INC_DIR_ARG) - add_custom_command ( - OUTPUT ${CMAKE_BINARY_DIR}/${SOURCE_F90} - COMMAND cpp -P -traditional ${CPPDEFS_ARG} ${INCLUDES_I} -Uvector - ${CMAKE_CURRENT_SOURCE_DIR}/${RAW_SOURCE_FILE} > ${CMAKE_BINARY_DIR}/${SOURCE_F90} - DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/${RAW_SOURCE_FILE} ${CORE_INC_DIR_ARG}/core_variables.inc) - else() - add_custom_command ( - OUTPUT ${CMAKE_BINARY_DIR}/${SOURCE_F90} - COMMAND cpp -P -traditional ${CPPDEFS_ARG} ${INCLUDES_I} -Uvector - ${CMAKE_CURRENT_SOURCE_DIR}/${RAW_SOURCE_FILE} > ${CMAKE_BINARY_DIR}/${SOURCE_F90}) - endif() - list(APPEND LOCAL_SOURCES ${CMAKE_BINARY_DIR}/${SOURCE_F90}) - else() - list(APPEND LOCAL_SOURCES ${RAW_SOURCE_FILE}) - endif() - endforeach() - - set(SOURCES ${LOCAL_SOURCES} PARENT_SCOPE) - -endfunction(genf90_targets) diff --git a/src/core_landice/landice.cmake b/src/core_landice/landice.cmake deleted file mode 100644 index 0d580d7800..0000000000 --- a/src/core_landice/landice.cmake +++ /dev/null @@ -1,79 +0,0 @@ - -# build_options.mk stuff handled here -list(APPEND CPPDEFS "-DCORE_LANDICE") -list(APPEND INCLUDES "${CMAKE_BINARY_DIR}/core_landice/shared" "${CMAKE_BINARY_DIR}/core_landice/analysis_members" "${CMAKE_BINARY_DIR}/core_landice/mode_forward") - -# -# Check if building with LifeV, Albany, and/or PHG external libraries -# - -if (LIFEV) - # LifeV can solve L1L2 or FO - list(APPEND CPPDEFS "-DLIFEV" "-DUSE_EXTERNAL_L1L2" "-DUSE_EXTERNAL_FIRSTORDER" "-DMPAS_LI_BUILD_INTERFACE") -endif() - -# Albany can only solve FO at present -if (ALBANY) - list(APPEND CPPDEFS "-DUSE_EXTERNAL_FIRSTORDER" "-DMPAS_LI_BUILD_INTERFACE") -endif() - -if (LIFEV AND ALBANY) - message(FATAL "Compiling with both LifeV and Albany is not allowed at this time.") -endif() - -# PHG currently requires LifeV -if (PHG AND NOT LIFEV) - message(FATAL "Compiling with PHG requires LifeV at this time.") -endif() - -# PHG can only Stokes at present -if (PHG) - list(APPEND CPPDEFS "-DUSE_EXTERNAL_STOKES" "-DMPAS_LI_BUILD_INTERFACE") -endif() - -# driver (files live in E3SM) -list(APPEND RAW_SOURCES - ../../mpas-albany-landice/driver/glc_comp_mct.F - ../../mpas-albany-landice/driver/glc_cpl_indices.F - ../../mpas-albany-landice/driver/glc_mct_vars.F -) - -# shared -list(APPEND RAW_SOURCES - core_landice/shared/mpas_li_constants.F - core_landice/shared/mpas_li_mask.F - core_landice/shared/mpas_li_setup.F -) - -# analysis members -list(APPEND RAW_SOURCES - core_landice/analysis_members/mpas_li_analysis_driver.F - core_landice/analysis_members/mpas_li_global_stats.F - core_landice/analysis_members/mpas_li_regional_stats.F -) - -# mode forward -list(APPEND RAW_SOURCES - core_landice/mode_forward/mpas_li_core.F - core_landice/mode_forward/mpas_li_core_interface.F - core_landice/mode_forward/mpas_li_time_integration.F - core_landice/mode_forward/mpas_li_time_integration_fe.F - core_landice/mode_forward/mpas_li_diagnostic_vars.F - core_landice/mode_forward/mpas_li_advection.F - core_landice/mode_forward/mpas_li_calving.F - core_landice/mode_forward/mpas_li_statistics.F - core_landice/mode_forward/mpas_li_velocity.F - core_landice/mode_forward/mpas_li_thermal.F - core_landice/mode_forward/mpas_li_iceshelf_melt.F - core_landice/mode_forward/mpas_li_sia.F - core_landice/mode_forward/mpas_li_velocity_simple.F - core_landice/mode_forward/mpas_li_velocity_external.F - core_landice/mode_forward/mpas_li_subglacial_hydro.F -) - -if (CPPDEFS MATCHES ".*MPAS_LI_BUILD_INTERFACE.*") - list(APPEND RAW_SOURCES core_landice/mode_forward/Interface_velocity_solver.cpp) -endif() - -# Generate core input -handle_st_nl_gen("namelist.landice" "streams.landice stream_list.landice. listed" ${CORE_INPUT_DIR} ${CORE_BLDDIR}) diff --git a/src/core_ocean/ocean.cmake b/src/core_ocean/ocean.cmake deleted file mode 100644 index 287dbb523b..0000000000 --- a/src/core_ocean/ocean.cmake +++ /dev/null @@ -1,207 +0,0 @@ - -# build_options.mk stuff handled here -list(APPEND CPPDEFS "-DCORE_OCEAN") -list(APPEND INCLUDES "${CMAKE_BINARY_DIR}/core_ocean/BGC" "${CMAKE_BINARY_DIR}/core_ocean/shared" "${CMAKE_BINARY_DIR}/core_ocean/analysis_members" "${CMAKE_BINARY_DIR}/core_ocean/cvmix" "${CMAKE_BINARY_DIR}/core_ocean/mode_forward" "${CMAKE_BINARY_DIR}/core_ocean/mode_analysis" "${CMAKE_BINARY_DIR}/core_ocean/mode_init") - -# driver (files live in E3SM) -list(APPEND RAW_SOURCES - ../../mpas-ocean/driver/ocn_comp_mct.F - ../../mpas-ocean/driver/mpaso_cpl_indices.F - ../../mpas-ocean/driver/mpaso_mct_vars.F -) - -# dycore -list(APPEND RAW_SOURCES - core_ocean/mode_forward/mpas_ocn_forward_mode.F - core_ocean/mode_forward/mpas_ocn_time_integration.F - core_ocean/mode_forward/mpas_ocn_time_integration_rk4.F - core_ocean/mode_forward/mpas_ocn_time_integration_split.F - - core_ocean/mode_analysis/mpas_ocn_analysis_mode.F - - core_ocean/mode_init/mpas_ocn_init_mode.F - core_ocean/mode_init/mpas_ocn_init_spherical_utils.F - core_ocean/mode_init/mpas_ocn_init_vertical_grids.F - core_ocean/mode_init/mpas_ocn_init_cell_markers.F - core_ocean/mode_init/mpas_ocn_init_interpolation.F - core_ocean/mode_init/mpas_ocn_init_ssh_and_landIcePressure.F - core_ocean/mode_init/mpas_ocn_init_baroclinic_channel.F - core_ocean/mode_init/mpas_ocn_init_lock_exchange.F - core_ocean/mode_init/mpas_ocn_init_dam_break.F - core_ocean/mode_init/mpas_ocn_init_internal_waves.F - core_ocean/mode_init/mpas_ocn_init_overflow.F - core_ocean/mode_init/mpas_ocn_init_cvmix_WSwSBF.F - core_ocean/mode_init/mpas_ocn_init_iso.F - core_ocean/mode_init/mpas_ocn_init_soma.F - core_ocean/mode_init/mpas_ocn_init_ziso.F - core_ocean/mode_init/mpas_ocn_init_sub_ice_shelf_2D.F - core_ocean/mode_init/mpas_ocn_init_periodic_planar.F - core_ocean/mode_init/mpas_ocn_init_ecosys_column.F - core_ocean/mode_init/mpas_ocn_init_sea_mount.F - core_ocean/mode_init/mpas_ocn_init_global_ocean.F - core_ocean/mode_init/mpas_ocn_init_isomip.F - core_ocean/mode_init/mpas_ocn_init_hurricane.F - core_ocean/mode_init/mpas_ocn_init_isomip_plus.F - core_ocean/mode_init/mpas_ocn_init_tidal_boundary.F - - core_ocean/shared/mpas_ocn_init_routines.F - core_ocean/shared/mpas_ocn_gm.F - core_ocean/shared/mpas_ocn_diagnostics.F - core_ocean/shared/mpas_ocn_diagnostics_routines.F - core_ocean/shared/mpas_ocn_thick_ale.F - core_ocean/shared/mpas_ocn_equation_of_state.F - core_ocean/shared/mpas_ocn_equation_of_state_jm.F - core_ocean/shared/mpas_ocn_equation_of_state_linear.F - core_ocean/shared/mpas_ocn_thick_hadv.F - core_ocean/shared/mpas_ocn_thick_vadv.F - core_ocean/shared/mpas_ocn_thick_surface_flux.F - core_ocean/shared/mpas_ocn_vel_hadv_coriolis.F - core_ocean/shared/mpas_ocn_vel_vadv.F - core_ocean/shared/mpas_ocn_vel_hmix.F - core_ocean/shared/mpas_ocn_vel_hmix_del2.F - core_ocean/shared/mpas_ocn_vel_hmix_leith.F - core_ocean/shared/mpas_ocn_vel_hmix_del4.F - core_ocean/shared/mpas_ocn_vel_forcing.F - core_ocean/shared/mpas_ocn_vel_forcing_surface_stress.F - core_ocean/shared/mpas_ocn_vel_forcing_explicit_bottom_drag.F - core_ocean/shared/mpas_ocn_vel_pressure_grad.F - core_ocean/shared/mpas_ocn_vmix.F - core_ocean/shared/mpas_ocn_vmix_coefs_const.F - core_ocean/shared/mpas_ocn_vmix_coefs_rich.F - core_ocean/shared/mpas_ocn_vmix_coefs_tanh.F - core_ocean/shared/mpas_ocn_vmix_coefs_redi.F - core_ocean/shared/mpas_ocn_vmix_cvmix.F - core_ocean/shared/mpas_ocn_tendency.F - core_ocean/shared/mpas_ocn_tracer_hmix.F - core_ocean/shared/mpas_ocn_tracer_hmix_del2.F - core_ocean/shared/mpas_ocn_tracer_hmix_del4.F - core_ocean/shared/mpas_ocn_tracer_hmix_redi.F - core_ocean/shared/mpas_ocn_tracer_advection.F - core_ocean/shared/mpas_ocn_tracer_advection_mono.F - core_ocean/shared/mpas_ocn_tracer_advection_std.F - core_ocean/shared/mpas_ocn_tracer_nonlocalflux.F - core_ocean/shared/mpas_ocn_tracer_short_wave_absorption.F - core_ocean/shared/mpas_ocn_tracer_short_wave_absorption_jerlov.F - core_ocean/shared/mpas_ocn_tracer_short_wave_absorption_variable.F - core_ocean/shared/mpas_ocn_tracer_surface_restoring.F - core_ocean/shared/mpas_ocn_tracer_interior_restoring.F - core_ocean/shared/mpas_ocn_tracer_exponential_decay.F - core_ocean/shared/mpas_ocn_tracer_ideal_age.F - core_ocean/shared/mpas_ocn_tracer_TTD.F - core_ocean/shared/mpas_ocn_tracer_ecosys.F - core_ocean/shared/mpas_ocn_tracer_DMS.F - core_ocean/shared/mpas_ocn_tracer_MacroMolecules.F - core_ocean/shared/mpas_ocn_high_freq_thickness_hmix_del2.F - core_ocean/shared/mpas_ocn_tracer_surface_flux_to_tend.F - core_ocean/shared/mpas_ocn_test.F - core_ocean/shared/mpas_ocn_constants.F - core_ocean/shared/mpas_ocn_forcing.F - core_ocean/shared/mpas_ocn_surface_bulk_forcing.F - core_ocean/shared/mpas_ocn_surface_land_ice_fluxes.F - core_ocean/shared/mpas_ocn_effective_density_in_land_ice.F - core_ocean/shared/mpas_ocn_frazil_forcing.F - core_ocean/shared/mpas_ocn_tidal_forcing.F - core_ocean/shared/mpas_ocn_time_average_coupled.F - core_ocean/shared/mpas_ocn_sea_ice.F - core_ocean/shared/mpas_ocn_framework_forcing.F - core_ocean/shared/mpas_ocn_time_varying_forcing.F - core_ocean/shared/mpas_ocn_wetting_drying.F - core_ocean/shared/mpas_ocn_tidal_potential_forcing.F -) - -set(OCEAN_DRIVER - core_ocean/driver/mpas_ocn_core.F - core_ocean/driver/mpas_ocn_core_interface.F -) -list(APPEND RAW_SOURCES ${OCEAN_DRIVER}) -list(APPEND DISABLE_QSMP ${OCEAN_DRIVER}) - -# Get CVMix -execute_process(COMMAND ${CMAKE_CURRENT_SOURCE_DIR}/core_ocean/get_cvmix.sh - WORKING_DIRECTORY ${CORE_BLDDIR}) - -# Get BGC -execute_process(COMMAND ${CMAKE_CURRENT_SOURCE_DIR}/core_ocean/get_BGC.sh - WORKING_DIRECTORY ${CORE_BLDDIR}) - -# Add CVMix -set(CVMIX_FILES - ${CORE_BLDDIR}/cvmix/cvmix_kinds_and_types.F90 - ${CORE_BLDDIR}/cvmix/cvmix_background.F90 - ${CORE_BLDDIR}/cvmix/cvmix_convection.F90 - ${CORE_BLDDIR}/cvmix/cvmix_ddiff.F90 - ${CORE_BLDDIR}/cvmix/cvmix_kpp.F90 - ${CORE_BLDDIR}/cvmix/cvmix_math.F90 - ${CORE_BLDDIR}/cvmix/cvmix_put_get.F90 - ${CORE_BLDDIR}/cvmix/cvmix_shear.F90 - ${CORE_BLDDIR}/cvmix/cvmix_tidal.F90 - ${CORE_BLDDIR}/cvmix/cvmix_utils.F90 -) - -# Add BGC -set(BGC_FILES - ${CORE_BLDDIR}/BGC/BGC_mod.F90 - ${CORE_BLDDIR}/BGC/BGC_parms.F90 - ${CORE_BLDDIR}/BGC/DMS_mod.F90 - ${CORE_BLDDIR}/BGC/DMS_parms.F90 - ${CORE_BLDDIR}/BGC/MACROS_mod.F90 - ${CORE_BLDDIR}/BGC/MACROS_parms.F90 - ${CORE_BLDDIR}/BGC/co2calc.F90 -) - -list(APPEND RAW_SOURCES ${CVMIX_FILES} ${BGC_FILES}) -list(APPEND NO_PREPROCESS ${CVMIX_FILES} ${BGC_FILES}) - -# Add analysis members -list(APPEND RAW_SOURCES - core_ocean/analysis_members/mpas_ocn_global_stats.F - core_ocean/analysis_members/mpas_ocn_okubo_weiss.F - core_ocean/analysis_members/mpas_ocn_okubo_weiss_eigenvalues.c - core_ocean/analysis_members/mpas_ocn_layer_volume_weighted_averages.F - core_ocean/analysis_members/mpas_ocn_surface_area_weighted_averages.F - core_ocean/analysis_members/mpas_ocn_water_mass_census.F - core_ocean/analysis_members/mpas_ocn_meridional_heat_transport.F - core_ocean/analysis_members/mpas_ocn_test_compute_interval.F - core_ocean/analysis_members/mpas_ocn_high_frequency_output.F - core_ocean/analysis_members/mpas_ocn_zonal_mean.F - core_ocean/analysis_members/mpas_ocn_lagrangian_particle_tracking_interpolations.F - core_ocean/analysis_members/mpas_ocn_particle_list.F - core_ocean/analysis_members/mpas_ocn_lagrangian_particle_tracking_reset.F - core_ocean/analysis_members/mpas_ocn_lagrangian_particle_tracking.F - core_ocean/analysis_members/mpas_ocn_eliassen_palm.F - core_ocean/analysis_members/mpas_ocn_time_filters.F - core_ocean/analysis_members/mpas_ocn_mixed_layer_depths.F - core_ocean/analysis_members/mpas_ocn_pointwise_stats.F - core_ocean/analysis_members/mpas_ocn_debug_diagnostics.F - core_ocean/analysis_members/mpas_ocn_time_series_stats.F - core_ocean/analysis_members/mpas_ocn_regional_stats.F - core_ocean/analysis_members/mpas_ocn_rpn_calculator.F - core_ocean/analysis_members/mpas_ocn_transect_transport.F - core_ocean/analysis_members/mpas_ocn_eddy_product_variables.F - core_ocean/analysis_members/mpas_ocn_moc_streamfunction.F - core_ocean/analysis_members/mpas_ocn_analysis_driver.F -) - -# add accelerator/gpu flags -list(APPEND ADD_ACC_FLAGS - core_ocean/shared/mpas_ocn_equation_of_state_jm.f90 - core_ocean/shared/mpas_ocn_mesh.f90 - core_ocean/shared/mpas_ocn_surface_bulk_forcing.f90 - core_ocean/shared/mpas_ocn_surface_land_ice_fluxes.f90 - core_ocean/shared/mpas_ocn_tendency.f90 - core_ocean/shared/mpas_ocn_vel_forcing_explicit_bottom_drag.f90 - core_ocean/shared/mpas_ocn_vel_forcing_surface_stress.f90 - core_ocean/shared/mpas_ocn_vel_hadv_coriolis.f90 - core_ocean/shared/mpas_ocn_vel_hmix_del2.f90 - core_ocean/shared/mpas_ocn_vel_hmix_del4.f90 - core_ocean/shared/mpas_ocn_vel_hmix_leith.f90 - core_ocean/shared/mpas_ocn_vel_pressure_grad.f90 - core_ocean/shared/mpas_ocn_vel_vadv.f90 -) - -# Generate core input -handle_st_nl_gen( - "namelist.ocean;namelist.ocean.forward mode=forward;namelist.ocean.analysis mode=analysis;namelist.ocean.init mode=init" - "streams.ocean stream_list.ocean. mutable;streams.ocean.forward stream_list.ocean.forward. mutable mode=forward;streams.ocean.analysis stream_list.ocean.analysis. mutable mode=analysis;streams.ocean.init stream_list.ocean.init. mutable mode=init" - ${CORE_INPUT_DIR} ${CORE_BLDDIR} -) diff --git a/src/core_seaice/seaice.cmake b/src/core_seaice/seaice.cmake deleted file mode 100644 index 0ac2b0dd49..0000000000 --- a/src/core_seaice/seaice.cmake +++ /dev/null @@ -1,108 +0,0 @@ - -# build_options.mk stuff handled here -list(APPEND CPPDEFS "-DCORE_SEAICE" "-Dcoupled" "-DCCSMCOUPLED") -list(APPEND INCLUDES "${CMAKE_BINARY_DIR}/core_seaice/column" "${CMAKE_BINARY_DIR}/core_seaice/shared" "${CMAKE_BINARY_DIR}/core_seaice/analysis_members" "${CMAKE_BINARY_DIR}/core_seaice/model_forward") - - -# driver (files live in E3SM) -list(APPEND RAW_SOURCES - ../../mpas-seaice/driver/ice_comp_mct.F - ../../mpas-seaice/driver/mpassi_cpl_indices.F - ../../mpas-seaice/driver/mpassi_mct_vars.F -) - -# column -list(APPEND RAW_SOURCES - core_seaice/column/ice_colpkg.F90 - core_seaice/column/ice_kinds_mod.F90 - core_seaice/column/ice_warnings.F90 - core_seaice/column/ice_colpkg_shared.F90 - core_seaice/column/constants/cesm/ice_constants_colpkg.F90 - core_seaice/column/ice_therm_shared.F90 - core_seaice/column/ice_orbital.F90 - core_seaice/column/ice_mushy_physics.F90 - core_seaice/column/ice_therm_mushy.F90 - core_seaice/column/ice_atmo.F90 - core_seaice/column/ice_age.F90 - core_seaice/column/ice_firstyear.F90 - core_seaice/column/ice_flux_colpkg.F90 - core_seaice/column/ice_meltpond_cesm.F90 - core_seaice/column/ice_meltpond_lvl.F90 - core_seaice/column/ice_meltpond_topo.F90 - core_seaice/column/ice_therm_vertical.F90 - core_seaice/column/ice_therm_bl99.F90 - core_seaice/column/ice_therm_0layer.F90 - core_seaice/column/ice_itd.F90 - core_seaice/column/ice_colpkg_tracers.F90 - core_seaice/column/ice_therm_itd.F90 - core_seaice/column/ice_shortwave.F90 - core_seaice/column/ice_mechred.F90 - core_seaice/column/ice_aerosol.F90 - core_seaice/column/ice_brine.F90 - core_seaice/column/ice_algae.F90 - core_seaice/column/ice_zbgc.F90 - core_seaice/column/ice_zbgc_shared.F90 - core_seaice/column/ice_zsalinity.F90 - core_seaice/column/ice_snow.F90 -) - -# shared -list(APPEND RAW_SOURCES - core_seaice/shared/mpas_seaice_time_integration.F - core_seaice/shared/mpas_seaice_advection_incremental_remap_tracers.F - core_seaice/shared/mpas_seaice_advection_incremental_remap.F - core_seaice/shared/mpas_seaice_advection_upwind.F - core_seaice/shared/mpas_seaice_advection.F - core_seaice/shared/mpas_seaice_velocity_solver_unit_tests.F - core_seaice/shared/mpas_seaice_velocity_solver.F - core_seaice/shared/mpas_seaice_velocity_solver_weak.F - core_seaice/shared/mpas_seaice_velocity_solver_variational.F - core_seaice/shared/mpas_seaice_velocity_solver_wachspress.F - core_seaice/shared/mpas_seaice_velocity_solver_pwl.F - core_seaice/shared/mpas_seaice_velocity_solver_variational_shared.F - core_seaice/shared/mpas_seaice_velocity_solver_constitutive_relation.F - core_seaice/shared/mpas_seaice_forcing.F - core_seaice/shared/mpas_seaice_initialize.F - core_seaice/shared/mpas_seaice_testing.F - core_seaice/shared/mpas_seaice_unit_test.F - core_seaice/shared/mpas_seaice_mesh.F - core_seaice/shared/mpas_seaice_diagnostics.F - core_seaice/shared/mpas_seaice_numerics.F - core_seaice/shared/mpas_seaice_constants.F - core_seaice/shared/mpas_seaice_column.F - core_seaice/shared/mpas_seaice_diagnostics.F - core_seaice/shared/mpas_seaice_error.F -) - -# analysis members -list(APPEND RAW_SOURCES - core_seaice/analysis_members/mpas_seaice_analysis_driver.F - core_seaice/analysis_members/mpas_seaice_high_frequency_output.F - core_seaice/analysis_members/mpas_seaice_temperatures.F - core_seaice/analysis_members/mpas_seaice_regional_statistics.F - core_seaice/analysis_members/mpas_seaice_ridging_diagnostics.F - core_seaice/analysis_members/mpas_seaice_conservation_check.F - core_seaice/analysis_members/mpas_seaice_geographical_vectors.F - core_seaice/analysis_members/mpas_seaice_ice_present.F - core_seaice/analysis_members/mpas_seaice_time_series_stats.F - core_seaice/analysis_members/mpas_seaice_load_balance.F - core_seaice/analysis_members/mpas_seaice_maximum_ice_presence.F - core_seaice/analysis_members/mpas_seaice_miscellaneous.F - core_seaice/analysis_members/mpas_seaice_area_variables.F - core_seaice/analysis_members/mpas_seaice_pond_diagnostics.F - core_seaice/analysis_members/mpas_seaice_deactivate_unneeded_fields.F - core_seaice/analysis_members/mpas_seaice_pointwise_stats.F - core_seaice/analysis_members/mpas_seaice_unit_conversion.F - core_seaice/analysis_members/mpas_seaice_ice_shelves.F -) - -# model_forward (DISABLE qsmp for these) -set(SEAICE_MODEL_FORWARD - core_seaice/model_forward/mpas_seaice_core.F - core_seaice/model_forward/mpas_seaice_core_interface.F -) -list(APPEND RAW_SOURCES ${SEAICE_MODEL_FORWARD}) -list(APPEND DISABLE_QSMP ${SEAICE_MODEL_FORWARD}) - -# Generate core input -handle_st_nl_gen("namelist.seaice" "streams.seaice stream_list.seaice. listed" ${CORE_INPUT_DIR} ${CORE_BLDDIR}) diff --git a/src/framework/framework.cmake b/src/framework/framework.cmake deleted file mode 100644 index 1906dbe8cb..0000000000 --- a/src/framework/framework.cmake +++ /dev/null @@ -1,36 +0,0 @@ -# framework -list(APPEND COMMON_RAW_SOURCES - framework/mpas_kind_types.F - framework/mpas_framework.F - framework/mpas_timer.F - framework/mpas_timekeeping.F - framework/mpas_constants.F - framework/mpas_attlist.F - framework/mpas_hash.F - framework/mpas_sort.F - framework/mpas_block_decomp.F - framework/mpas_block_creator.F - framework/mpas_dmpar.F - framework/mpas_abort.F - framework/mpas_decomp.F - framework/mpas_threading.F - framework/mpas_io.F - framework/mpas_io_streams.F - framework/mpas_bootstrapping.F - framework/mpas_io_units.F - framework/mpas_stream_manager.F - framework/mpas_stream_list.F - framework/mpas_forcing.F - framework/mpas_c_interfacing.F - framework/random_id.c - framework/pool_hash.c - framework/mpas_derived_types.F - framework/mpas_domain_routines.F - framework/mpas_field_routines.F - framework/mpas_pool_routines.F - framework/xml_stream_parser.c - framework/regex_matching.c - framework/mpas_field_accessor.F - framework/mpas_log.F - framework/mpas_string_utils.F -) diff --git a/src/operators/operators.cmake b/src/operators/operators.cmake deleted file mode 100644 index d65c7c661e..0000000000 --- a/src/operators/operators.cmake +++ /dev/null @@ -1,13 +0,0 @@ -# operators -list(APPEND COMMON_RAW_SOURCES - operators/mpas_vector_operations.F - operators/mpas_matrix_operations.F - operators/mpas_tensor_operations.F - operators/mpas_rbf_interpolation.F - operators/mpas_vector_reconstruction.F - operators/mpas_spline_interpolation.F - operators/mpas_tracer_advection_helpers.F - operators/mpas_tracer_advection_mono.F - operators/mpas_tracer_advection_std.F - operators/mpas_geometry_utils.F -) diff --git a/src/tools/CMakeLists.txt b/src/tools/CMakeLists.txt deleted file mode 100644 index 513ae48cf1..0000000000 --- a/src/tools/CMakeLists.txt +++ /dev/null @@ -1,30 +0,0 @@ - -if (DEFINED ENV{MPAS_TOOL_DIR}) - message(STATUS "*** Using MPAS tools from $ENV{MPAS_TOOL_DIR} ***") - add_custom_target(namelist_gen) - add_custom_command( - TARGET namelist_gen PRE_BUILD - COMMAND ${CMAKE_COMMAND} -E copy $ENV{MPAS_TOOL_DIR}/input_gen/namelist_gen ${CMAKE_CURRENT_BINARY_DIR}/namelist_gen) - add_custom_target(streams_gen) - add_custom_command( - TARGET streams_gen PRE_BUILD - COMMAND ${CMAKE_COMMAND} -E copy $ENV{MPAS_TOOL_DIR}/input_gen/streams_gen ${CMAKE_CURRENT_BINARY_DIR}/streams_gen) - add_custom_target(parse) - add_custom_command( - TARGET parse PRE_BUILD - COMMAND ${CMAKE_COMMAND} -E copy $ENV{MPAS_TOOL_DIR}/input_gen/parse ${CMAKE_CURRENT_BINARY_DIR}/parse) -else() - message(STATUS "*** Building MPAS tools from source ***") - # Make build tools, need to be compiled with serial compiler. - set(CMAKE_C_COMPILER ${SCC}) - - add_executable(streams_gen input_gen/streams_gen.c input_gen/test_functions.c ../external/ezxml/ezxml.c) - add_executable(namelist_gen input_gen/namelist_gen.c input_gen/test_functions.c ../external/ezxml/ezxml.c) - add_executable(parse registry/parse.c registry/dictionary.c registry/gen_inc.c registry/fortprintf.c registry/utility.c ../external/ezxml/ezxml.c) - - foreach(EXEITEM streams_gen namelist_gen parse) - target_compile_definitions(${EXEITEM} PRIVATE ${CPPDEFS}) - target_compile_options(${EXEITEM} PRIVATE "-Uvector") - target_include_directories(${EXEITEM} PRIVATE ${INCLUDES}) - endforeach() -endif() From 4e960c9785e01dc472502f0dc60f0ec529dcc71d Mon Sep 17 00:00:00 2001 From: Matthew Dimond Date: Mon, 31 Jul 2023 11:57:42 -0600 Subject: [PATCH 08/86] mpas_split_string now trims strings before splitting This commit adds a step to the mpas_split_string subroutine. In the process of adding tests, it was discovered that splitting a string while using a space as a delimiter causes the string to be split on every trailing space, leading to a splitStrings array that is equal to the size of the untrimmed input string, minus the number of non-space characters, plus one. This behavior is unwanted. This has been solved by trimming off trailing spaces before splitting the string. --- src/framework/mpas_string_utils.F | 78 +++++++++++++++++-------------- 1 file changed, 42 insertions(+), 36 deletions(-) diff --git a/src/framework/mpas_string_utils.F b/src/framework/mpas_string_utils.F index fe503dc606..b768522578 100644 --- a/src/framework/mpas_string_utils.F +++ b/src/framework/mpas_string_utils.F @@ -17,50 +17,56 @@ !----------------------------------------------------------------------- module mpas_string_utils - contains + contains - !----------------------------------------------------------------------- - ! routine mpas_split_string - ! - !> \brief This routine splits a string on a specified delimiting character - !> \author Michael Duda, Doug Jacobsen - !> \date 07/23/2014 - !> \details This routine splits the given "string" on the delimiter - !> character, and returns an array of pointers to the substrings - !> between the delimiting characters. - ! - !----------------------------------------------------------------------- - subroutine mpas_split_string(string, delimiter, subStrings) + !----------------------------------------------------------------------- + ! routine mpas_split_string + ! + !> \brief This routine splits a string on a specified delimiting character + !> \author Michael Duda, Doug Jacobsen + !> \date 07/23/2014 + !> \details This routine splits the given "string" on the delimiter + !> character, and returns an array of pointers to the substrings + !> between the delimiting characters. Strings are trimmed before + !> splitting such that all trailing whitespace is ignored. + ! + !----------------------------------------------------------------------- + subroutine mpas_split_string(string, delimiter, subStrings) - implicit none + implicit none - character(len=*), intent(in) :: string - character, intent(in) :: delimiter - character(len=*), pointer, dimension(:) :: subStrings + ! Arguments + character(len=*), intent(in) :: string + character, intent(in) :: delimiter + character(len=*), pointer, dimension(:) :: subStrings - integer :: i, start, index + ! Local variables + character(len=len_trim(string)) :: trimString + integer :: i, start, index - index = 1 - do i = 1, len(string) - if(string(i:i) == delimiter) then - index = index + 1 - end if - end do + trimString = trim(string) + index = 1 - allocate(subStrings(1:index)) + do i = 1, len(trimString) + if (trimString(i:i) == delimiter) then + index = index + 1 + end if + end do - start = 1 - index = 1 - do i = 1, len(string) - if (string(i:i) == delimiter) then - subStrings(index) = string(start:i-1) - index = index + 1 - start = i + 1 - end if - end do - subStrings(index) = string(start:len(string)) + allocate(subStrings(1:index)) - end subroutine mpas_split_string + start = 1 + index = 1 + do i = 1, len(trimString) + if (trimString(i:i) == delimiter) then + subStrings(index) = trimString(start:i-1) + index = index + 1 + start = i + 1 + end if + end do + subStrings(index) = trimString(start:len(trimString)) + + end subroutine mpas_split_string end module mpas_string_utils From 20799ee3eac788ef4a23df3b365fd604e108c09e Mon Sep 17 00:00:00 2001 From: Matthew Dimond Date: Thu, 27 Jul 2023 16:16:45 -0600 Subject: [PATCH 09/86] Add mpas_test_core_string_utils.F to test mpas_string_utils This commit adds the infrastructure required to test the new mpas_string_utils module. This includes adding a test file, adding some minimal tests, and adding these files to the Makefile for the test core. The tests as they stand simply test basic string splitting capability. --- src/core_test/Makefile | 6 +- src/core_test/mpas_test_core.F | 7 +- src/core_test/mpas_test_core_string_utils.F | 115 ++++++++++++++++++++ 3 files changed, 125 insertions(+), 3 deletions(-) create mode 100644 src/core_test/mpas_test_core_string_utils.F diff --git a/src/core_test/Makefile b/src/core_test/Makefile index d47059490c..eca8fb26a9 100644 --- a/src/core_test/Makefile +++ b/src/core_test/Makefile @@ -7,7 +7,8 @@ OBJS = mpas_test_core.o \ mpas_test_core_field_tests.o \ mpas_test_core_timekeeping_tests.o \ mpas_test_core_sorting.o \ - mpas_halo_testing.o + mpas_halo_testing.o \ + mpas_test_core_string_utils.o all: core_test @@ -36,7 +37,8 @@ mpas_test_core_interface.o: mpas_test_core.o mpas_test_core.o: mpas_test_core_halo_exch.o mpas_test_core_streams.o \ mpas_test_core_field_tests.o mpas_test_core_timekeeping_tests.o \ - mpas_test_core_sorting.o mpas_halo_testing.o + mpas_test_core_sorting.o mpas_halo_testing.o \ + mpas_test_core_string_utils.o mpas_test_core_halo_exch.o: diff --git a/src/core_test/mpas_test_core.F b/src/core_test/mpas_test_core.F index fc746aba48..6c4561b05f 100644 --- a/src/core_test/mpas_test_core.F +++ b/src/core_test/mpas_test_core.F @@ -93,7 +93,8 @@ function test_core_run(domain) result(iErr)!{{{ use test_core_streams, only : test_core_streams_test use test_core_sorting, only : test_core_test_sorting use mpas_halo_testing, only : mpas_halo_tests - + use test_core_string_utils, only : mpas_test_string_utils + implicit none type (domain_type), intent(inout) :: domain @@ -167,6 +168,10 @@ function test_core_run(domain) result(iErr)!{{{ call mpas_log_write('Stream I/O tests: FAILURE', MPAS_LOG_ERR) end if + ! Run string util tests + call mpas_log_write('') + call mpas_test_string_utils(iErr) + call mpas_log_write('') call test_core_test_intervals(domain, threadErrs, iErr) diff --git a/src/core_test/mpas_test_core_string_utils.F b/src/core_test/mpas_test_core_string_utils.F new file mode 100644 index 0000000000..10b245a351 --- /dev/null +++ b/src/core_test/mpas_test_core_string_utils.F @@ -0,0 +1,115 @@ +! Copyright (c) 2023, University Corporation for Atmospheric Research (UCAR) +! +! Unless noted otherwise source code is licensed under the BSD license. +! Additional copyright and license information can be found in the +! LICENSE file distributed with this code, or at +! http://mpas-dev.github.com/license.html . +! +module test_core_string_utils + + use mpas_derived_types + use mpas_log + + private + + public :: mpas_test_string_utils + + contains + + subroutine mpas_test_split_string(err) + + use mpas_string_utils, only : mpas_split_string + + implicit none + + character(len=StrKIND) :: testString + character :: delimiter + character(len=StrKIND), pointer, dimension(:) :: splitStrings + integer, intent(out) :: err + integer :: i + + err = 0 + + ! Test a basic case + delimiter = ' ' + testString = 'This is a basic test' + call mpas_split_string(testString, delimiter, splitStrings) + + if (size(splitStrings) /= 5) then + err = err + 1 + call mpas_log_write('FAILED TO SPLIT STRING #1 CORRECTLY: WRONG'//& + ' SUBSTRING COUNT', MPAS_LOG_ERR) + return + end if + + if (trim(splitStrings(1)) /= 'This' .or. & + trim(splitStrings(2)) /= 'is' .or. & + trim(splitStrings(3)) /= 'a' .or. & + trim(splitStrings(4)) /= 'basic' .or. & + trim(splitStrings(5)) /= 'test') then + err = err + 1 + call mpas_log_write('FAILED TO SPLIT STRING #1 CORRECTLY', & + MPAS_LOG_ERR) + end if + + ! Test a string without delimiters + testString = 'This-is-a-test' + call mpas_split_string(testString, delimiter, splitStrings) + + if (size(splitStrings) /= 1) then + err = err + 1 + call mpas_log_write('FAILED TO SPLIT STRING #2 CORRECTLY: WRONG'//& + ' SUBSTRING COUNT', MPAS_LOG_ERR) + return + end if + + if (trim(splitStrings(1)) /= 'This-is-a-test') then + err = err + 1 + call mpas_log_write('FAILED TO SPLIT STRING #2 CORRECTLY', & + MPAS_LOG_ERR) + end if + + ! Test a string with consecutive delimiters + testString = 'This--is-a-test' + delimiter = '-' + call mpas_split_string(testString, delimiter, splitStrings) + + if (size(splitStrings) /= 5) then + err = err + 1 + call mpas_log_write('FAILED TO SPLIT STRING #3 CORRECTLY: WRONG'//& + ' SUBSTRING COUNT', MPAS_LOG_ERR) + return + end if + + if (trim(splitStrings(1)) /= 'This' .or. & + trim(splitStrings(2)) /= '' .or. & + trim(splitStrings(3)) /= 'is' .or. & + trim(splitStrings(4)) /= 'a' .or. & + trim(splitStrings(5)) /= 'test') then + err = err + 1 + call mpas_log_write('FAILED TO SPLIT STRING #3 CORRECTLY', & + MPAS_LOG_ERR) + end if + + end subroutine mpas_test_split_string + + subroutine mpas_test_string_utils(err) + + implicit none + + integer, intent(out) :: err + + err = 0 + + call mpas_log_write('String Utils Tests') + + call mpas_test_split_string(err) + if (err == 0) then + call mpas_log_write(' mpas_split_string: SUCCESS') + else + call mpas_log_write(' mpas_split_string: FAILURE', MPAS_LOG_ERR) + end if + + end subroutine mpas_test_string_utils + +end module test_core_string_utils From e0f7f59bb65b4f5348eace79fefdbc9b750bdbdd Mon Sep 17 00:00:00 2001 From: Matthew Dimond Date: Wed, 2 Aug 2023 14:03:22 -0600 Subject: [PATCH 10/86] Create mpas_string_replace in mpas_string_utils A function to replace characters in a string with another character has been added to the mpas_string_utils module. The function searches for a character (charToReplace) inside of an input string, and replaces any instances of that character with another character (targetCharacter). Strings are trimmed before characters are replaced to avoid potential issues with trailing whitespace when replacing spaces. --- src/framework/mpas_string_utils.F | 34 +++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/src/framework/mpas_string_utils.F b/src/framework/mpas_string_utils.F index b768522578..775b621af2 100644 --- a/src/framework/mpas_string_utils.F +++ b/src/framework/mpas_string_utils.F @@ -68,5 +68,39 @@ subroutine mpas_split_string(string, delimiter, subStrings) end subroutine mpas_split_string + !----------------------------------------------------------------------- + ! routine mpas_string_replace + ! + !> \brief Returns string with charToReplace replaced with targetChar + !> \author Matthew Dimond + !> \date 07/26/2023 + !> \details This function replaces all characters matching charToReplace in + !> "string" with the char "targetChar" after trimming "string" + ! + !----------------------------------------------------------------------- + function mpas_string_replace(string, charToReplace, targetChar) result(stringOut) + + implicit none + + ! Arguments + character(len=*), intent(in) :: string + character, intent(in) :: targetChar, charToReplace + + ! Local variables + integer :: i + + ! Result + character(len=len_trim(string)) :: stringOut + + stringOut = trim(string) + + do i = 1, len_trim(string) + if (string(i:i) == charToReplace) then + stringOut(i:i) = targetChar + end if + end do + + end function mpas_string_replace + end module mpas_string_utils From c42165d94b63ef335eccfb636fee6c40a79fd52b Mon Sep 17 00:00:00 2001 From: Matthew Dimond Date: Wed, 2 Aug 2023 14:21:06 -0600 Subject: [PATCH 11/86] Add tests for mpas_string_replace to mpas_test_core This commit adds unit tests for the new mpas_string_Replace function to the test core. Tests include consecutive characters, whitespace characters, and attempting to replace a character that does not appear in the input string. --- src/core_test/mpas_test_core_string_utils.F | 68 +++++++++++++++++++++ 1 file changed, 68 insertions(+) diff --git a/src/core_test/mpas_test_core_string_utils.F b/src/core_test/mpas_test_core_string_utils.F index 10b245a351..6e6c85c7c8 100644 --- a/src/core_test/mpas_test_core_string_utils.F +++ b/src/core_test/mpas_test_core_string_utils.F @@ -16,6 +16,66 @@ module test_core_string_utils contains + subroutine mpas_test_string_replace(err) + + use mpas_string_utils, only : mpas_string_replace + + implicit none + + ! Arguments + integer, intent(out) :: err + + ! Local variables + character(len=StrKIND) :: testString + character(len=StrKIND) :: outString + character :: targetCharacter, toReplace + + err = 0 + + ! Basic functionality + testString = 'Test_String' + targetCharacter = '-' + toReplace = '_' + outString = mpas_string_replace(testString, toReplace, targetCharacter) + if (trim(outString) /= 'Test-String') then + err = err + 1 + call mpas_log_write('FAILED TO REPLACE STRING #1 CORRECTLY', & + MPAS_LOG_ERR) + end if + + ! Whitespace replacement + testString = 'Test String' + targetCharacter = '-' + toReplace = ' ' + outString = mpas_string_replace(testString, toReplace, targetCharacter) + if (trim(outString) /= 'Test-String') then + err = err + 1 + call mpas_log_write('FAILED TO REPLACE STRING #2 CORRECTLY', & + MPAS_LOG_ERR) + end if + + ! Consecutive charcters + testString = 'Test__String' + toReplace = '_' + outString = mpas_string_replace(testString, toReplace, targetCharacter) + if (trim(outString) /= 'Test--String') then + err = err + 1 + call mpas_log_write('FAILED TO REPLACE STRING #3 CORRECTLY', & + MPAS_LOG_ERR) + end if + + ! No Replacement + testString = 'Test String' + toReplace = '-' + outString = mpas_string_replace(testString, toReplace, targetCharacter) + if (trim(outString) /= 'Test String') then + err = err + 1 + call mpas_log_write('FAILED TO REPLACE STRING #4 CORRECTLY', & + MPAS_LOG_ERR) + end if + + end subroutine mpas_test_string_replace + subroutine mpas_test_split_string(err) use mpas_string_utils, only : mpas_split_string @@ -110,6 +170,14 @@ subroutine mpas_test_string_utils(err) call mpas_log_write(' mpas_split_string: FAILURE', MPAS_LOG_ERR) end if + call mpas_test_string_replace(err) + if (err == 0) then + call mpas_log_write(' mpas_string_replace: SUCCESS') + else + call mpas_log_write(' mpas_string_replace: FAILURE', & + MPAS_LOG_ERR) + end if + end subroutine mpas_test_string_utils end module test_core_string_utils From 076d3a0057337fc0aca9192b65631350841b4cde Mon Sep 17 00:00:00 2001 From: "G. Dylan Dickerson" Date: Tue, 8 Aug 2023 14:17:22 -0600 Subject: [PATCH 12/86] Add ability for clean target to check for CORE existence Previously MPAS would run the clean recipe without regard for the core actually existing. This change ensures that the clean recipe/target will only run if a valid value for CORE is provided. --- Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Makefile b/Makefile index 4d5f20edfb..cce8e513e8 100644 --- a/Makefile +++ b/Makefile @@ -996,6 +996,7 @@ override CPPFLAGS += -DMPAS_BUILD_TARGET=$(BUILD_TARGET) ifeq ($(wildcard src/core_$(CORE)), ) # CHECK FOR EXISTENCE OF CORE DIRECTORY all: core_error +clean: core_error else @@ -1320,8 +1321,7 @@ clean_core: else # CORE IF all: error -clean: errmsg - exit 1 +clean: error error: errmsg @echo "************ ERROR ************" @echo "No CORE specified. Quitting." From 5c29cecc9640efdeb5163f693d795650cad5bd1f Mon Sep 17 00:00:00 2001 From: Matthew Dimond Date: Mon, 10 Jul 2023 16:58:16 -0600 Subject: [PATCH 13/86] Add ability to include arbitrary attributes in variables. This commit adds the functionality needed to add arbitrary attributes to variables defined in the Registry.xml, and propagate the attributes not reserved for internal use to the output file. The "reserved" attributes are contained in the "ATTRS_TO_IGNORE" array, and include name, type, dimensions, persistence, packages, time_levs, name_in_code, array_group, and default value. These will continue to be handled as special cases by gen_inc.c. As well, some attributes will be modified in the code- description will become long_name, and missing_value becomes _FillValue. A special case for "missing_value" was also added to the code- there is already logic that determines the proper _FillValue for a variable, and we continue to use that as the _FillValue when missing_value is added as an attribute. In the case of variables defined under a var_array, the missing_value attribute will be ignored and replaced with the missing_value attribute defined at the level of the var_array tag. This does not change any behavior from the develop branch. A new warning is now printed during compilation if a missing_value is defined in a variable contained within a var_array. All attributes are now added through the "add_attribute_if_not_ignored" function. Any changes to the "ATTRS_TO_IGNORE", "ATTRS_TO_MODIFY", or "NUMERIC_ATTRS" arrays should also include a modification to the "NUM_IGNORED_ATTRS", "NUM_MODIFIED_ATTRS", or "NUM_NUMERIC_ATTRS" fields, respectively. Attributes added through the new function will also have single quotes escaped with the "escape_quotes" function. This simply adds another apostrophe in front of apostrophes to escape them in fortran. --- src/tools/registry/gen_inc.c | 224 ++++++++++++++++++++++++----------- src/tools/registry/gen_inc.h | 2 + 2 files changed, 156 insertions(+), 70 deletions(-) diff --git a/src/tools/registry/gen_inc.c b/src/tools/registry/gen_inc.c index 8f5e79b813..acf3df2d63 100644 --- a/src/tools/registry/gen_inc.c +++ b/src/tools/registry/gen_inc.c @@ -18,6 +18,32 @@ #define STR(s) #s #define MACRO_TO_STR(s) STR(s) +#define NUM_MODIFIED_ATTRS 2 +#define NUM_IGNORED_ATTRS 9 +#define NUM_NUMERIC_ATTRS 1 + +static const char *NUMERIC_ATTRS[NUM_NUMERIC_ATTRS] = { + "missing_value" +}; + +static const char *ATTRS_TO_IGNORE[NUM_IGNORED_ATTRS] = { + "name", + "type", + "dimensions", + "persistence", + "packages", + "time_levs", + "name_in_code", + "array_group", + "default_value" +}; + +static const char *ATTRS_TO_MODIFY[NUM_MODIFIED_ATTRS][2] = { + {"description", "long_name"}, + {"missing_value", "_FillValue"} +}; + + void write_model_variables(ezxml_t registry){/*{{{*/ const char * suffix = MACRO_TO_STR(MPAS_NAMELIST_SUFFIX); const char * exe_name = MACRO_TO_STR(MPAS_EXE_NAME); @@ -83,6 +109,115 @@ int write_field_pointer_arrays(FILE* fd){/*{{{*/ return 0; }/*}}}*/ +// Checks for a string in a list of strings. +// Returns the index of the string if it does exist in the array, +// and -1 if it does not appear in the array. +int find_string_in_array(char *input_string, const char *array[], size_t rows){ + size_t i; + for (i = 0; i < rows; i++ ){ + if (strcmp(input_string, array[i]) == 0){ + return i; + } + } + return -1; +} + +// Helper function to change attribute names in accordance with +// "attrs_to_modify" within the "add_attribute_if_not_ignored" function +const char * modify_attr(const char *attr, const char *array[][2], size_t rows) { + size_t i; + for (i = 0; i < rows; i++) { + if (strcmp(attr, array[i][0]) == 0) { + return array[i][1]; + } + } + return attr; +} + +// Doubles single quotes in stringIn, and places the results in the buffer +// stringOut. stringOut should be large enough to store (len(stringIn) * 2 + 1) +// characters. Returns 1 if the buffer is too small for the result. +int escape_quotes(const char * stringIn, char * result, size_t bufferSize){ + size_t resultIndex = 0; + + for (size_t i = 0; i < strlen(stringIn) + 1; i++) { + if ( stringIn[i] == '\'' ) { + if (resultIndex >= bufferSize) return 1; + result[resultIndex++] = '\''; + } + if (resultIndex >= bufferSize) return 1; + result[resultIndex++] = stringIn[i]; + } + + return 0; +} + +void add_attribute_if_not_ignored(FILE *fd, char *index, char *att_name, char *pointer_name_arr, char *att_value){ + char *format_string; + + // Allocate buffers for escaping apostrophes, + size_t value_buffer_size = 2 * strlen(att_value) + 1; + size_t name_buffer_size = 2 * strlen(att_name) + 1; + char *escaped_value = (char*)malloc(value_buffer_size); + char *escaped_name = (char*)malloc(name_buffer_size); + + // Confirm that memory was allocated correctly + if (escaped_value == NULL) { + fprintf(stderr, + "ERROR: Failed to allocate memory while escaping quotes for att_value %s of att %s\n", + att_value, + att_name); + return; + } else if (escaped_name == NULL) { + fprintf(stderr, + "ERROR: Failed to allocate memory while escaping quotes for att_name of att %s\n", + att_name); + return; + } + + + // Return early if we want to ignore the attribute + if (find_string_in_array(att_name, ATTRS_TO_IGNORE, NUM_IGNORED_ATTRS) >= 0){ + return; + } + + // check if the attribute is numeric + if (find_string_in_array(att_name, NUMERIC_ATTRS, NUM_NUMERIC_ATTRS) >= 0){ + format_string = " call mpas_add_att(%s %% attLists(%s) %% attList, '%s', %s)\n"; + } + // If it isn't numeric, make sure to wrap att_value in quotes + else { + format_string = " call mpas_add_att(%s %% attLists(%s) %% attList, '%s', '%s')\n"; + } + + // Escape the quotes + if ( escape_quotes(att_value, escaped_value, value_buffer_size) == 1){ + fprintf(stderr, + "ERROR: Buffer too small to escape quotes for att_value %s of att %s\n", + att_value, + att_name); + return; + } + + if ( escape_quotes(modify_attr(att_name, ATTRS_TO_MODIFY, NUM_MODIFIED_ATTRS), + escaped_name, + name_buffer_size) == 1) { + fprintf(stderr, + "ERROR: Buffer too small to escape quotes for att_name of att %s\n", + att_name); + return; + } + // Write the add_att code + fortprintf(fd, + format_string, + pointer_name_arr, + index, + escaped_name, + escaped_value); + + free(escaped_value); + free(escaped_name); +} int set_pointer_name(int type, int ndims, char *pointer_name, int time_levs){/*{{{*/ @@ -1016,7 +1151,7 @@ int parse_var_array(FILE *fd, ezxml_t registry, ezxml_t superStruct, ezxml_t var const char *structname, *structlevs, *structpackages; const char *substructname; const char *vararrname, *vararrtype, *vararrdims, *vararrpersistence, *vararrdefaultval, *vararrpackages, *vararrmissingval; - const char *varname, *varpersistence, *vartype, *vardims, *varunits, *vardesc, *vararrgroup, *varstreams, *vardefaultval, *varpackages; + const char *varname, *varpersistence, *vartype, *vardims, *vararrgroup, *varstreams, *vardefaultval, *varpackages; const char *varname2, *vararrgroup2, *vararrname_in_code; const char *varname_in_code; const char *streamname, *streamname2; @@ -1364,10 +1499,9 @@ int parse_var_array(FILE *fd, ezxml_t registry, ezxml_t superStruct, ezxml_t var fortprintf(fd, " end do\n"); for(var_xml = ezxml_child(var_arr_xml, "var"); var_xml; var_xml = var_xml->next){ + char **attr; varname = ezxml_attr(var_xml, "name"); varname_in_code = ezxml_attr(var_xml, "name_in_code"); - vardesc = ezxml_attr(var_xml, "description"); - varunits = ezxml_attr(var_xml, "units"); if(!varname_in_code){ varname_in_code = ezxml_attr(var_xml, "name"); @@ -1377,40 +1511,18 @@ int parse_var_array(FILE *fd, ezxml_t registry, ezxml_t superStruct, ezxml_t var fortprintf(fd, " call mpas_pool_get_dimension(newSubPool, 'index_%s', const_index)\n", varname_in_code); fortprintf(fd, " end if\n"); fortprintf(fd, " if (const_index > 0) then\n", spacing); - if ( vardesc != NULL ) { - string = strdup(vardesc); - tofree = string; - - token = strsep(&string, "'"); - sprintf(temp_str, "%s", token); - - while ( ( token = strsep(&string, "'") ) != NULL ) { - sprintf(temp_str, "%s''%s", temp_str, token); - } - - free(tofree); - - fortprintf(fd, " call mpas_add_att(%s %% attLists(const_index) %% attList, 'long_name', '%s')\n", pointer_name_arr, temp_str); - } - - if ( varunits != NULL ) { - string = strdup(varunits); - tofree = string; - - token = strsep(&string, "'"); - sprintf(temp_str, "%s", token); - while ( ( token = strsep(&string, "'") ) != NULL ) { - sprintf(temp_str, "%s''%s", temp_str, token); + for (attr = var_xml->attr; attr && *attr; attr+=2) { + // If the attr is "missing_value", ignore it and later on take + // the value from the var array. + if (strcmp(attr[0], "missing_value") == 0) { + printf("WARNING: Ignoring missing_value attribute for var %s defined in var_array %s\n", varname, vararrname); + } else { + add_attribute_if_not_ignored(fd, "const_index", attr[0], pointer_name_arr, attr[1]); } - - free(tofree); - - fortprintf(fd, " call mpas_add_att(%s %% attLists(const_index) %% attList, 'units', '%s')\n", pointer_name_arr, temp_str); } - if ( vararrmissingval ) { - fortprintf(fd, " call mpas_add_att(%s %% attLists(const_index) %% attList, '_FillValue', %s)\n", pointer_name_arr, missing_value); + add_attribute_if_not_ignored(fd, "const_index", "missing_value", pointer_name_arr, missing_value); } fortprintf(fd, " %s %% missingValue = %s\n", pointer_name_arr, missing_value); fortprintf(fd, " %s %% constituentNames(const_index) = '%s'\n", pointer_name_arr, varname); @@ -1467,7 +1579,7 @@ int parse_var(FILE *fd, ezxml_t registry, ezxml_t superStruct, ezxml_t currentVa const char *structtimelevs, *vartimelevs; const char *structname, *structlevs, *structpackages; const char *substructname; - const char *varname, *varpersistence, *vartype, *vardims, *varunits, *vardesc, *vararrgroup, *varstreams, *vardefaultval, *varpackages, *varmissingval; + const char *varname, *varpersistence, *vartype, *vardims, *vararrgroup, *varstreams, *vardefaultval, *varpackages, *varmissingval; const char *varname2, *vararrgroup2; const char *varname_in_code; const char *streamname, *streamname2; @@ -1502,8 +1614,6 @@ int parse_var(FILE *fd, ezxml_t registry, ezxml_t superStruct, ezxml_t currentVa vardefaultval = ezxml_attr(var_xml, "default_value"); vartimelevs = ezxml_attr(var_xml, "time_levs"); varname_in_code = ezxml_attr(var_xml, "name_in_code"); - varunits = ezxml_attr(var_xml, "units"); - vardesc = ezxml_attr(var_xml, "description"); varmissingval = ezxml_attr(var_xml, "missing_value"); if(!varname_in_code){ @@ -1548,6 +1658,7 @@ int parse_var(FILE *fd, ezxml_t registry, ezxml_t superStruct, ezxml_t currentVa } for(time_lev = 1; time_lev <= time_levs; time_lev++){ + char **attr; if (time_levs > 1) { snprintf(pointer_name_arr, 1024, "%s(%d)", pointer_name, time_lev); } else { @@ -1603,41 +1714,14 @@ int parse_var(FILE *fd, ezxml_t registry, ezxml_t superStruct, ezxml_t currentVa } fortprintf(fd, " allocate(%s %% attLists(1))\n", pointer_name_arr); fortprintf(fd, " allocate(%s %% attLists(1) %% attList)\n", pointer_name_arr); - - if ( varunits != NULL ) { - string = strdup(varunits); - tofree = string; - token = strsep(&string, "'"); - - sprintf(temp_str, "%s", token); - - while ( ( token = strsep(&string, "'") ) != NULL ) { - sprintf(temp_str, "%s''%s", temp_str, token); - } - - free(tofree); - - fortprintf(fd, " call mpas_add_att(%s %% attLists(1) %% attList, 'units', '%s')\n", pointer_name_arr, temp_str); - } - - if ( vardesc != NULL ) { - string = strdup(vardesc); - tofree = string; - token = strsep(&string, "'"); - - sprintf(temp_str, "%s", token); - - while ( ( token = strsep(&string, "'") ) != NULL ) { - sprintf(temp_str, "%s''%s", temp_str, token); + for (attr = var_xml->attr; attr && *attr; attr+=2) { + // If the attr is "missing_value", use the specified fill value + // for real, integer, or char values. + if (strcmp(attr[0], "missing_value") == 0) { + add_attribute_if_not_ignored(fd, "1", attr[0], pointer_name_arr, missing_value); + } else { + add_attribute_if_not_ignored(fd, "1", attr[0], pointer_name_arr, attr[1]); } - - free(tofree); - - fortprintf(fd, " call mpas_add_att(%s %% attLists(1) %% attList, 'long_name', '%s')\n", pointer_name_arr, temp_str); - } - - if ( varmissingval != NULL ) { - fortprintf(fd, " call mpas_add_att(%s %% attLists(1) %% attList, '_FillValue', %s)\n", pointer_name_arr, missing_value); } fortprintf(fd, " %s %% missingValue = %s\n", pointer_name_arr, missing_value); diff --git a/src/tools/registry/gen_inc.h b/src/tools/registry/gen_inc.h index 96db3de8b3..3833456d66 100644 --- a/src/tools/registry/gen_inc.h +++ b/src/tools/registry/gen_inc.h @@ -9,6 +9,8 @@ #include "ezxml.h" +void add_attribute_if_not_ignored(FILE *fd, char *index, char *att_name, char *pointer_name_arr, char *temp_str); +int find_string_in_array(char *input_string, const char *array[], size_t rows); void write_model_variables(ezxml_t registry); int write_field_pointer_arrays(FILE* fd); int set_pointer_name(int type, int ndims, char *pointer_name, int time_levs); From bf52b10579d6a87fc44c59546bb515802af53d0b Mon Sep 17 00:00:00 2001 From: Michael Duda Date: Tue, 26 Sep 2023 13:34:10 -0600 Subject: [PATCH 14/86] After reading a stream, only reindex fields that were active in that stream Historically, input streams that contained mesh indexing fields (e.g., cellsOnCell) did not attach packages to those fields in the stream, and so we could safely assume that all indexing fields in an input stream should be converted to local indices via a call to the postread_reindex routine after the stream was read. In future, however, packages may be used to conditionally read mesh indexing fields from a stream, in which case it's important to only reindex those fields that were actually read; otherwise, indexing fields that already contained correct local indices will be corrupted. With this commit, two new pools -- the allPackages pool and the field_pkg_pool -- are passed to the postread_reindex routine, which can then determine whether each indexing field in an input stream was active and therefore needs to be reindexed. --- src/framework/mpas_stream_manager.F | 30 +++++++++++++++++++++++++++-- 1 file changed, 28 insertions(+), 2 deletions(-) diff --git a/src/framework/mpas_stream_manager.F b/src/framework/mpas_stream_manager.F index 0276d34653..0951b398ce 100644 --- a/src/framework/mpas_stream_manager.F +++ b/src/framework/mpas_stream_manager.F @@ -3978,7 +3978,7 @@ subroutine read_stream(manager, stream, timeLevel, mgLevel, forceReadNow, when, ! ! For any connectivity arrays in this stream, convert global indices to local indices ! - call postread_reindex(manager % allFields, stream % field_pool) + call postread_reindex(manager % allFields, manager % allPackages, stream % field_pool, stream % field_pkg_pool) end if end subroutine read_stream !}}} @@ -5312,12 +5312,14 @@ end subroutine postwrite_reindex !}}} !> This routine should be called immediately after a read of a stream. ! !----------------------------------------------------------------------- - subroutine postread_reindex(allFields, streamFields) !{{{ + subroutine postread_reindex(allFields, allPackages, streamFields, fieldPkgPool) !{{{ implicit none type (mpas_pool_type), pointer :: allFields + type (mpas_pool_type), pointer :: allPackages type (mpas_pool_type), pointer :: streamFields + type (mpas_pool_type), pointer :: fieldPkgPool type (mpas_pool_iterator_type) :: fieldItr type (mpas_pool_field_info_type) :: fieldInfo @@ -5332,6 +5334,10 @@ subroutine postread_reindex(allFields, streamFields) !{{{ logical :: skip_field integer :: i, j, k + character (len=StrKIND), pointer :: packages + logical :: active_field + integer :: err_level + call mpas_pool_get_field(allFields, 'indexToCellID', indexToCellID) call mpas_pool_get_field(allFields, 'indexToEdgeID', indexToEdgeID) @@ -5344,6 +5350,26 @@ subroutine postread_reindex(allFields, streamFields) !{{{ ! Note: in a stream's field_pool, the names of fields are stored as configs if ( fieldItr % memberType == MPAS_POOL_CONFIG ) then + ! + ! Check whether the field is active in this stream + ! + err_level = mpas_pool_get_error_level() + call mpas_pool_set_error_level(MPAS_POOL_SILENT) + + nullify(packages) + call mpas_pool_get_config(fieldPkgPool, trim(fieldItr % memberName)//':packages', packages) + if (associated(packages)) then + active_field = parse_package_list(allPackages, trim(packages)) + else + active_field = .true. + end if + call mpas_pool_set_error_level(err_level) + + if (.not. active_field) then + STREAM_DEBUG_WRITE('-- '//trim(fieldItr % memberName)//' not active in stream and will not be reindexed') + cycle + end if + call mpas_pool_get_field_info(allFields, fieldItr % memberName, fieldInfo) skip_field = .false. From b19c73fd981a4fc9747c0eeaa4ec8e6fb7a3e7c1 Mon Sep 17 00:00:00 2001 From: Michael Duda Date: Tue, 26 Sep 2023 13:43:53 -0600 Subject: [PATCH 15/86] After reading a stream, only exchange halos for fields that were active The internal read_stream routine that is called by MPAS_stream_mgr_read previously performed halo exchanges for all fields in the stream under the assumption that the new values in the fields that were read should be propagated out to halos. For all indexing fields (e.g., cellsOnCell) in the stream, global indices were then translated to local indices. If any indexing fields in an input stream are deactivated due to packages, however, those deactivated indexing fields do not undergo global-to-local index translation. In cases where the indexing fields already contained valid local indices in owned and halo elements, performing a halo exchange would lead to incorrect local indices in the halo elements: specifically, the halo elements would contain the local indices from other blocks rather than from their own block. To avoid corrupting indices in indexing arrays, the exch_all_halos routine, which handles the halo updates for all fields in an input stream, has been modified to consider the packages that are attached to each field; only fields that are active in an input stream have their halos updated after the stream is read. --- src/framework/mpas_stream_manager.F | 31 +++++++++++++++++++++++++++-- 1 file changed, 29 insertions(+), 2 deletions(-) diff --git a/src/framework/mpas_stream_manager.F b/src/framework/mpas_stream_manager.F index 0951b398ce..bde652983b 100644 --- a/src/framework/mpas_stream_manager.F +++ b/src/framework/mpas_stream_manager.F @@ -3973,7 +3973,8 @@ subroutine read_stream(manager, stream, timeLevel, mgLevel, forceReadNow, when, ! ! Exchange halos for all decomposed fields in this stream ! - call exch_all_halos(manager % allFields, stream % field_pool, stream % timeLevel, local_ierr) + call exch_all_halos(manager % allFields, manager % allPackages, stream % field_pool, stream % field_pkg_pool, & + stream % timeLevel, local_ierr) ! ! For any connectivity arrays in this stream, convert global indices to local indices @@ -4646,12 +4647,14 @@ end function parse_package_list !> This routine performs a halo exchange of each decomposed field within a stream. ! !----------------------------------------------------------------------- - subroutine exch_all_halos(allFields, streamFields, timeLevel, ierr) !{{{ + subroutine exch_all_halos(allFields, allPackages, streamFields, fieldPkgPool, timeLevel, ierr) !{{{ implicit none type (mpas_pool_type), pointer :: allFields + type (mpas_pool_type), pointer :: allPackages type (mpas_pool_type), pointer :: streamFields + type (mpas_pool_type), pointer :: fieldPkgPool integer, intent(in) :: timeLevel integer, intent(out) :: ierr @@ -4667,6 +4670,10 @@ subroutine exch_all_halos(allFields, streamFields, timeLevel, ierr) !{{{ type (field2DInteger), pointer :: int2DField type (field3DInteger), pointer :: int3DField + character (len=StrKIND), pointer :: packages + logical :: active_field + integer :: err_level + ierr = MPAS_STREAM_MGR_NOERR @@ -4677,6 +4684,26 @@ subroutine exch_all_halos(allFields, streamFields, timeLevel, ierr) !{{{ ! Note: in a stream's field_pool, the names of fields are stored as configs if ( fieldItr % memberType == MPAS_POOL_CONFIG ) then + ! + ! Check whether the field is active in this stream + ! + err_level = mpas_pool_get_error_level() + call mpas_pool_set_error_level(MPAS_POOL_SILENT) + + nullify(packages) + call mpas_pool_get_config(fieldPkgPool, trim(fieldItr % memberName)//':packages', packages) + if (associated(packages)) then + active_field = parse_package_list(allPackages, trim(packages)) + else + active_field = .true. + end if + call mpas_pool_set_error_level(err_level) + + if (.not. active_field) then + STREAM_DEBUG_WRITE('-- '//trim(fieldItr % memberName)//' not active in stream and halo will not be exchanged') + cycle + end if + call mpas_pool_get_field_info(allFields, fieldItr % memberName, fieldInfo) if ( fieldInfo % nDims == 1) then From 72e7ebbf381b7d11435e47de36ed4f0f5e4bf250 Mon Sep 17 00:00:00 2001 From: Michael Duda Date: Thu, 31 Aug 2023 00:12:59 +0000 Subject: [PATCH 16/86] Rename MPAS_IO_ERR_PIO to the more generic name MPAS_IO_ERR_BACKEND When MPAS is compiled with support for the SMIOL library, the code MPAS_IO_ERR_PIO was returned to indicate that an error occurred within the SMIOL library. Generally, it is convenient to have a generic error code to indicate that one of the libraries (PIO or SMIOL) encountered an error condition, and so this commit renames the MPAS_IO_ERR_PIO constant to MPAS_IO_ERR_BACKEND. Additionally, the MPAS_io_err_mesg() routine has been updated to print either MPAS IO Error: Bad return value from PIO or MPAS IO Error: Bad return value from SMIOL depending on whether MPAS was compiled with support for PIO or for SMIOL. --- src/framework/mpas_io.F | 89 +++++++++++++++++---------------- src/framework/mpas_io_types.inc | 2 +- 2 files changed, 48 insertions(+), 43 deletions(-) diff --git a/src/framework/mpas_io.F b/src/framework/mpas_io.F index 01ab167243..a57486a322 100644 --- a/src/framework/mpas_io.F +++ b/src/framework/mpas_io.F @@ -425,7 +425,7 @@ type (MPAS_IO_Handle_type) function MPAS_io_open(filename, mode, ioformat, ioCon endif #ifdef MPAS_PIO_SUPPORT if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if #endif @@ -448,7 +448,7 @@ type (MPAS_IO_Handle_type) function MPAS_io_open(filename, mode, ioformat, ioCon pio_ierr = PIO_inquire(MPAS_io_open % pio_file, unlimitedDimID=MPAS_io_open % pio_unlimited_dimid) !call mpas_log_write('Found unlimited dim $i', intArgs=(/MPAS_io_open % pio_unlimited_dimid/) ) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if #endif @@ -461,7 +461,7 @@ type (MPAS_IO_Handle_type) function MPAS_io_open(filename, mode, ioformat, ioCon if ( MPAS_io_open % pio_unlimited_dimid >= 0 ) then pio_ierr = PIO_inq_dimlen(MPAS_io_open % pio_file, MPAS_io_open % pio_unlimited_dimid, MPAS_io_open % preexisting_records) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if else @@ -585,7 +585,7 @@ subroutine MPAS_io_inq_dim(handle, dimname, dimsize, ierr) pio_ierr = PIO_inq_dimlen(handle % pio_file, new_dimlist_node % dimhandle % dimid, new_dimlist_node % dimhandle % dimsize) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND deallocate(new_dimlist_node % dimhandle) deallocate(new_dimlist_node) dimsize = -1 @@ -692,7 +692,7 @@ subroutine MPAS_io_def_dim(handle, dimname, dimsize, ierr) ! if (handle % preexisting_file) then call MPAS_io_inq_dim(handle, dimname, inq_dimsize, ierr=pio_ierr) - if (pio_ierr /= MPAS_IO_ERR_PIO) then + if (pio_ierr /= MPAS_IO_ERR_BACKEND) then ! Verify that the dimsize matches... if (dimsize /= inq_dimsize .and. dimsize /= MPAS_IO_UNLIMITED_DIM) then @@ -743,7 +743,7 @@ subroutine MPAS_io_def_dim(handle, dimname, dimsize, ierr) #endif #ifdef MPAS_PIO_SUPPORT if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND deallocate(new_dimlist_node % dimhandle) deallocate(new_dimlist_node) return @@ -836,7 +836,7 @@ subroutine MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsiz pio_ierr = PIO_inq_varid(handle % pio_file, trim(fieldname), new_fieldlist_node % fieldhandle % fieldid) pio_ierr = PIO_inq_varid(handle % pio_file, trim(fieldname), new_fieldlist_node % fieldhandle % field_desc) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND deallocate(new_fieldlist_node % fieldhandle) deallocate(new_fieldlist_node) call mpas_log_write('Variable ' // trim(fieldname) // ' not in input file.', MPAS_LOG_WARN) @@ -847,7 +847,7 @@ subroutine MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsiz ! Get field type pio_ierr = PIO_inq_vartype(handle % pio_file, new_fieldlist_node % fieldhandle % fieldid, new_fieldlist_node % fieldhandle % field_type) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND deallocate(new_fieldlist_node % fieldhandle) deallocate(new_fieldlist_node) return @@ -873,7 +873,7 @@ subroutine MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsiz #ifdef MPAS_SMIOL_SUPPORT local_ierr = SMIOLf_inquire_var(handle % smiol_file, trim(fieldname), vartype=smiol_type) if (local_ierr /= SMIOL_SUCCESS) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND deallocate(new_fieldlist_node % fieldhandle) deallocate(new_fieldlist_node) call mpas_log_write('Variable ' // trim(fieldname) // ' not in input file.', MPAS_LOG_WARN) @@ -900,7 +900,7 @@ subroutine MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsiz #ifdef MPAS_PIO_SUPPORT pio_ierr = PIO_inq_varndims(handle % pio_file, new_fieldlist_node % fieldhandle % fieldid, new_fieldlist_node % fieldhandle % ndims) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND deallocate(new_fieldlist_node % fieldhandle) deallocate(new_fieldlist_node) return @@ -918,7 +918,7 @@ subroutine MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsiz call mpas_log_write(trim(SMIOLf_error_string(local_ierr)), messageType=MPAS_LOG_ERR) end if - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND deallocate(new_fieldlist_node % fieldhandle) deallocate(new_fieldlist_node) @@ -935,7 +935,7 @@ subroutine MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsiz if (new_fieldlist_node % fieldhandle % ndims > 0) then pio_ierr = PIO_inq_vardimid(handle % pio_file, new_fieldlist_node % fieldhandle % fieldid, dimids) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND deallocate(new_fieldlist_node % fieldhandle) deallocate(new_fieldlist_node) deallocate(dimids) @@ -958,7 +958,7 @@ subroutine MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsiz pio_ierr = PIO_inq_dimlen(handle % pio_file, dimids(i), new_fieldlist_node % fieldhandle % dims(i) % dimsize) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND deallocate(new_fieldlist_node % fieldhandle) deallocate(new_fieldlist_node) deallocate(dimids) @@ -968,7 +968,7 @@ subroutine MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsiz pio_ierr = PIO_inq_dimname(handle % pio_file, dimids(i), new_fieldlist_node % fieldhandle % dims(i) % dimname) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND deallocate(new_fieldlist_node % fieldhandle) deallocate(new_fieldlist_node) deallocate(dimids) @@ -1173,7 +1173,7 @@ subroutine MPAS_io_def_var(handle, fieldname, fieldtype, dimnames, precision, ie ! if (handle % preexisting_file) then call MPAS_io_inq_var(handle, fieldname, inq_fieldtype, inq_ndims, inq_dimnames, ierr=pio_ierr) - if (pio_ierr /= MPAS_IO_ERR_PIO) then + if (pio_ierr /= MPAS_IO_ERR_BACKEND) then ! Verify that the type and dimensions match... if (fieldtype == MPAS_IO_DOUBLE) then @@ -1310,7 +1310,7 @@ subroutine MPAS_io_def_var(handle, fieldname, fieldtype, dimnames, precision, ie pio_ierr = PIO_def_var(handle % pio_file, trim(fieldname), pio_type, dimids, new_fieldlist_node % fieldhandle % field_desc) end if if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if #endif @@ -1330,7 +1330,7 @@ subroutine MPAS_io_def_var(handle, fieldname, fieldtype, dimnames, precision, ie #ifdef MPAS_PIO_SUPPORT pio_ierr = PIO_inq_varid(handle % pio_file, trim(fieldname), new_fieldlist_node % fieldhandle % fieldid) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if #endif @@ -2682,7 +2682,7 @@ subroutine MPAS_io_get_var_generic(handle, fieldname, intVal, intArray1d, intArr ! call mpas_log_write('Checking for error') #ifdef MPAS_PIO_SUPPORT if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if #endif @@ -3055,7 +3055,7 @@ subroutine MPAS_io_put_var_generic(handle, fieldname, intVal, intArray1d, intArr ! pre-existing files. if (pio_ierr /= PIO_noerr .and. & .not. (handle % external_file_desc .or. handle % preexisting_file)) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if #endif @@ -3950,7 +3950,7 @@ subroutine MPAS_io_put_var_generic(handle, fieldname, intVal, intArray1d, intArr end if #ifdef MPAS_PIO_SUPPORT if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if #endif @@ -4279,7 +4279,7 @@ subroutine MPAS_io_get_att_int0d(handle, attName, attValue, fieldname, ierr) #ifdef MPAS_PIO_SUPPORT pio_ierr = PIO_inq_att(handle % pio_file, varid, attName, xtype, len) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if if (xtype /= PIO_int) then @@ -4289,7 +4289,7 @@ subroutine MPAS_io_get_att_int0d(handle, attName, attValue, fieldname, ierr) pio_ierr = PIO_get_att(handle % pio_file, varid, attName, attValue) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if #endif @@ -4305,7 +4305,7 @@ subroutine MPAS_io_get_att_int0d(handle, attName, attValue, fieldname, ierr) if (present(ierr)) ierr = MPAS_IO_ERR_WRONG_ATT_TYPE return else - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if end if @@ -4444,7 +4444,7 @@ subroutine MPAS_io_get_att_int1d(handle, attName, attValue, fieldname, ierr) #ifdef MPAS_PIO_SUPPORT pio_ierr = PIO_inq_att(handle % pio_file, varid, attName, xtype, len) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -4455,14 +4455,14 @@ subroutine MPAS_io_get_att_int1d(handle, attName, attValue, fieldname, ierr) pio_ierr = PIO_inq_attlen(handle % pio_file, varid, attName, attlen) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if allocate(attValue(attlen)) pio_ierr = PIO_get_att(handle % pio_file, varid, attName, attValue) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if #endif @@ -4607,7 +4607,7 @@ subroutine MPAS_io_get_att_real0d(handle, attName, attValue, fieldname, precisio #ifdef MPAS_PIO_SUPPORT pio_ierr = PIO_inq_att(handle % pio_file, varid, attName, xtype, len) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if #endif @@ -4675,7 +4675,7 @@ subroutine MPAS_io_get_att_real0d(handle, attName, attValue, fieldname, precisio end if #ifdef MPAS_PIO_SUPPORT if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if #endif @@ -4686,7 +4686,7 @@ subroutine MPAS_io_get_att_real0d(handle, attName, attValue, fieldname, precisio if (present(ierr)) ierr = MPAS_IO_ERR_WRONG_ATT_TYPE return else - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if end if @@ -4836,13 +4836,13 @@ subroutine MPAS_io_get_att_real1d(handle, attName, attValue, fieldname, precisio #ifdef MPAS_PIO_SUPPORT pio_ierr = PIO_inq_att(handle % pio_file, varid, attName, xtype, len) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if pio_ierr = PIO_inq_attlen(handle % pio_file, varid, attName, attlen) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -4883,7 +4883,7 @@ subroutine MPAS_io_get_att_real1d(handle, attName, attValue, fieldname, precisio end if if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if #endif @@ -5019,7 +5019,7 @@ subroutine MPAS_io_get_att_text(handle, attName, attValue, fieldname, ierr) #ifdef MPAS_PIO_SUPPORT pio_ierr = PIO_inq_att(handle % pio_file, varid, attName, xtype, len) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if if (xtype /= PIO_char) then @@ -5029,7 +5029,7 @@ subroutine MPAS_io_get_att_text(handle, attName, attValue, fieldname, ierr) pio_ierr = PIO_get_att(handle % pio_file, varid, attName, attValue) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if #endif @@ -5045,7 +5045,7 @@ subroutine MPAS_io_get_att_text(handle, attName, attValue, fieldname, ierr) if (present(ierr)) ierr = MPAS_IO_ERR_WRONG_ATT_TYPE return else - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if end if @@ -5232,7 +5232,7 @@ subroutine MPAS_io_put_att_int0d(handle, attName, attValue, fieldname, syncVal, #ifdef MPAS_PIO_SUPPORT pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if #endif @@ -5412,7 +5412,7 @@ subroutine MPAS_io_put_att_int1d(handle, attName, attValue, fieldname, syncVal, #ifdef MPAS_PIO_SUPPORT pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if #endif @@ -5615,7 +5615,7 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal, #ifdef MPAS_PIO_SUPPORT if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if #endif @@ -5818,7 +5818,7 @@ subroutine MPAS_io_put_att_real1d(handle, attName, attValue, fieldname, syncVal, end if #ifdef MPAS_PIO_SUPPORT if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if #endif @@ -5983,7 +5983,7 @@ subroutine MPAS_io_put_att_text(handle, attName, attValue, fieldname, syncVal, i pio_ierr = PIO_put_att(handle % pio_file, varid, attName, trim(attValueLocal)) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND ! ! If we are working with a pre-existing file and the text attribute is larger than in the file, we need @@ -6235,7 +6235,7 @@ subroutine MPAS_io_finalize(ioContext, finalize_iosystem, ierr) #ifdef MPAS_PIO_SUPPORT call PIO_finalize(ioContext % pio_iosystem, pio_ierr) if (pio_ierr /= PIO_noerr) then - if (present(ierr)) ierr = MPAS_IO_ERR_PIO + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if deallocate(ioContext % pio_iosystem) @@ -6281,8 +6281,13 @@ subroutine MPAS_io_err_mesg(ierr, fatal) call mpas_log_write('MPAS IO Error: Filename too long', MPAS_LOG_ERR) case (MPAS_IO_ERR_UNINIT_HANDLE) call mpas_log_write('MPAS IO Error: Uninitialized I/O handle', MPAS_LOG_ERR) - case (MPAS_IO_ERR_PIO) + case (MPAS_IO_ERR_BACKEND) +#ifdef MPAS_PIO_SUPPORT call mpas_log_write('MPAS IO Error: Bad return value from PIO', MPAS_LOG_ERR) +#endif +#ifdef MPAS_SMIOL_SUPPORT + call mpas_log_write('MPAS IO Error: Bad return value from SMIOL', MPAS_LOG_ERR) +#endif case (MPAS_IO_ERR_DATA_MODE) call mpas_log_write('MPAS IO Error: Cannot define in data mode', MPAS_LOG_ERR) case (MPAS_IO_ERR_NOWRITE) diff --git a/src/framework/mpas_io_types.inc b/src/framework/mpas_io_types.inc index e648b234ef..522e6e1ad5 100644 --- a/src/framework/mpas_io_types.inc +++ b/src/framework/mpas_io_types.inc @@ -49,7 +49,7 @@ MPAS_IO_ERR_INVALID_FORMAT = -2, & MPAS_IO_ERR_LONG_FILENAME = -3, & MPAS_IO_ERR_UNINIT_HANDLE = -4, & - MPAS_IO_ERR_PIO = -5, & + MPAS_IO_ERR_BACKEND = -5, & MPAS_IO_ERR_DATA_MODE = -6, & MPAS_IO_ERR_NOWRITE = -7, & MPAS_IO_ERR_REDEF_DIM = -8, & From 87f02db61b4236bc356816ce7adcf5a0e3c679fa Mon Sep 17 00:00:00 2001 From: Michael Duda Date: Thu, 31 Aug 2023 21:30:34 +0000 Subject: [PATCH 17/86] Provide better error messages from MPAS_io_err_mesg in case of PIO or SMIOL errors In cases where MPAS I/O routines in the mpas_io module returned MPAS_IO_ERR_BACKEND, the MPAS_io_err_mesg function would simply print: MPAS IO Error: Bad return value from PIO or MPAS IO Error: Bad return value from SMIOL By latching the specific return codes from calls to the PIO or SMIOL library and storing them in a new private module variable, io_global_err, the MPAS_io_err_mesg function can now write a more specific (and therefore, hopefully more useful) error message; for example: MPAS IO Error: PIO error -62: NetCDF: One or more variable sizes violate format constraints --- src/framework/mpas_io.F | 61 +++++++++++++++++++++++++++++++++++++++-- 1 file changed, 59 insertions(+), 2 deletions(-) diff --git a/src/framework/mpas_io.F b/src/framework/mpas_io.F index a57486a322..b8109cd79c 100644 --- a/src/framework/mpas_io.F +++ b/src/framework/mpas_io.F @@ -80,6 +80,13 @@ module mpas_io #endif +#endif + +#ifdef MPAS_PIO_SUPPORT + integer, private :: io_global_err = PIO_noerr +#endif +#ifdef MPAS_SMIOL_SUPPORT + integer, private :: io_global_err = SMIOL_SUCCESS #endif interface MPAS_io_get_var @@ -425,6 +432,7 @@ type (MPAS_IO_Handle_type) function MPAS_io_open(filename, mode, ioformat, ioCon endif #ifdef MPAS_PIO_SUPPORT if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -448,6 +456,7 @@ type (MPAS_IO_Handle_type) function MPAS_io_open(filename, mode, ioformat, ioCon pio_ierr = PIO_inquire(MPAS_io_open % pio_file, unlimitedDimID=MPAS_io_open % pio_unlimited_dimid) !call mpas_log_write('Found unlimited dim $i', intArgs=(/MPAS_io_open % pio_unlimited_dimid/) ) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -461,6 +470,7 @@ type (MPAS_IO_Handle_type) function MPAS_io_open(filename, mode, ioformat, ioCon if ( MPAS_io_open % pio_unlimited_dimid >= 0 ) then pio_ierr = PIO_inq_dimlen(MPAS_io_open % pio_file, MPAS_io_open % pio_unlimited_dimid, MPAS_io_open % preexisting_records) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -585,6 +595,7 @@ subroutine MPAS_io_inq_dim(handle, dimname, dimsize, ierr) pio_ierr = PIO_inq_dimlen(handle % pio_file, new_dimlist_node % dimhandle % dimid, new_dimlist_node % dimhandle % dimsize) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND deallocate(new_dimlist_node % dimhandle) deallocate(new_dimlist_node) @@ -743,6 +754,7 @@ subroutine MPAS_io_def_dim(handle, dimname, dimsize, ierr) #endif #ifdef MPAS_PIO_SUPPORT if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND deallocate(new_dimlist_node % dimhandle) deallocate(new_dimlist_node) @@ -836,6 +848,7 @@ subroutine MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsiz pio_ierr = PIO_inq_varid(handle % pio_file, trim(fieldname), new_fieldlist_node % fieldhandle % fieldid) pio_ierr = PIO_inq_varid(handle % pio_file, trim(fieldname), new_fieldlist_node % fieldhandle % field_desc) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND deallocate(new_fieldlist_node % fieldhandle) deallocate(new_fieldlist_node) @@ -847,6 +860,7 @@ subroutine MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsiz ! Get field type pio_ierr = PIO_inq_vartype(handle % pio_file, new_fieldlist_node % fieldhandle % fieldid, new_fieldlist_node % fieldhandle % field_type) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND deallocate(new_fieldlist_node % fieldhandle) deallocate(new_fieldlist_node) @@ -873,6 +887,7 @@ subroutine MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsiz #ifdef MPAS_SMIOL_SUPPORT local_ierr = SMIOLf_inquire_var(handle % smiol_file, trim(fieldname), vartype=smiol_type) if (local_ierr /= SMIOL_SUCCESS) then + io_global_err = local_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND deallocate(new_fieldlist_node % fieldhandle) deallocate(new_fieldlist_node) @@ -900,6 +915,7 @@ subroutine MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsiz #ifdef MPAS_PIO_SUPPORT pio_ierr = PIO_inq_varndims(handle % pio_file, new_fieldlist_node % fieldhandle % fieldid, new_fieldlist_node % fieldhandle % ndims) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND deallocate(new_fieldlist_node % fieldhandle) deallocate(new_fieldlist_node) @@ -918,6 +934,7 @@ subroutine MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsiz call mpas_log_write(trim(SMIOLf_error_string(local_ierr)), messageType=MPAS_LOG_ERR) end if + io_global_err = local_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND deallocate(new_fieldlist_node % fieldhandle) @@ -935,6 +952,7 @@ subroutine MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsiz if (new_fieldlist_node % fieldhandle % ndims > 0) then pio_ierr = PIO_inq_vardimid(handle % pio_file, new_fieldlist_node % fieldhandle % fieldid, dimids) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND deallocate(new_fieldlist_node % fieldhandle) deallocate(new_fieldlist_node) @@ -958,6 +976,7 @@ subroutine MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsiz pio_ierr = PIO_inq_dimlen(handle % pio_file, dimids(i), new_fieldlist_node % fieldhandle % dims(i) % dimsize) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND deallocate(new_fieldlist_node % fieldhandle) deallocate(new_fieldlist_node) @@ -968,6 +987,7 @@ subroutine MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsiz pio_ierr = PIO_inq_dimname(handle % pio_file, dimids(i), new_fieldlist_node % fieldhandle % dims(i) % dimname) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND deallocate(new_fieldlist_node % fieldhandle) deallocate(new_fieldlist_node) @@ -1310,6 +1330,7 @@ subroutine MPAS_io_def_var(handle, fieldname, fieldtype, dimnames, precision, ie pio_ierr = PIO_def_var(handle % pio_file, trim(fieldname), pio_type, dimids, new_fieldlist_node % fieldhandle % field_desc) end if if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -1330,6 +1351,7 @@ subroutine MPAS_io_def_var(handle, fieldname, fieldtype, dimnames, precision, ie #ifdef MPAS_PIO_SUPPORT pio_ierr = PIO_inq_varid(handle % pio_file, trim(fieldname), new_fieldlist_node % fieldhandle % fieldid) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -2682,6 +2704,7 @@ subroutine MPAS_io_get_var_generic(handle, fieldname, intVal, intArray1d, intArr ! call mpas_log_write('Checking for error') #ifdef MPAS_PIO_SUPPORT if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -3055,6 +3078,7 @@ subroutine MPAS_io_put_var_generic(handle, fieldname, intVal, intArray1d, intArr ! pre-existing files. if (pio_ierr /= PIO_noerr .and. & .not. (handle % external_file_desc .or. handle % preexisting_file)) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -3950,6 +3974,7 @@ subroutine MPAS_io_put_var_generic(handle, fieldname, intVal, intArray1d, intArr end if #ifdef MPAS_PIO_SUPPORT if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -4279,6 +4304,7 @@ subroutine MPAS_io_get_att_int0d(handle, attName, attValue, fieldname, ierr) #ifdef MPAS_PIO_SUPPORT pio_ierr = PIO_inq_att(handle % pio_file, varid, attName, xtype, len) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -4289,6 +4315,7 @@ subroutine MPAS_io_get_att_int0d(handle, attName, attValue, fieldname, ierr) pio_ierr = PIO_get_att(handle % pio_file, varid, attName, attValue) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -4305,6 +4332,7 @@ subroutine MPAS_io_get_att_int0d(handle, attName, attValue, fieldname, ierr) if (present(ierr)) ierr = MPAS_IO_ERR_WRONG_ATT_TYPE return else + io_global_err = local_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -4444,6 +4472,7 @@ subroutine MPAS_io_get_att_int1d(handle, attName, attValue, fieldname, ierr) #ifdef MPAS_PIO_SUPPORT pio_ierr = PIO_inq_att(handle % pio_file, varid, attName, xtype, len) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -4455,6 +4484,7 @@ subroutine MPAS_io_get_att_int1d(handle, attName, attValue, fieldname, ierr) pio_ierr = PIO_inq_attlen(handle % pio_file, varid, attName, attlen) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -4462,6 +4492,7 @@ subroutine MPAS_io_get_att_int1d(handle, attName, attValue, fieldname, ierr) allocate(attValue(attlen)) pio_ierr = PIO_get_att(handle % pio_file, varid, attName, attValue) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -4607,6 +4638,7 @@ subroutine MPAS_io_get_att_real0d(handle, attName, attValue, fieldname, precisio #ifdef MPAS_PIO_SUPPORT pio_ierr = PIO_inq_att(handle % pio_file, varid, attName, xtype, len) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -4675,6 +4707,7 @@ subroutine MPAS_io_get_att_real0d(handle, attName, attValue, fieldname, precisio end if #ifdef MPAS_PIO_SUPPORT if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -4686,6 +4719,7 @@ subroutine MPAS_io_get_att_real0d(handle, attName, attValue, fieldname, precisio if (present(ierr)) ierr = MPAS_IO_ERR_WRONG_ATT_TYPE return else + io_global_err = local_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -4836,12 +4870,14 @@ subroutine MPAS_io_get_att_real1d(handle, attName, attValue, fieldname, precisio #ifdef MPAS_PIO_SUPPORT pio_ierr = PIO_inq_att(handle % pio_file, varid, attName, xtype, len) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if pio_ierr = PIO_inq_attlen(handle % pio_file, varid, attName, attlen) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -4883,6 +4919,7 @@ subroutine MPAS_io_get_att_real1d(handle, attName, attValue, fieldname, precisio end if if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -5019,6 +5056,7 @@ subroutine MPAS_io_get_att_text(handle, attName, attValue, fieldname, ierr) #ifdef MPAS_PIO_SUPPORT pio_ierr = PIO_inq_att(handle % pio_file, varid, attName, xtype, len) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -5029,6 +5067,7 @@ subroutine MPAS_io_get_att_text(handle, attName, attValue, fieldname, ierr) pio_ierr = PIO_get_att(handle % pio_file, varid, attName, attValue) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -5045,6 +5084,7 @@ subroutine MPAS_io_get_att_text(handle, attName, attValue, fieldname, ierr) if (present(ierr)) ierr = MPAS_IO_ERR_WRONG_ATT_TYPE return else + io_global_err = local_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -5232,6 +5272,7 @@ subroutine MPAS_io_put_att_int0d(handle, attName, attValue, fieldname, syncVal, #ifdef MPAS_PIO_SUPPORT pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -5412,6 +5453,7 @@ subroutine MPAS_io_put_att_int1d(handle, attName, attValue, fieldname, syncVal, #ifdef MPAS_PIO_SUPPORT pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -5615,6 +5657,7 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal, #ifdef MPAS_PIO_SUPPORT if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -5818,6 +5861,7 @@ subroutine MPAS_io_put_att_real1d(handle, attName, attValue, fieldname, syncVal, end if #ifdef MPAS_PIO_SUPPORT if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -5983,6 +6027,7 @@ subroutine MPAS_io_put_att_text(handle, attName, attValue, fieldname, syncVal, i pio_ierr = PIO_put_att(handle % pio_file, varid, attName, trim(attValueLocal)) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND ! @@ -5994,16 +6039,19 @@ subroutine MPAS_io_put_att_text(handle, attName, attValue, fieldname, syncVal, i if (handle % preexisting_file .and. .not. handle % data_mode) then pio_ierr = PIO_redef(handle % pio_file) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr return end if pio_ierr = PIO_put_att(handle % pio_file, varid, attName, trim(attValueLocal)) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr return end if pio_ierr = PIO_enddef(handle % pio_file) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr return end if @@ -6235,6 +6283,7 @@ subroutine MPAS_io_finalize(ioContext, finalize_iosystem, ierr) #ifdef MPAS_PIO_SUPPORT call PIO_finalize(ioContext % pio_iosystem, pio_ierr) if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if @@ -6270,6 +6319,11 @@ subroutine MPAS_io_err_mesg(ierr, fatal) integer, intent(in) :: ierr logical, intent(in) :: fatal +#ifdef MPAS_PIO_SUPPORT + integer :: ierr_local + character(len=StrKIND) :: pio_string +#endif + select case (ierr) case (MPAS_IO_NOERR) ! ... do nothing ... @@ -6283,10 +6337,13 @@ subroutine MPAS_io_err_mesg(ierr, fatal) call mpas_log_write('MPAS IO Error: Uninitialized I/O handle', MPAS_LOG_ERR) case (MPAS_IO_ERR_BACKEND) #ifdef MPAS_PIO_SUPPORT - call mpas_log_write('MPAS IO Error: Bad return value from PIO', MPAS_LOG_ERR) + ierr_local = PIO_strerror(io_global_err, pio_string) + call mpas_log_write('MPAS IO Error: PIO error $i: '//trim(pio_string), & + messageType=MPAS_LOG_ERR, intArgs=[io_global_err]) #endif #ifdef MPAS_SMIOL_SUPPORT - call mpas_log_write('MPAS IO Error: Bad return value from SMIOL', MPAS_LOG_ERR) + call mpas_log_write('MPAS IO Error: SMIOL error $i: '//trim(SMIOLf_error_string(io_global_err)), & + messageType=MPAS_LOG_ERR, intArgs=[io_global_err]) #endif case (MPAS_IO_ERR_DATA_MODE) call mpas_log_write('MPAS IO Error: Cannot define in data mode', MPAS_LOG_ERR) From 2cc9424ef29c47107ea3a62bafc71ea2877f1947 Mon Sep 17 00:00:00 2001 From: Michael Duda Date: Thu, 31 Aug 2023 21:44:50 +0000 Subject: [PATCH 18/86] Properly set return error codes and exit from some mpas_io routines with SMIOL In a subset of the routines in the mpas_io module, return error codes were not properly set when errors occurred in calls to the SMIOL library, and those routines didn't exit at the point of those unrecoverable errors. This commit updates various mpas_io routines so that they set the 'ierr' return code and return when MPAS is using the SMIOL library. --- src/framework/mpas_io.F | 63 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) diff --git a/src/framework/mpas_io.F b/src/framework/mpas_io.F index b8109cd79c..f8c0b0eeab 100644 --- a/src/framework/mpas_io.F +++ b/src/framework/mpas_io.F @@ -445,6 +445,10 @@ type (MPAS_IO_Handle_type) function MPAS_io_open(filename, mode, ioformat, ioCon else call mpas_log_write(trim(SMIOLf_error_string(local_ierr)), messageType=MPAS_LOG_ERR) end if + + io_global_err = local_ierr + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND + return end if #endif MPAS_io_open % external_file_desc = .false. @@ -750,6 +754,10 @@ subroutine MPAS_io_def_dim(handle, dimname, dimsize, ierr) else call mpas_log_write(trim(SMIOLf_error_string(local_ierr)), messageType=MPAS_LOG_ERR) end if + + io_global_err = local_ierr + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND + return end if #endif #ifdef MPAS_PIO_SUPPORT @@ -1010,6 +1018,10 @@ subroutine MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsiz else call mpas_log_write(trim(SMIOLf_error_string(local_ierr)), messageType=MPAS_LOG_ERR) end if + + io_global_err = local_ierr + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND + return end if do i=1,new_fieldlist_node % fieldhandle % ndims new_fieldlist_node % fieldhandle % dims(i) % dimname = smiol_dimnames(i) @@ -1025,6 +1037,10 @@ subroutine MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsiz else call mpas_log_write(trim(SMIOLf_error_string(local_ierr)), messageType=MPAS_LOG_ERR) end if + + io_global_err = local_ierr + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND + return end if new_fieldlist_node % fieldhandle % dims(i) % dimsize = smiol_dimlen if (new_fieldlist_node % fieldhandle % dims(i) % is_unlimited_dim) then @@ -1344,6 +1360,10 @@ subroutine MPAS_io_def_var(handle, fieldname, fieldtype, dimnames, precision, ie else call mpas_log_write(trim(SMIOLf_error_string(local_ierr)), messageType=MPAS_LOG_ERR) end if + + io_global_err = local_ierr + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND + return end if #endif @@ -1695,6 +1715,10 @@ subroutine MPAS_io_set_var_indices(handle, fieldname, indices, ierr) else call mpas_log_write(trim(SMIOLf_error_string(local_ierr)), messageType=MPAS_LOG_ERR) end if + + io_global_err = local_ierr + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND + return end if #endif @@ -1842,6 +1866,10 @@ subroutine MPAS_io_get_var_generic(handle, fieldname, intVal, intArray1d, intArr else call mpas_log_write(trim(SMIOLf_error_string(local_ierr)), messageType=MPAS_LOG_ERR) end if + + io_global_err = local_ierr + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND + return end if #endif @@ -2718,6 +2746,10 @@ subroutine MPAS_io_get_var_generic(handle, fieldname, intVal, intArray1d, intArr else call mpas_log_write(trim(SMIOLf_error_string(local_ierr)), messageType=MPAS_LOG_ERR) end if + + io_global_err = local_ierr + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND + return end if #endif @@ -3121,6 +3153,10 @@ subroutine MPAS_io_put_var_generic(handle, fieldname, intVal, intArray1d, intArr else call mpas_log_write(trim(SMIOLf_error_string(local_ierr)), messageType=MPAS_LOG_ERR) end if + + io_global_err = local_ierr + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND + return end if #endif @@ -3987,6 +4023,10 @@ subroutine MPAS_io_put_var_generic(handle, fieldname, intVal, intArray1d, intArr else call mpas_log_write(trim(SMIOLf_error_string(local_ierr)), messageType=MPAS_LOG_ERR) end if + + io_global_err = local_ierr + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND + return end if #endif @@ -5291,6 +5331,10 @@ subroutine MPAS_io_put_att_int0d(handle, attName, attValue, fieldname, syncVal, else call mpas_log_write(trim(SMIOLf_error_string(local_ierr)), messageType=MPAS_LOG_ERR) end if + + io_global_err = local_ierr + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND + return end if #endif @@ -5670,6 +5714,10 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal, else call mpas_log_write(trim(SMIOLf_error_string(local_ierr)), messageType=MPAS_LOG_ERR) end if + + io_global_err = local_ierr + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND + return end if #endif @@ -6076,6 +6124,10 @@ subroutine MPAS_io_put_att_text(handle, attName, attValue, fieldname, syncVal, i else call mpas_log_write(trim(SMIOLf_error_string(local_ierr)), messageType=MPAS_LOG_ERR) end if + + io_global_err = local_ierr + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND + return end if #endif @@ -6146,6 +6198,10 @@ subroutine MPAS_io_sync(handle, ierr) else call mpas_log_write(trim(SMIOLf_error_string(local_ierr)), messageType=MPAS_LOG_ERR) end if + + io_global_err = local_ierr + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND + return end if #endif @@ -6235,6 +6291,10 @@ subroutine MPAS_io_close(handle, ierr) else call mpas_log_write(trim(SMIOLf_error_string(local_ierr)), messageType=MPAS_LOG_ERR) end if + + io_global_err = local_ierr + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND + return end if #endif @@ -6293,6 +6353,9 @@ subroutine MPAS_io_finalize(ioContext, finalize_iosystem, ierr) local_ierr = SMIOLf_finalize(ioContext % smiol_context) if (local_ierr /= SMIOL_SUCCESS) then call mpas_log_write('SMIOLf_free_decomp failed with code $i', intArgs=[local_ierr], messageType=MPAS_LOG_ERR) + io_global_err = local_ierr + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND + return end if #endif end if From 4bf7be609e0125491d953288e0f0aafc5055d3ce Mon Sep 17 00:00:00 2001 From: Michael Duda Date: Thu, 31 Aug 2023 22:11:39 +0000 Subject: [PATCH 19/86] Add new 'ioContext' argument to MPAS_io_err_mesg to provide additional context The messages that are printed for some errors by the MPAS_io_err_mesg() routine may benefit from having access to the I/O context within which the error occurred. For example, the SMIOL library can use the SMIOL context member of the MPAS 'mpas_io_context_type' type to provide messages from the specific library that was called by SMIOL. Now, if the SMIOL error code is SMIOL_LIBRARY_ERROR, an additional line is printed by the MPAS_io_err_mesg() routine; for example: ERROR: Library error message: Unknown error in file operation With the addition of the new ioContext argument to MPAS_io_err_mesg, calls to this routine from elsewhere in MPAS (currently only in the mpas_io_stream module) have been updated to provide an appropriate value for this new argument. --- src/framework/mpas_io.F | 7 ++- src/framework/mpas_io_streams.F | 88 ++++++++++++++++----------------- 2 files changed, 50 insertions(+), 45 deletions(-) diff --git a/src/framework/mpas_io.F b/src/framework/mpas_io.F index f8c0b0eeab..cc202d8cb5 100644 --- a/src/framework/mpas_io.F +++ b/src/framework/mpas_io.F @@ -6375,10 +6375,11 @@ type (dm_info) function MPAS_io_handle_dminfo(handle) end function MPAS_io_handle_dminfo - subroutine MPAS_io_err_mesg(ierr, fatal) + subroutine MPAS_io_err_mesg(ioContext, ierr, fatal) implicit none + type (mpas_io_context_type), intent(inout) :: ioContext integer, intent(in) :: ierr logical, intent(in) :: fatal @@ -6407,6 +6408,10 @@ subroutine MPAS_io_err_mesg(ierr, fatal) #ifdef MPAS_SMIOL_SUPPORT call mpas_log_write('MPAS IO Error: SMIOL error $i: '//trim(SMIOLf_error_string(io_global_err)), & messageType=MPAS_LOG_ERR, intArgs=[io_global_err]) + if (io_global_err == SMIOL_LIBRARY_ERROR) then + call mpas_log_write('Library error message: '// & + trim(SMIOLf_lib_error_string(ioContext % smiol_context)), messageType=MPAS_LOG_ERR) + end if #endif case (MPAS_IO_ERR_DATA_MODE) call mpas_log_write('MPAS IO Error: Cannot define in data mode', MPAS_LOG_ERR) diff --git a/src/framework/mpas_io_streams.F b/src/framework/mpas_io_streams.F index 82665d243e..b445d5881a 100644 --- a/src/framework/mpas_io_streams.F +++ b/src/framework/mpas_io_streams.F @@ -118,7 +118,7 @@ subroutine MPAS_createStream(stream, ioContext, fileName, ioFormat, ioDirection, end if ! General error - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR) then if (present(ierr)) ierr = MPAS_IO_ERR return @@ -1704,7 +1704,7 @@ subroutine MPAS_streamAddField_generic(stream, fieldName, fieldType, dimNames, d !call mpas_log_write('... defining dimension '// trim(dimNames(idim))//" $i", intArgs=(/ dimSizes(idim)/)) write(dimNamesLocal(idim),'(a)') dimNames(idim) call MPAS_io_def_dim(stream % fileHandle, trim(dimNames(idim)), dimSizes(idim), io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR) then if (present(ierr)) ierr = MPAS_IO_ERR deallocate(new_field_list_node) @@ -1729,7 +1729,7 @@ subroutine MPAS_streamAddField_generic(stream, fieldName, fieldType, dimNames, d if (ndims > 0) then !call mpas_log_write('... defining dimension '// trim(dimNames(idim))//" $i", intArgs=(/ globalDimSize/)) call MPAS_io_def_dim(stream % fileHandle, trim(dimNames(idim)), globalDimSize, io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR) then if (present(ierr)) ierr = MPAS_IO_ERR deallocate(new_field_list_node) @@ -1743,7 +1743,7 @@ subroutine MPAS_streamAddField_generic(stream, fieldName, fieldType, dimNames, d if (hasTimeDimension) then !call mpas_log_write('... defining Time dimension ') call MPAS_io_def_dim(stream % fileHandle, 'Time', MPAS_IO_UNLIMITED_DIM, io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR) then if (present(ierr)) ierr = MPAS_IO_ERR deallocate(new_field_list_node) @@ -1759,7 +1759,7 @@ subroutine MPAS_streamAddField_generic(stream, fieldName, fieldType, dimNames, d !call mpas_log_write('... defining var to low-level interface with ndims $i', intArgs=(/ndims/)) call MPAS_io_def_var(stream % fileHandle, trim(fieldName), fieldType, dimNamesLocal(1:ndims), precision=precision, ierr=io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR) then if (present(ierr)) ierr = MPAS_IO_ERR deallocate(new_field_list_node) @@ -1772,7 +1772,7 @@ subroutine MPAS_streamAddField_generic(stream, fieldName, fieldType, dimNames, d call MPAS_io_inq_var(stream % fileHandle, trim(fieldName), dimnames=dimNamesInq, dimsizes=dimSizesInq, ierr=io_err) ! If the field does not exist in the input file, we should handle this situation gracefully at higher levels ! without printing disconcerting error messages - !call MPAS_io_err_mesg(io_err, .false.) + !call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR) then if (present(ierr)) ierr = MPAS_IO_ERR deallocate(new_field_list_node) @@ -1830,7 +1830,7 @@ subroutine MPAS_streamAddField_generic(stream, fieldName, fieldType, dimNames, d ! if (ndims > 0 .and. isDecomposed) then call MPAS_io_set_var_indices(stream % fileHandle, trim(fieldName), indices, io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR) then if (present(ierr)) ierr = MPAS_IO_ERR deallocate(new_field_list_node) @@ -2479,7 +2479,7 @@ subroutine MPAS_readStream(stream, frame, ierr) ! Set time frame to real ! call MPAS_io_set_frame(stream % fileHandle, frame, io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR) then if (present(ierr)) ierr = MPAS_IO_ERR return @@ -2500,7 +2500,7 @@ subroutine MPAS_readStream(stream, frame, ierr) !call mpas_log_write('MGD calling MPAS_io_get_var now...') call MPAS_io_get_var(stream % fileHandle, field_cursor % int0dField % fieldName, int0d_temp, io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR) then if (present(ierr)) ierr = MPAS_IO_ERR return @@ -2532,7 +2532,7 @@ subroutine MPAS_readStream(stream, frame, ierr) else call MPAS_io_get_var(stream % fileHandle, field_cursor % int1dField % fieldName, int1d_temp, io_err) end if - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR) then if (present(ierr)) ierr = MPAS_IO_ERR if (.not. field_cursor % int1dField % isVarArray) then @@ -2608,7 +2608,7 @@ subroutine MPAS_readStream(stream, frame, ierr) else call MPAS_io_get_var(stream % fileHandle, field_cursor % int2dField % fieldName, int2d_temp, io_err) end if - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR) then if (present(ierr)) ierr = MPAS_IO_ERR if (field_cursor % int2dField % isVarArray) then @@ -2690,7 +2690,7 @@ subroutine MPAS_readStream(stream, frame, ierr) else call MPAS_io_get_var(stream % fileHandle, field_cursor % int3dField % fieldName, int3d_temp, io_err) end if - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR) then if (present(ierr)) ierr = MPAS_IO_ERR if (field_cursor % int3dField % isVarArray) then @@ -2760,7 +2760,7 @@ subroutine MPAS_readStream(stream, frame, ierr) !call mpas_log_write('MGD calling MPAS_io_get_var now...') call MPAS_io_get_var(stream % fileHandle, field_cursor % real0dField % fieldName, real0d_temp, io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR) then if (present(ierr)) ierr = MPAS_IO_ERR return @@ -2792,7 +2792,7 @@ subroutine MPAS_readStream(stream, frame, ierr) else call MPAS_io_get_var(stream % fileHandle, field_cursor % real1dField % fieldName, real1d_temp, io_err) end if - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR) then if (present(ierr)) ierr = MPAS_IO_ERR if (.not. field_cursor % real1dField % isVarArray) then @@ -2869,7 +2869,7 @@ subroutine MPAS_readStream(stream, frame, ierr) else call MPAS_io_get_var(stream % fileHandle, field_cursor % real2dField % fieldName, real2d_temp, io_err) end if - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR) then if (present(ierr)) ierr = MPAS_IO_ERR if (field_cursor % real2dField % isVarArray) then @@ -2954,7 +2954,7 @@ subroutine MPAS_readStream(stream, frame, ierr) else call MPAS_io_get_var(stream % fileHandle, field_cursor % real3dField % fieldName, real3d_temp, io_err) end if - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR) then if (present(ierr)) ierr = MPAS_IO_ERR if (field_cursor % real3dField % isVarArray) then @@ -3041,7 +3041,7 @@ subroutine MPAS_readStream(stream, frame, ierr) else call MPAS_io_get_var(stream % fileHandle, field_cursor % real4dField % fieldName, real4d_temp, io_err) end if - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR) then if (present(ierr)) ierr = MPAS_IO_ERR if (field_cursor % real4dField % isVarArray) then @@ -3131,7 +3131,7 @@ subroutine MPAS_readStream(stream, frame, ierr) else call MPAS_io_get_var(stream % fileHandle, field_cursor % real5dField % fieldName, real5d_temp, io_err) end if - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR) then if (present(ierr)) ierr = MPAS_IO_ERR if (field_cursor % real5dField % isVarArray) then @@ -3202,7 +3202,7 @@ subroutine MPAS_readStream(stream, frame, ierr) !call mpas_log_write('MGD calling MPAS_io_get_var now...') call MPAS_io_get_var(stream % fileHandle, field_cursor % char0dField % fieldName, field_cursor % char0dField % scalar, io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR) then if (present(ierr)) ierr = MPAS_IO_ERR return @@ -3225,7 +3225,7 @@ subroutine MPAS_readStream(stream, frame, ierr) !call mpas_log_write('MGD calling MPAS_io_get_var now...') allocate(char1d_temp(field_cursor % char1dField % dimSizes(1))) call MPAS_io_get_var(stream % fileHandle, field_cursor % char1dField % fieldName, char1d_temp, io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR) then if (present(ierr)) ierr = MPAS_IO_ERR deallocate(char1d_temp) @@ -3302,7 +3302,7 @@ subroutine MPAS_writeStream(stream, frame, ierr) ! Set time frame to write ! call MPAS_io_set_frame(stream % fileHandle, frame, io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR) then if (present(ierr)) ierr = MPAS_IO_ERR return @@ -3344,7 +3344,7 @@ subroutine MPAS_writeStream(stream, frame, ierr) !call mpas_log_write('MGD calling MPAS_io_put_var now...') call MPAS_io_put_var(stream % fileHandle, field_cursor % int0dField % fieldName, int0d_temp, io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR else if (field_cursor % field_type == FIELD_1D_INT) then @@ -3401,7 +3401,7 @@ subroutine MPAS_writeStream(stream, frame, ierr) else call MPAS_io_put_var(stream % fileHandle, field_cursor % int1dField % fieldName, int1d_temp, io_err) end if - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR end do @@ -3464,7 +3464,7 @@ subroutine MPAS_writeStream(stream, frame, ierr) else call MPAS_io_put_var(stream % fileHandle, field_cursor % int2dField % fieldName, int2d_temp, io_err) end if - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR end do @@ -3531,7 +3531,7 @@ subroutine MPAS_writeStream(stream, frame, ierr) else call MPAS_io_put_var(stream % fileHandle, field_cursor % int3dField % fieldName, int3d_temp, io_err) end if - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR end do @@ -3552,7 +3552,7 @@ subroutine MPAS_writeStream(stream, frame, ierr) !call mpas_log_write('MGD calling MPAS_io_put_var now...') call MPAS_io_put_var(stream % fileHandle, field_cursor % real0dField % fieldName, real0d_temp, io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR else if (field_cursor % field_type == FIELD_1D_REAL) then @@ -3609,7 +3609,7 @@ subroutine MPAS_writeStream(stream, frame, ierr) else call MPAS_io_put_var(stream % fileHandle, field_cursor % real1dField % fieldName, real1d_temp, io_err) end if - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR end do @@ -3672,7 +3672,7 @@ subroutine MPAS_writeStream(stream, frame, ierr) else call MPAS_io_put_var(stream % fileHandle, field_cursor % real2dField % fieldName, real2d_temp, io_err) end if - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR end do @@ -3739,7 +3739,7 @@ subroutine MPAS_writeStream(stream, frame, ierr) else call MPAS_io_put_var(stream % fileHandle, field_cursor % real3dField % fieldName, real3d_temp, io_err) end if - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR end do @@ -3808,7 +3808,7 @@ subroutine MPAS_writeStream(stream, frame, ierr) else call MPAS_io_put_var(stream % fileHandle, field_cursor % real4dField % fieldName, real4d_temp, io_err) end if - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR end do @@ -3879,7 +3879,7 @@ subroutine MPAS_writeStream(stream, frame, ierr) else call MPAS_io_put_var(stream % fileHandle, field_cursor % real5dField % fieldName, real5d_temp, io_err) end if - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR end do @@ -3898,7 +3898,7 @@ subroutine MPAS_writeStream(stream, frame, ierr) !call mpas_log_write('Copying field from first block') !call mpas_log_write('MGD calling MPAS_io_put_var now...') call MPAS_io_put_var(stream % fileHandle, field_cursor % char0dField % fieldName, field_cursor % char0dField % scalar, io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR else if (field_cursor % field_type == FIELD_1D_CHAR) then @@ -3910,7 +3910,7 @@ subroutine MPAS_writeStream(stream, frame, ierr) !call mpas_log_write('Copying field from first block') !call mpas_log_write('MGD calling MPAS_io_put_var now...') call MPAS_io_put_var(stream % fileHandle, field_cursor % char1dField % fieldName, field_cursor % char1dField % array, io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR @@ -3949,7 +3949,7 @@ subroutine MPAS_readStreamAtt_0dInteger(stream, attName, attValue, ierr) end if call MPAS_io_get_att(stream % fileHandle, attName, attValue, ierr=io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR end subroutine MPAS_readStreamAtt_0dInteger @@ -3977,7 +3977,7 @@ subroutine MPAS_readStreamAtt_1dInteger(stream, attName, attValue, ierr) end if call MPAS_io_get_att(stream % fileHandle, attName, attValue, ierr=io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR end subroutine MPAS_readStreamAtt_1dInteger @@ -4013,7 +4013,7 @@ subroutine MPAS_readStreamAtt_0dReal(stream, attName, attValue, precision, ierr) end if call MPAS_io_get_att(stream % fileHandle, attName, attValue, precision=local_precision, ierr=io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR end subroutine MPAS_readStreamAtt_0dReal @@ -4049,7 +4049,7 @@ subroutine MPAS_readStreamAtt_1dReal(stream, attName, attValue, precision, ierr) end if call MPAS_io_get_att(stream % fileHandle, attName, attValue, precision=local_precision, ierr=io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR end subroutine MPAS_readStreamAtt_1dReal @@ -4077,7 +4077,7 @@ subroutine MPAS_readStreamAtt_text(stream, attName, attValue, ierr) end if call MPAS_io_get_att(stream % fileHandle, attName, attValue, ierr=io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR end subroutine MPAS_readStreamAtt_text @@ -4106,7 +4106,7 @@ subroutine MPAS_writeStreamAtt_0dInteger(stream, attName, attValue, syncVal, ier end if call MPAS_io_put_att(stream % fileHandle, attName, attValue, syncVal=syncVal, ierr=io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR end subroutine MPAS_writeStreamAtt_0dInteger @@ -4135,7 +4135,7 @@ subroutine MPAS_writeStreamAtt_1dInteger(stream, attName, attValue, syncVal, ier end if call MPAS_io_put_att(stream % fileHandle, attName, attValue, syncVal=syncVal, ierr=io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR end subroutine MPAS_writeStreamAtt_1dInteger @@ -4172,7 +4172,7 @@ subroutine MPAS_writeStreamAtt_0dReal(stream, attName, attValue, syncVal, precis end if call MPAS_io_put_att(stream % fileHandle, attName, attValue, syncVal=syncVal, precision=local_precision, ierr=io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR end subroutine MPAS_writeStreamAtt_0dReal @@ -4209,7 +4209,7 @@ subroutine MPAS_writeStreamAtt_1dReal(stream, attName, attValue, syncVal, precis end if call MPAS_io_put_att(stream % fileHandle, attName, attValue, syncVal=syncVal, precision=local_precision, ierr=io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR end subroutine MPAS_writeStreamAtt_1dReal @@ -4238,7 +4238,7 @@ subroutine MPAS_writeStreamAtt_text(stream, attName, attValue, syncVal, ierr) end if call MPAS_io_put_att(stream % fileHandle, attName, attValue, syncVal=syncVal, ierr=io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR end subroutine MPAS_writeStreamAtt_text @@ -4265,7 +4265,7 @@ subroutine MPAS_closeStream(stream, ierr) end if call MPAS_io_close(stream % fileHandle, io_err) - call MPAS_io_err_mesg(io_err, .false.) + call MPAS_io_err_mesg(stream % fileHandle % ioContext, io_err, .false.) if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR !call mpas_log_write('Deallocating global attribute list') From f16a136de39881a4b7c50cb19c5f18c525f8b872 Mon Sep 17 00:00:00 2001 From: Matthew Dimond Date: Thu, 31 Aug 2023 10:11:29 -0600 Subject: [PATCH 20/86] Update gen_inc.c to build with default Intel C compiler flags The Intel C compiler does not default to C99 standards. Introduced in C99 was the addition of variable declarations within 'for' loops. As a result, when compiling with the default Intel compiler flags, the variable declaration in the 'for' loop on line 143 failed to compile. This commit updates the file to declare the variable the line before, like the other 'for' loops in the file. The code is now verified to be compliant with the default Intel C standards, and compiles with the ifort Make target. --- src/tools/registry/gen_inc.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/tools/registry/gen_inc.c b/src/tools/registry/gen_inc.c index acf3df2d63..1b97c7792b 100644 --- a/src/tools/registry/gen_inc.c +++ b/src/tools/registry/gen_inc.c @@ -139,8 +139,8 @@ const char * modify_attr(const char *attr, const char *array[][2], size_t rows) // characters. Returns 1 if the buffer is too small for the result. int escape_quotes(const char * stringIn, char * result, size_t bufferSize){ size_t resultIndex = 0; - - for (size_t i = 0; i < strlen(stringIn) + 1; i++) { + size_t i; + for (i = 0; i < strlen(stringIn) + 1; i++) { if ( stringIn[i] == '\'' ) { if (resultIndex >= bufferSize) return 1; result[resultIndex++] = '\''; From a1ea9a40fafb945cb0ab77a3c7e39114034a663d Mon Sep 17 00:00:00 2001 From: "G. Dylan Dickerson" Date: Thu, 5 Oct 2023 16:16:38 -0600 Subject: [PATCH 21/86] Make single-precision builds default Switch logic for the PRECISION argument in the top-level Makefile so that a user has to request double-precision, with single-precision being the new default. Also add NOTE to the user that using PRECISION=single is now unnecessary. --- Makefile | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/Makefile b/Makefile index cce8e513e8..056cfeb851 100644 --- a/Makefile +++ b/Makefile @@ -831,14 +831,15 @@ ifeq "$(OPENMP_OFFLOAD)" "true" LDFLAGS += $(LDFLAGS_GPU) endif #OPENMP_OFFLOAD IF -ifeq "$(PRECISION)" "single" +ifeq "$(PRECISION)" "double" + FFLAGS += $(FFLAGS_PROMOTION) + PRECISION_MESSAGE="MPAS was built with default double-precision reals." +else +$(if $(PRECISION),$(info NOTE: PRECISION=single is unnecessary, single is the default)) CFLAGS += "-DSINGLE_PRECISION" CXXFLAGS += "-DSINGLE_PRECISION" override CPPFLAGS += "-DSINGLE_PRECISION" PRECISION_MESSAGE="MPAS was built with default single-precision reals." -else - FFLAGS += $(FFLAGS_PROMOTION) - PRECISION_MESSAGE="MPAS was built with default double-precision reals." endif #PRECISION IF ifeq "$(USE_PAPI)" "true" @@ -1353,7 +1354,7 @@ errmsg: @echo " TIMER_LIB=tau - Uses TAU for the timer interface instead of the native interface" @echo " OPENMP=true - builds and links with OpenMP flags. Default is to not use OpenMP." @echo " OPENACC=true - builds and links with OpenACC flags. Default is to not use OpenACC." - @echo " PRECISION=single - builds with default single-precision real kind. Default is to use double-precision." + @echo " PRECISION=double - builds with default double-precision real kind. Default is to use single-precision." @echo " SHAREDLIB=true - generate position-independent code suitable for use in a shared library. Default is false." @echo "" @echo "Ensure that NETCDF, PNETCDF, PIO, and PAPI (if USE_PAPI=true) are environment variables" From 68c49d52f4cde00403cc2adce85bc06dc6a6f7bb Mon Sep 17 00:00:00 2001 From: "G. Dylan Dickerson" Date: Fri, 6 Oct 2023 18:07:00 -0600 Subject: [PATCH 22/86] Add check to PRECISION argument to Makefile This check prevents any values besides "double" or "single" to be allowed, but still allows PRECISION to be unset/empty. --- Makefile | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Makefile b/Makefile index 056cfeb851..d1ab04ecfb 100644 --- a/Makefile +++ b/Makefile @@ -831,6 +831,9 @@ ifeq "$(OPENMP_OFFLOAD)" "true" LDFLAGS += $(LDFLAGS_GPU) endif #OPENMP_OFFLOAD IF +ifneq (,$(filter-out double single,$(PRECISION))) +$(error PRECISION should be "", "single", or "double"; received value "$(PRECISION)") +endif ifeq "$(PRECISION)" "double" FFLAGS += $(FFLAGS_PROMOTION) PRECISION_MESSAGE="MPAS was built with default double-precision reals." From 699765de4bedf14f29eb9b91ecba7f7199e5b0f9 Mon Sep 17 00:00:00 2001 From: Michael Duda Date: Tue, 3 Oct 2023 10:06:47 -0600 Subject: [PATCH 23/86] Enable supersampling of 30" terrestrial fields: ter, ivgtyp, isltyp, greenfrac With the introduction of a new namelist option, config_30s_supersample_factor, in the &data_sources namelist group, the supersampling ratio for several 30-arc-second datasets may now be controlled from the namelist.init_atmosphere file. The config_30s_supersample_factor option defaults to 1, which appears to be reasonable for MPAS meshes with >= 3 km cells. Experimentally, a supersampling factor of 2 was found to be sufficient for a 1-km quasi-uniform regional mesh centered over Colorado. The init_atm_map_static_data routine, which is used by the interp_terrain, interp_landuse, and interp_soilcat routines, already supported supersampling, and all that was required for these fields was to pass the namelist supersampling value down the subroutine call stack. The code to remap the MODIS FPAR 30-arc-second greenness fraction data did not support supersampling, and so was modified to use the same approach as for terrain, land use, and soil category. --- src/core_init_atmosphere/Registry.xml | 5 ++ .../mpas_init_atm_static.F | 50 +++++++++++++------ 2 files changed, 39 insertions(+), 16 deletions(-) diff --git a/src/core_init_atmosphere/Registry.xml b/src/core_init_atmosphere/Registry.xml index e40f5c3722..ff6ac3dbe4 100644 --- a/src/core_init_atmosphere/Registry.xml +++ b/src/core_init_atmosphere/Registry.xml @@ -182,6 +182,11 @@ description="The supersampling factor to be used for MODIS maximum snow albedo and monthly albedo datasets (case 7 only)" possible_values="Positive integer values"/> + + 1) then + call mpas_log_write(' Dataset will be supersampled by a factor of $i', intArgs=(/supersample_fac_30s/)) + end if + geog_sub_path = 'greenfrac_fpar_modis/' ierr = mgr % init(trim(geog_data_path)//trim(geog_sub_path)) @@ -750,10 +759,13 @@ subroutine init_atm_static(mesh, dims, configs) all_pixels_mapped_to_halo_cells = .true. - do j = tile_bdr + 1, tile_ny + tile_bdr, 1 - do i = tile_bdr + 1, tile_nx + tile_bdr, 1 + do j = supersample_fac_30s * tile_bdr + 1, supersample_fac_30s * (tile_ny + tile_bdr), 1 + do i = supersample_fac_30s * tile_bdr + 1, supersample_fac_30s * (tile_nx + tile_bdr), 1 + + ii = (i - 1) / supersample_fac_30s + 1 + jj = (j - 1) / supersample_fac_30s + 1 - call mgr % tile_to_latlon(tile, j, i, lat_pt, lon_pt) + call mgr % tile_to_latlon(tile, j, i, lat_pt, lon_pt, supersample_fac_30s) call mpas_latlon_to_xyz(xPixel, yPixel, zPixel, sphere_radius, lat_pt, lon_pt) call mpas_kd_search(tree, (/xPixel, yPixel, zPixel/), res, max_distance=max_kdtree_distance2) @@ -766,10 +778,10 @@ subroutine init_atm_static(mesh, dims, configs) ! if (landMask(res % id) == 1 .and. bdyMaskCell(res % id) < nBdyLayers) then do k = 1, tile_nz - if (tile % tile(i, j, k) == missing_value) then + if (tile % tile(ii, jj, k) == missing_value) then i8val = int(fillval, kind=I8KIND) else - i8val = int(tile % tile(i,j,k), kind=I8KIND) + i8val = int(tile % tile(ii, jj, k), kind=I8KIND) end if greenfrac_int(k, res % id) = greenfrac_int(k, res % id) + i8val end do @@ -785,10 +797,10 @@ subroutine init_atm_static(mesh, dims, configs) if (mpas_in_cell(xPixel, yPixel, zPixel, xCell(res % id), yCell(res % id), zCell(res % id), & nEdgesOnCell(res % id), verticesOnCell(:,res % id), xVertex, yVertex, zVertex)) then do k = 1, tile_nz - if (tile % tile(i, j, k) == missing_value) then + if (tile % tile(ii, jj, k) == missing_value) then i8val = int(fillval, kind=I8KIND) else - i8val = int(tile % tile(i,j,k), kind=I8KIND) + i8val = int(tile % tile(ii, jj, k), kind=I8KIND) end if greenfrac_int(k, res % id) = greenfrac_int(k, res % id) + i8val end do @@ -1435,7 +1447,7 @@ end subroutine terrain_interp_accumulation !> should be the path to the terrain dataset. ! !----------------------------------------------------------------------- - subroutine interp_terrain(mesh, kdtree, geog_data_path) + subroutine interp_terrain(mesh, kdtree, geog_data_path, supersample_fac) implicit none @@ -1443,6 +1455,7 @@ subroutine interp_terrain(mesh, kdtree, geog_data_path) type (mpas_pool_type), intent(inout) :: mesh type (mpas_kd_type), pointer, intent(in) :: kdtree character (len=*), intent(in) :: geog_data_path + integer, intent(in), optional :: supersample_fac ! Local variables type (mpas_geotile_mgr_type) :: mgr @@ -1478,7 +1491,8 @@ subroutine interp_terrain(mesh, kdtree, geog_data_path) ter_integer(:) = 0 nhs(:) = 0 - call init_atm_map_static_data(mesh, mgr, kdtree, continuous_interp_criteria, terrain_interp_accumulation) + call init_atm_map_static_data(mesh, mgr, kdtree, continuous_interp_criteria, terrain_interp_accumulation, & + supersample_fac=supersample_fac) do iCell = 1, nCells ter(iCell) = real(real(ter_integer(iCell), kind=R8KIND) / real(nhs(iCell), kind=R8KIND), kind=RKIND) @@ -1571,7 +1585,7 @@ end subroutine categorical_interp_accumulation !> that isice and iswater are in the dataset's index file. ! !----------------------------------------------------------------------- - subroutine interp_landuse(mesh, kdtree, geog_data_path, isice_lu, iswater_lu) + subroutine interp_landuse(mesh, kdtree, geog_data_path, isice_lu, iswater_lu, supersample_fac) implicit none @@ -1581,6 +1595,7 @@ subroutine interp_landuse(mesh, kdtree, geog_data_path, isice_lu, iswater_lu) character (len=*), intent(in) :: geog_data_path integer, intent(out) :: isice_lu integer, intent(out) :: iswater_lu + integer, intent(in), optional :: supersample_fac ! Local variables type (mpas_geotile_mgr_type) :: mgr @@ -1613,7 +1628,8 @@ subroutine interp_landuse(mesh, kdtree, geog_data_path, isice_lu, iswater_lu) allocate(ncat(category_min:category_max, nCells)) ncat(:,:) = 0 - call init_atm_map_static_data(mesh, mgr, kdtree, categorical_interp_criteria, categorical_interp_accumulation) + call init_atm_map_static_data(mesh, mgr, kdtree, categorical_interp_criteria, categorical_interp_accumulation, & + supersample_fac=supersample_fac) do iCell = 1, nCells ! Because maxloc returns the location of the maximum value of an array as if the @@ -1652,7 +1668,7 @@ end subroutine interp_landuse !> iswater is present in the dataset's index file. !> !----------------------------------------------------------------------- - subroutine interp_soilcat(mesh, kdtree, geog_data_path, iswater_soil) + subroutine interp_soilcat(mesh, kdtree, geog_data_path, iswater_soil, supersample_fac) implicit none @@ -1661,6 +1677,7 @@ subroutine interp_soilcat(mesh, kdtree, geog_data_path, iswater_soil) type (mpas_kd_type), pointer, intent(in) :: kdtree character (len=*), intent(in) :: geog_data_path integer, intent(out) :: iswater_soil + integer, intent(in), optional :: supersample_fac ! Local variables type (mpas_geotile_mgr_type) :: mgr @@ -1690,7 +1707,8 @@ subroutine interp_soilcat(mesh, kdtree, geog_data_path, iswater_soil) allocate(ncat(category_min:category_max, nCells)) ncat(:,:) = 0 - call init_atm_map_static_data(mesh, mgr, kdtree, categorical_interp_criteria, categorical_interp_accumulation) + call init_atm_map_static_data(mesh, mgr, kdtree, categorical_interp_criteria, categorical_interp_accumulation, & + supersample_fac=supersample_fac) do iCell = 1, nCells ! Because maxloc returns the location of the maximum value of an array as if the From f1efe7478e36ac21384e13c05e0cd2570a5f86e7 Mon Sep 17 00:00:00 2001 From: Matthew Dimond Date: Thu, 3 Aug 2023 09:47:45 -0600 Subject: [PATCH 24/86] Add cf-compliant time axis to core_atmopshere CF compliance in time axis requires a unit of '