diff --git a/.github/DISCUSSION_TEMPLATE/building-installing.yaml b/.github/DISCUSSION_TEMPLATE/building-installing.yaml new file mode 100644 index 0000000000..3857be7489 --- /dev/null +++ b/.github/DISCUSSION_TEMPLATE/building-installing.yaml @@ -0,0 +1,50 @@ +labels: ["source: discussions", "build/porting"] +body: + - type: markdown + attributes: + value: | + ### Instructions + Before submitting a new discussion please review the [ESMF User's Guide](https://earthsystemmodeling.org/doc/) and check for [existing discussions](https://github.com/orgs/esmf-org/discussions?discussions_q=). + + **Note:** The ESMF Core Team continues to operate the esmf_support@ucar.edu address. If you have privacy concerns posting to ESMF Discussions or if you prefer email then send us an email. + - type: checkboxes + attributes: + label: Requirements + options: + - label: Reviewed [ESMF User's Guide](https://earthsystemmodeling.org/doc/) + required: true + - label: Searched [GitHub Discussions](https://github.com/orgs/esmf-org/discussions?discussions_q=) + required: true + - type: input + id: affiliation + attributes: + label: Affiliation(s) + description: "Are you affiliated with an organization?" + placeholder: "NASA, NOAA, NRL, NSF-NCAR, University, ..." + validations: + required: false + - type: input + id: version + attributes: + label: ESMF Version + description: "What version of ESMF are you using?" + placeholder: "v0.0.0" + validations: + required: false + - type: textarea + id: question + attributes: + label: Issue + description: "What is your question or issue?" + placeholder: "enter issue here" + validations: + required: true + - type: dropdown + id: tag + attributes: + label: Autotag + options: + - "@oehmke" + default: 0 + validations: + required: true diff --git a/.github/DISCUSSION_TEMPLATE/esmpy.yaml b/.github/DISCUSSION_TEMPLATE/esmpy.yaml new file mode 100644 index 0000000000..8a18f2c628 --- /dev/null +++ b/.github/DISCUSSION_TEMPLATE/esmpy.yaml @@ -0,0 +1,50 @@ +labels: ["source: discussions", "product: ESMPy"] +body: + - type: markdown + attributes: + value: | + ### Instructions + Before submitting a new discussion please review the [ESMPy Documentation](https://earthsystemmodeling.org/esmpy/) and check for [existing discussions](https://github.com/orgs/esmf-org/discussions?discussions_q=). + + **Note:** The ESMF Core Team continues to operate the esmf_support@ucar.edu address. If you have privacy concerns posting to ESMF Discussions or if you prefer email then send us an email. + - type: checkboxes + attributes: + label: Requirements + options: + - label: Reviewed [ESMPy Documentation](https://earthsystemmodeling.org/esmpy/) + required: true + - label: Searched [GitHub Discussions](https://github.com/orgs/esmf-org/discussions?discussions_q=) + required: true + - type: input + id: affiliation + attributes: + label: Affiliation(s) + description: "Are you affiliated with an organization?" + placeholder: "NASA, NOAA, NRL, NSF-NCAR, University, ..." + validations: + required: false + - type: input + id: version + attributes: + label: ESMF Version + description: "What version of ESMF are you using?" + placeholder: "v0.0.0" + validations: + required: false + - type: textarea + id: question + attributes: + label: Issue + description: "What is your question or issue?" + placeholder: "enter issue here" + validations: + required: true + - type: dropdown + id: tag + attributes: + label: Autotag + options: + - "@billsacks" + default: 0 + validations: + required: true diff --git a/.github/DISCUSSION_TEMPLATE/esmx.yaml b/.github/DISCUSSION_TEMPLATE/esmx.yaml new file mode 100644 index 0000000000..9da34d7705 --- /dev/null +++ b/.github/DISCUSSION_TEMPLATE/esmx.yaml @@ -0,0 +1,50 @@ +labels: ["source: discussions", "product: ESMX"] +body: + - type: markdown + attributes: + value: | + ### Instructions + Before submitting a new discussion please review the [ESMX Guide](https://github.com/esmf-org/esmf/tree/develop/src/addon/ESMX) and check for [existing discussions](https://github.com/orgs/esmf-org/discussions?discussions_q=). + + **Note:** The ESMF Core Team continues to operate the esmf_support@ucar.edu address. If you have privacy concerns posting to ESMF Discussions or if you prefer email then send us an email. + - type: checkboxes + attributes: + label: Requirements + options: + - label: Reviewed [ESMX Guide](https://github.com/esmf-org/esmf/tree/develop/src/addon/ESMX) + required: true + - label: Searched [GitHub Discussions](https://github.com/orgs/esmf-org/discussions?discussions_q=) + required: true + - type: input + id: affiliation + attributes: + label: Affiliation(s) + description: "Are you affiliated with an organization?" + placeholder: "NASA, NOAA, NRL, NSF-NCAR, University, ..." + validations: + required: false + - type: input + id: version + attributes: + label: ESMF Version + description: "What version of ESMF are you using?" + placeholder: "v0.0.0" + validations: + required: false + - type: textarea + id: question + attributes: + label: Issue + description: "What is your question or issue?" + placeholder: "enter issue here" + validations: + required: true + - type: dropdown + id: tag + attributes: + label: Autotag + options: + - "@danrosen25" + default: 0 + validations: + required: true diff --git a/.github/DISCUSSION_TEMPLATE/infrastructure-superstructure.yaml b/.github/DISCUSSION_TEMPLATE/infrastructure-superstructure.yaml new file mode 100644 index 0000000000..6d96caf5d4 --- /dev/null +++ b/.github/DISCUSSION_TEMPLATE/infrastructure-superstructure.yaml @@ -0,0 +1,50 @@ +labels: ["source: discussions", "product: ESMF"] +body: + - type: markdown + attributes: + value: | + ### Instructions + Before submitting a new discussion please review the [ESMF Reference Manuals](https://earthsystemmodeling.org/doc/) and check for [existing discussions](https://github.com/orgs/esmf-org/discussions?discussions_q=). + + **Note:** The ESMF Core Team continues to operate the esmf_support@ucar.edu address. If you have privacy concerns posting to ESMF Discussions or if you prefer email then send us an email. + - type: checkboxes + attributes: + label: Requirements + options: + - label: Reviewed [ESMF Reference Manual](https://earthsystemmodeling.org/doc/) + required: true + - label: Searched [GitHub Discussions](https://github.com/orgs/esmf-org/discussions?discussions_q=) + required: true + - type: input + id: affiliation + attributes: + label: Affiliation(s) + description: "Are you affiliated with an organization?" + placeholder: "NASA, NOAA, NRL, NSF-NCAR, University, ..." + validations: + required: false + - type: input + id: version + attributes: + label: ESMF Version + description: "What version of ESMF are you using?" + placeholder: "v0.0.0" + validations: + required: false + - type: textarea + id: question + attributes: + label: Issue + description: "What is your question or issue?" + placeholder: "enter issue here" + validations: + required: true + - type: dropdown + id: tag + attributes: + label: Autotag + options: + - "@oehmke" + default: 0 + validations: + required: true diff --git a/.github/DISCUSSION_TEMPLATE/nuopc.yaml b/.github/DISCUSSION_TEMPLATE/nuopc.yaml new file mode 100644 index 0000000000..a46b4098b6 --- /dev/null +++ b/.github/DISCUSSION_TEMPLATE/nuopc.yaml @@ -0,0 +1,50 @@ +labels: ["source: discussions", "product: NUOPC"] +body: + - type: markdown + attributes: + value: | + ### Instructions + Before submitting a new discussion please review the [NUOPC Reference Manual](https://earthsystemmodeling.org/doc/) and check for [existing discussions](https://github.com/orgs/esmf-org/discussions?discussions_q=). + + **Note:** The ESMF Core Team continues to operate the esmf_support@ucar.edu address. If you have privacy concerns posting to ESMF Discussions or if you prefer email then send us an email. + - type: checkboxes + attributes: + label: Requirements + options: + - label: Reviewed [NUOPC Reference Manual](https://earthsystemmodeling.org/doc/) + required: true + - label: Searched [GitHub Discussions](https://github.com/orgs/esmf-org/discussions?discussions_q=) + required: true + - type: input + id: affiliation + attributes: + label: Affiliation(s) + description: "Are you affiliated with an organization?" + placeholder: "NASA, NOAA, NRL, NSF-NCAR, University, ..." + validations: + required: false + - type: input + id: version + attributes: + label: ESMF Version + description: "What version of ESMF are you using?" + placeholder: "v0.0.0" + validations: + required: false + - type: textarea + id: question + attributes: + label: Issue + description: "What is your question or issue?" + placeholder: "enter issue here" + validations: + required: true + - type: dropdown + id: tag + attributes: + label: Autotag + options: + - "@danrosen25" + default: 0 + validations: + required: true diff --git a/.github/DISCUSSION_TEMPLATE/other.yaml b/.github/DISCUSSION_TEMPLATE/other.yaml new file mode 100644 index 0000000000..a76da68998 --- /dev/null +++ b/.github/DISCUSSION_TEMPLATE/other.yaml @@ -0,0 +1,50 @@ +labels: ["source: discussions"] +body: + - type: markdown + attributes: + value: | + ### Instructions + Before submitting a new discussion please review the [ESMF Documentation](https://earthsystemmodeling.org/doc/) and check for [existing discussions](https://github.com/orgs/esmf-org/discussions?discussions_q=). + + **Note:** The ESMF Core Team continues to operate the esmf_support@ucar.edu address. If you have privacy concerns posting to ESMF Discussions or if you prefer email then send us an email. + - type: checkboxes + attributes: + label: Requirements + options: + - label: Reviewed [ESMF Documentation](https://earthsystemmodeling.org/doc/) + required: true + - label: Searched [GitHub Discussions](https://github.com/orgs/esmf-org/discussions?discussions_q=) + required: true + - type: input + id: affiliation + attributes: + label: Affiliation(s) + description: "Are you affiliated with an organization?" + placeholder: "NASA, NOAA, NRL, NSF-NCAR, University, ..." + validations: + required: false + - type: input + id: version + attributes: + label: ESMF Version + description: "What version of ESMF are you using?" + placeholder: "v0.0.0" + validations: + required: false + - type: textarea + id: question + attributes: + label: Issue + description: "What is your question or issue?" + placeholder: "enter issue here" + validations: + required: true + - type: dropdown + id: tag + attributes: + label: Autotag + options: + - "@anntsay" + default: 0 + validations: + required: false diff --git a/.github/DISCUSSION_TEMPLATE/performance-parallelization.yaml b/.github/DISCUSSION_TEMPLATE/performance-parallelization.yaml new file mode 100644 index 0000000000..e89ca4d5c1 --- /dev/null +++ b/.github/DISCUSSION_TEMPLATE/performance-parallelization.yaml @@ -0,0 +1,50 @@ +labels: ["source: discussions", "performance"] +body: + - type: markdown + attributes: + value: | + ### Instructions + Before submitting a new discussion please review the [ESMF Reference Manuals](https://earthsystemmodeling.org/doc/) and check for [existing discussions](https://github.com/orgs/esmf-org/discussions?discussions_q=). + + **Note:** The ESMF Core Team continues to operate the esmf_support@ucar.edu address. If you have privacy concerns posting to ESMF Discussions or if you prefer email then send us an email. + - type: checkboxes + attributes: + label: Requirements + options: + - label: Reviewed [ESMF Reference Manual](https://earthsystemmodeling.org/doc/) + required: true + - label: Searched [GitHub Discussions](https://github.com/orgs/esmf-org/discussions?discussions_q=) + required: true + - type: input + id: affiliation + attributes: + label: Affiliation(s) + description: "Are you affiliated with an organization?" + placeholder: "NASA, NOAA, NRL, NSF-NCAR, University, ..." + validations: + required: false + - type: input + id: version + attributes: + label: ESMF Version + description: "What version of ESMF are you using?" + placeholder: "v0.0.0" + validations: + required: false + - type: textarea + id: question + attributes: + label: Issue + description: "What is your question or issue?" + placeholder: "enter issue here" + validations: + required: true + - type: dropdown + id: tag + attributes: + label: Autotag + options: + - "@oehmke" + default: 0 + validations: + required: true diff --git a/.github/DISCUSSION_TEMPLATE/remapping-regridding.yaml b/.github/DISCUSSION_TEMPLATE/remapping-regridding.yaml new file mode 100644 index 0000000000..c0213ae60c --- /dev/null +++ b/.github/DISCUSSION_TEMPLATE/remapping-regridding.yaml @@ -0,0 +1,50 @@ +labels: ["source: discussions"] +body: + - type: markdown + attributes: + value: | + ### Instructions + Before submitting a new discussion please review the [ESMF Reference Manuals](https://earthsystemmodeling.org/doc/) and check for [existing discussions](https://github.com/orgs/esmf-org/discussions?discussions_q=). + + **Note:** The ESMF Core Team continues to operate the esmf_support@ucar.edu address. If you have privacy concerns posting to ESMF Discussions or if you prefer email then send us an email. + - type: checkboxes + attributes: + label: Requirements + options: + - label: Reviewed [ESMF Reference Manual](https://earthsystemmodeling.org/doc/) + required: true + - label: Searched [GitHub Discussions](https://github.com/orgs/esmf-org/discussions?discussions_q=) + required: true + - type: input + id: affiliation + attributes: + label: Affiliation(s) + description: "Are you affiliated with an organization?" + placeholder: "NASA, NOAA, NRL, NSF-NCAR, University, ..." + validations: + required: false + - type: input + id: version + attributes: + label: ESMF Version + description: "What version of ESMF are you using?" + placeholder: "v0.0.0" + validations: + required: false + - type: textarea + id: question + attributes: + label: Issue + description: "What is your question or issue?" + placeholder: "enter issue here" + validations: + required: true + - type: dropdown + id: tag + attributes: + label: Autotag + options: + - "@oehmke" + default: 0 + validations: + required: true diff --git a/.github/workflows/test-build-spack.yml b/.github/workflows/test-build-spack.yml index 11418fbcb6..845fd5f719 100644 --- a/.github/workflows/test-build-spack.yml +++ b/.github/workflows/test-build-spack.yml @@ -28,7 +28,7 @@ on: jobs: set-matrix: - runs-on: ubuntu-latest + runs-on: ubuntu-24.04 outputs: matrix: ${{ steps.list_comp_pkgs.outputs.matrix }} @@ -66,7 +66,7 @@ jobs: build: needs: set-matrix - runs-on: ubuntu-latest + runs-on: ubuntu-24.04 strategy: matrix: ${{ fromJson(needs.set-matrix.outputs.matrix) }} diff --git a/.zenodo.json b/.zenodo.json new file mode 100644 index 0000000000..f730d54b43 --- /dev/null +++ b/.zenodo.json @@ -0,0 +1,7 @@ +{ + "creators": [ + { + "name": "ESMF Core Team" + } + ] +} diff --git a/README.md b/README.md index a4cb743581..499f50e5fd 100644 --- a/README.md +++ b/README.md @@ -4,6 +4,8 @@ # Earth System Modeling Framework (ESMF) +[![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.11205526.svg)](https://doi.org/10.5281/zenodo.11205526) + >Copyright (c) 2002-2024 University Corporation for Atmospheric Research, Massachusetts Institute of Technology, Geophysical Fluid Dynamics Laboratory, University of Michigan, National Centers for Environmental Prediction, Los Alamos National Laboratory, Argonne National Laboratory, NASA Goddard Space Flight Center. All rights reserved. Hello and welcome to ESMF. diff --git a/build/common.mk b/build/common.mk index ba2e644337..836f6f177e 100644 --- a/build/common.mk +++ b/build/common.mk @@ -2354,7 +2354,7 @@ endif lib: info @$(MAKE) build_libs @$(MAKE) build_tracelibs - @$(MAKE) info_mk + @$(MAKE) info_mk ESMF_CCOMPILEPATHS="$(ESMF_CCOMPILEPATHS) -I$(ESMF_CONFDIR)" @echo "ESMF library built successfully on "`date` @echo "To verify, build and run the unit and system tests with: $(MAKE) check" @echo " or the more extensive: $(MAKE) all_tests" diff --git a/makefile b/makefile index 3a2443b8df..1691cf50bd 100644 --- a/makefile +++ b/makefile @@ -782,6 +782,7 @@ install: envdump -@echo "Installing ESMF:" -@echo " " mkdir -p $(ESMF_INSTALL_HEADERDIR_ABSPATH) + cp -f $(ESMF_BUILD)/src/include/NUOPC.h $(ESMF_INSTALL_HEADERDIR_ABSPATH) cp -f $(ESMF_BUILD)/src/include/ESMC.h $(ESMF_INSTALL_HEADERDIR_ABSPATH) cp -f $(ESMF_BUILD)/src/include/ESMC_*.h $(ESMF_INSTALL_HEADERDIR_ABSPATH) cp -f $(ESMF_DIR)/build_config/$(ESMF_OS).$(ESMF_COMPILER).$(ESMF_SITE)/ESMC_Conf.h $(ESMF_INSTALL_HEADERDIR_ABSPATH) diff --git a/src/Infrastructure/Config/doc/Config_usage.tex b/src/Infrastructure/Config/doc/Config_usage.tex index b6fb6aaa89..430f7ee10f 100644 --- a/src/Infrastructure/Config/doc/Config_usage.tex +++ b/src/Infrastructure/Config/doc/Config_usage.tex @@ -3,11 +3,11 @@ \subsubsection{Resource files} A {\em Resource File (RF)} is a text file consisting of list of - {\em label}-{\em value} pairs. There is a limit of 1024 characters - per line and the Resource File can contain a maximum of 200 records. - Each {\em label} should be followed by some data, the {\em value}. - An example Resource File follows. It is the file used in the example - below. + {\em label}-{\em value} pairs. There is a buffer limit of 256,000 + characters for the entire Resource File. Each {\em label} is limited + to 1,000 characters. Each label should be followed by some data, the + {\em value}. An example Resource File follows. It is the file used + in the example below. \begin{verbatim} # This is an example Resource File. diff --git a/src/Infrastructure/Config/src/ESMF_Config.F90 b/src/Infrastructure/Config/src/ESMF_Config.F90 index 8c311d950c..6673283b3f 100644 --- a/src/Infrastructure/Config/src/ESMF_Config.F90 +++ b/src/Infrastructure/Config/src/ESMF_Config.F90 @@ -182,23 +182,18 @@ module ESMF_ConfigMod !------------------------------------------------------------------------------ ! Revised parameter table to fit Fortran 90 standard. - integer, parameter :: LSZ = max (1024,ESMF_MAXPATHLEN) ! Maximum line size - ! should be at least long enough - ! to read in a file name with full - ! path prepended. - integer, parameter :: MSZ = 256 ! Used to size buffer; this is - ! usually *less* than the number - ! of non-blank/comment lines - ! (because most lines are shorter - ! then LSZ) - - integer, parameter :: NBUF_MAX = MSZ*LSZ ! max size of buffer + integer, parameter :: LSZ = 1024 ! Maximum label size + integer, parameter :: NBUF_MAX = 256*1024 ! max size of buffer integer, parameter :: NATT_MAX = NBUF_MAX/64 ! max # attributes; ! assumes an average line ! size of 16, the code ! will do a bound check character, parameter :: BLK = achar(32) ! blank (space) + character, parameter :: QTD = achar(34) ! double quotation " + character, parameter :: CMT = achar(35) ! number sign # + character, parameter :: DSN = achar(36) ! dollar sign $ + character, parameter :: QTS = achar(39) ! single quotation ' character, parameter :: TAB = achar(09) ! TAB character, parameter :: EOL = achar(10) ! end of line mark (newline) character, parameter :: EOB = achar(00) ! end of buffer mark (null) @@ -223,10 +218,11 @@ module ESMF_ConfigMod #endif !private character(len=NBUF_MAX),pointer :: buffer => null () ! hold the whole file - character(len=LSZ), pointer :: this_line => null () ! the current line integer :: nbuf ! actual size of buffer integer :: next_line ! index_ for next line on buffer + integer :: next_item ! index_ for beginning of line integer :: value_begin ! index of beginning of value + logical :: eolflag ! end of line reached type(ESMF_ConfigAttrUsed), dimension(:), & pointer :: attr_used => null () ! used attributes table integer :: nattr ! number of attributes @@ -514,7 +510,6 @@ subroutine ESMF_ConfigClassInit(s) ! !EOPI nullify(s%buffer) - nullify(s%this_line) nullify(s%attr_used) ESMF_INIT_SET_DEFINED(s) @@ -646,7 +641,7 @@ type(ESMF_Config) function ESMF_ConfigCreateDefault(keywordEnforcer, hconfig, rc if (ESMF_LogFoundAllocError(memstat, msg="Allocating config class", & ESMF_CONTEXT, rcToReturn=rc)) return - allocate(config_local%buffer, config_local%this_line, stat = memstat) + allocate(config_local%buffer, stat = memstat) if (ESMF_LogFoundAllocError(memstat, msg="Allocating local buffer 1", & ESMF_CONTEXT, rcToReturn=rc)) return @@ -660,6 +655,8 @@ type(ESMF_Config) function ESMF_ConfigCreateDefault(keywordEnforcer, hconfig, rc config_local%nbuf = 2 config_local%buffer(1:1) = EOL config_local%buffer(2:2) = EOB + config_local%next_item = 1 + config_local%eolflag = .false. config_local%next_line = 2 config_local%attr_used => attr_used_local @@ -785,8 +782,9 @@ type(ESMF_Config) function ESMF_ConfigCreateFromSection(config, & ESMF_ConfigCreateFromSection % cptr % nbuf = ptr ESMF_ConfigCreateFromSection % cptr % buffer(ptr:ptr) = EOB - ESMF_ConfigCreateFromSection % cptr % this_line = ' ' - ESMF_ConfigCreateFromSection % cptr % next_line = 1 + ESMF_ConfigCreateFromSection % cptr % next_line = 2 + ESMF_ConfigCreateFromSection % cptr % next_item = 1 + ESMF_ConfigCreateFromSection % cptr % eolflag = .false. ESMF_ConfigCreateFromSection % cptr % value_begin = 1 call ESMF_ConfigParseAttributes(ESMF_ConfigCreateFromSection, & @@ -864,7 +862,7 @@ subroutine ESMF_ConfigDestroy(config, keywordEnforcer, rc) if (ESMF_LogFoundDeallocError(memstat, msg="Deallocating local buffer 2", & ESMF_CONTEXT, rcToReturn=rc)) return - deallocate(config%cptr%buffer, config%cptr%this_line, stat = memstat) + deallocate(config%cptr%buffer, stat = memstat) if (ESMF_LogFoundDeallocError(memstat, msg="Deallocating local buffer 1", & ESMF_CONTEXT, rcToReturn=rc)) return @@ -957,7 +955,6 @@ subroutine ESMF_ConfigFindLabel(config, label, keywordEnforcer, isPresent, rc) i = index_ ( config%cptr%buffer(1:config%cptr%nbuf), EOL//label ) + 1 if ( i .eq. 1 ) then - config%cptr%this_line = BLK // EOL if (present (isPresent)) then if (present (rc)) rc = ESMF_SUCCESS return @@ -984,12 +981,22 @@ subroutine ESMF_ConfigFindLabel(config, label, keywordEnforcer, isPresent, rc) ! Extract the line associated with this label ! ------------------------------------------- i = i + len ( label ) - j = i + index_(config%cptr%buffer(i:config%cptr%nbuf),EOL) - 2 - config%cptr%this_line = config%cptr%buffer(i:j) // BLK // EOL - - config%cptr%next_line = j + 2 - + j = verify(config%cptr%buffer(i:config%cptr%nbuf),":") + if (j .eq. 0) then + i = config%cptr%nbuf + else + i = i + j - 1 + end if config%cptr%value_begin = i + config%cptr%next_item = i + config%cptr%eolflag = .false. + + j = index_(config%cptr%buffer(i:config%cptr%nbuf),EOL) + if (j .eq. 0) then + config%cptr%next_line = config%cptr%nbuf + else + config%cptr%next_line = i + j + end if if ( present (rc )) rc = ESMF_SUCCESS @@ -1053,7 +1060,6 @@ subroutine ESMF_ConfigFindNextLabel(config, label, keywordEnforcer, isPresent, r i = index_ ( config%cptr%buffer(ptr:config%cptr%nbuf ), EOL//label) + 1 if ( i .eq. 1 ) then - config%cptr%this_line = BLK // EOL if (present (isPresent)) then if (present (rc)) rc = ESMF_SUCCESS return @@ -1079,12 +1085,22 @@ subroutine ESMF_ConfigFindNextLabel(config, label, keywordEnforcer, isPresent, r ! Extract the line associated with this label ! ------------------------------------------- i = i + len ( label ) + ptr - 1 - j = i + index_ ( config%cptr%buffer(i:config%cptr%nbuf),EOL ) - 2 - config%cptr%this_line = config%cptr%buffer(ptr:j) // BLK // EOL - - config%cptr%next_line = j + 2 - + j = verify(config%cptr%buffer(i:config%cptr%nbuf),":") + if (j .eq. 0) then + i = config%cptr%nbuf + else + i = i + j - 1 + end if config%cptr%value_begin = i + config%cptr%next_item = i + config%cptr%eolflag = .false. + + j = index_(config%cptr%buffer(i:config%cptr%nbuf),EOL) + if (j .eq. 0) then + config%cptr%next_line = config%cptr%nbuf + else + config%cptr%next_line = i + j + end if if ( present (rc )) rc = ESMF_SUCCESS @@ -1287,7 +1303,7 @@ subroutine ESMF_ConfigGetString(config, value, & !EOPI ------------------------------------------------------------------ character(len=1) :: ch - integer :: ib, ie, localrc + integer :: ib, ie, nb, localrc logical :: found ! Initialize return code; assume routine not implemented @@ -1300,21 +1316,18 @@ subroutine ESMF_ConfigGetString(config, value, & ! Default setting if( present( default ) ) then - value = default - else - value = BLK - endif - - if (present (eolFlag)) then - eolFlag = .false. - end if - - if (present (default)) then if (len (value) < len (default)) then if (ESMF_LogFoundError (ESMF_RC_ARG_BAD, & msg='default length too long for value string', & ESMF_CONTEXT, rcToReturn=rc)) return end if + value = default + else + value = BLK + endif + + if (present (eolFlag)) then + eolFlag = .false. end if ! Processing @@ -1337,22 +1350,15 @@ subroutine ESMF_ConfigGetString(config, value, & endif endif - call ESMF_Config_trim ( config%cptr%this_line ) - - ch = config%cptr%this_line(1:1) - if ( ch .eq. '"' .or. ch .eq. "'" ) then - ib = 2 - ie = index_ ( config%cptr%this_line(ib:), ch ) - else - ib = 1 - ie = min(index_(config%cptr%this_line,BLK), & - index_(config%cptr%this_line,EOL)) - 1 - end if - - if ( ie .lt. ib ) then - value = BLK + ib = config%cptr%next_item + ie = config%cptr%next_line-2 + if ( config%cptr%eolflag ) then + ! reached end of line + config%cptr%next_item = config%cptr%next_line-1 if ( present ( default )) then value = default + else + value = BLK endif if (present (eolFlag)) then eolFlag = .true. @@ -1365,21 +1371,65 @@ subroutine ESMF_ConfigGetString(config, value, & endif return else - ! Get the string, and shift the rest of %this_line to - ! the left - value = config%cptr%this_line(ib:ie) - config%cptr%this_line = config%cptr%this_line(ie+2:) - if (len (value) >= ie-ib+1) then - localrc = ESMF_SUCCESS - else - localrc = ESMF_RC_ARG_SIZE - end if + nb = verify(config%cptr%buffer(ib:ie),BLK//TAB) + if (nb .eq. 0) then + ! remainder of line is blank + value = BLK + config%cptr%eolflag = .true. + config%cptr%next_item = config%cptr%next_line-1 + if (present (eolFlag)) then + eolFlag = .true. + end if + localrc = ESMF_SUCCESS + else + ! shift to first non blank + ib = ib + nb - 1 + ch = config%cptr%buffer(ib:ib) + if ( ch .eq. '"' .or. ch .eq. "'" ) then + ! quotation separated list + ib = ib + 1 + ie = index_(config%cptr%buffer(ib:ie),ch) + if (ie .eq. 0) then + ! missing end quotation + ib = ib - 1 + ie = config%cptr%next_line - 2 + config%cptr%eolflag = .true. + config%cptr%next_item = config%cptr%next_line-1 + else + ie = ib + ie - 2 + config%cptr%next_item = ie + 2 + nb = verify(config%cptr%buffer(config%cptr%next_item:config%cptr%next_line-2),BLK//TAB) + if (nb .eq. 0) config%cptr%eolflag = .true. + end if + else + ! blank separated list + ie = index_(config%cptr%buffer(ib:ie),BLK) + if (ie .eq. 0) then + ! last item + ie = config%cptr%next_line - 2 + config%cptr%eolflag = .true. + config%cptr%next_item = config%cptr%next_line-1 + else + ie = ib + ie - 2 + config%cptr%next_item = ie + 2 + nb = verify(config%cptr%buffer(config%cptr%next_item:config%cptr%next_line-2),BLK//TAB) + if (nb .eq. 0) config%cptr%eolflag = .true. + end if + end if + value = config%cptr%buffer(ib:ie) + ! error if value truncated + if (len (value) >= ie-ib+1) then + localrc = ESMF_SUCCESS + else + localrc = ESMF_RC_ARG_SIZE + end if + end if end if if ( present (rc)) then rc = localrc endif - + end subroutine ESMF_ConfigGetString !------------------------------------------------------------------------------ @@ -1536,7 +1586,7 @@ subroutine ESMF_ConfigGetFloatR4(config, value, & ! integer :: localrc integer :: iostat - character(len=LSZ) :: string + character(len=NBUF_MAX) :: string real(ESMF_KIND_R4) :: x ! Initialize return code; assume routine not implemented @@ -1629,7 +1679,7 @@ subroutine ESMF_ConfigGetFloatR8(config, value, & ! integer :: localrc integer :: iostat - character(len=LSZ) :: string + character(len=NBUF_MAX) :: string real(ESMF_KIND_R8) :: x ! Initialize return code; assume routine not implemented @@ -1926,7 +1976,7 @@ subroutine ESMF_ConfigGetIntI4(config, value, & !EOPI ------------------------------------------------------------------- integer :: localrc - character(len=LSZ) :: string + character(len=NBUF_MAX) :: string real(ESMF_KIND_R8) :: x integer(ESMF_KIND_I4) :: n integer :: iostat @@ -2026,7 +2076,7 @@ subroutine ESMF_ConfigGetIntI8(config, value, & ! integer :: localrc integer :: iostat - character(len=LSZ) :: string + character(len=NBUF_MAX) :: string real(ESMF_KIND_R8) :: x integer(ESMF_KIND_I8) :: n @@ -2331,7 +2381,7 @@ subroutine ESMF_ConfigGetLogical(config, value, & ! \end{description} ! !EOPI ------------------------------------------------------------------- - character(len=LSZ) :: string + character(len=NBUF_MAX) :: string integer :: localrc ! Initialize return code; assume routine not implemented @@ -2543,7 +2593,7 @@ subroutine ESMF_ConfigGetChar(config, value, & ! ! !EOP ------------------------------------------------------------------- - character(len=LSZ) :: string + character(len=NBUF_MAX) :: string integer :: localrc ! Initialize return code; assume routine not implemented @@ -2725,7 +2775,7 @@ integer function ESMF_ConfigGetLen(config, keywordEnforcer, label, rc) ! \end{description} ! !EOP ------------------------------------------------------------------- - character(len=LSZ) :: string + character(len=NBUF_MAX) :: string integer :: localrc integer :: count logical :: eol, found @@ -2954,12 +3004,11 @@ subroutine ESMF_ConfigLoadFile_1proc_( config, filename, rc ) ! !DESCRIPTION: Resource file filename is loaded into memory ! !EOPI ------------------------------------------------------------------- - integer :: i, ls, ptr + integer :: i, j, lsz, lst, led, qst, qed, cst, ptr integer :: lu, nrecs integer :: iostat - character(len=LSZ) :: line integer :: localrc - character(LSZ), allocatable :: line_buffer(:) + character(NBUF_MAX) :: line_buffer ! Initialize return code; assume routine not implemented if (present(rc)) rc = ESMF_RC_NOT_IMPL @@ -2991,33 +3040,69 @@ subroutine ESMF_ConfigLoadFile_1proc_( config, filename, rc ) rewind (lu) - allocate (line_buffer(nrecs)) - do, i = 1, nrecs - read (lu, '(a)') line_buffer(i) - end do - ! Read to end of file ! ------------------- config%cptr%buffer(1:1) = EOL ptr = 2 ! next buffer position do, i = 1, nrecs - ! Read next line ! -------------- - line = line_buffer(i) ! copy next line - call ESMF_Config_trim ( line ) ! remove trailing white space - call ESMF_Config_pad ( line ) ! Pad with # from end of line - -! A non-empty line -! ---------------- - ls = index_(line,'#' ) - 1 ! line length - if ( ls .gt. 0 ) then - if ( (ptr+ls) .gt. NBUF_MAX ) then - if (ESMF_LogFoundError(ESMF_RC_MEM, msg="exceeded NBUF_MAX size", & - ESMF_CONTEXT, rcToReturn=rc)) return - end if - config%cptr%buffer(ptr:ptr+ls) = line(1:ls) // EOL - ptr = ptr + ls + 1 + read (lu, '(a)', iostat=iostat) line_buffer + if (iostat /= 0) then + if (ESMF_LogFoundError(ESMF_RC_FILE_READ, & + msg="error reading file - "//trim(filename), & + ESMF_CONTEXT, rcToReturn=rc)) return + end if + ! find comment start, skip quoted comments + ! lst = line start, led = line end + ! qst = next quote start, qed = last quote end + ! cst = comment start + led = verify(line_buffer,BLK//TAB//DSN,back=.true.) + if (led .gt. 0) then + ! replace TAB's with blanks for convenience + ! backwards compatibility after removing ESMF_Config_pad + do j = 1, led + if (line_buffer(j:j) .eq. TAB) line_buffer(j:j) = BLK + end do + lst = verify(line_buffer(:led),BLK) + qst = scan(line_buffer(:led),QTS//QTD) + cst = index(line_buffer(:led),CMT) + if (cst .eq. 0) cst = led + 1 + qed = 0 + do while ((qst .ne. qed) .and. (qst .lt. cst)) + ! find end of quotation + if (qst .eq. led) then + qed = qst + else + qed = qst + index(line_buffer(qst+1:led),line_buffer(qst:qst)) + end if + if (qed .eq. qst) then + if (ESMF_LogFoundError(ESMF_RC_ARG_BAD, & + msg="missing end quote - "//trim(filename), & + ESMF_CONTEXT, rcToReturn=rc)) return + else + ! find next quotation start + qst = qed + scan(line_buffer(qed+1:led),QTS//QTD) + ! find next comment start + cst = index(line_buffer(qed+1:led),CMT) + if (cst .eq. 0) then + cst = led + 1 + else + cst = qed + cst + end if + end if + end do + led = len_trim(line_buffer(1:cst-1)) + lsz = led - lst + 1 + ! append line to buffer + if ( lsz .gt. 0 ) then + if ( (ptr+lsz) .ge. NBUF_MAX ) then + if (ESMF_LogFoundError(ESMF_RC_MEM, msg="exceeded NBUF_MAX size", & + ESMF_CONTEXT, rcToReturn=rc)) return + end if + config%cptr%buffer(ptr:ptr+lsz) = line_buffer(lst:led) // EOL + ptr = ptr + lsz + 1 + end if end if end do @@ -3035,7 +3120,7 @@ subroutine ESMF_ConfigLoadFile_1proc_( config, filename, rc ) endif config%cptr%buffer(ptr:ptr) = EOB config%cptr%nbuf = ptr - config%cptr%this_line = ' ' + config%cptr%next_item = 1 config%cptr%next_line = 1 config%cptr%value_begin = 1 @@ -3207,13 +3292,15 @@ subroutine ESMF_ConfigNextLine(config, keywordEnforcer, tableEnd, rc) end if i = config%cptr%next_line - j = i + index_(config%cptr%buffer(i:config%cptr%nbuf),EOL) - 2 - config%cptr%this_line = config%cptr%buffer(i:j) // BLK // EOL - - if ( config%cptr%this_line(1:2) .eq. '::' ) then + j = i + index_(config%cptr%buffer(i:config%cptr%nbuf),EOL) + + if ( config%cptr%buffer(i:i+1) .eq. '::' ) then localrc = ESMF_SUCCESS ! end of table. We set rc = ESMF_SUCCESS local_tend = .true. ! and end = .true. Used to be iret = 1 config%cptr%next_line = config%cptr%nbuf + 1 + config%cptr%value_begin = config%cptr%nbuf + 1 + config%cptr%next_item = config%cptr%nbuf + 1 + config%cptr%eolflag = .true. if ( present (tableEnd )) then tableEnd = local_tend endif @@ -3223,7 +3310,10 @@ subroutine ESMF_ConfigNextLine(config, keywordEnforcer, tableEnd, rc) return end if - config%cptr%next_line = j + 2 + config%cptr%value_begin = i + config%cptr%next_item = i + config%cptr%next_line = j + config%cptr%eolflag = .false. localrc = ESMF_SUCCESS if ( present (tableEnd )) then tableEnd = local_tend @@ -3260,7 +3350,7 @@ subroutine ESMF_ConfigParseAttributes( config, unique, rc ) ! !EOPI ------------------------------------------------------------------- integer :: i, j, k, a, b, localrc - character(len=LSZ) :: this_line, label + character(len=LSZ) :: this_label, label character(len=ESMF_MAXSTR) :: logmsg logical :: duplicate @@ -3283,15 +3373,20 @@ subroutine ESMF_ConfigParseAttributes( config, unique, rc ) do while ( i .lt. config%cptr%nbuf ) ! get next line from buffer - j = i + index_(config%cptr%buffer(i:config%cptr%nbuf), EOL) - 1 - this_line = config%cptr%buffer(i:j) + j = index_(config%cptr%buffer(i:config%cptr%nbuf), EOL) + if (j .eq. 0) then + j = config%cptr%nbuf - 1 + else + j = i + j - 1 + endif + this_label = config%cptr%buffer(i:j) - ! look for label in this_line; non-blank characters followed by a colon - if (this_line(1:2) .ne. '::' ) then ! skip end-of-table mark - k = index_(this_line, ':') - 1 ! label sans colon + ! look for label in this_label; non-blank characters followed by a colon + if (this_label(1:2) .ne. '::' ) then ! skip end-of-table mark + k = index_(this_label, ':') - 1 ! label sans colon if (k .ge. 1) then ! non-blank match ! found a label, trim it, - label = trim(adjustl(this_line(1:k))) + label = trim(adjustl(this_label(1:k))) ! ... check it for uniqueness if requested, duplicate = .false. @@ -3491,7 +3586,7 @@ subroutine ESMF_ConfigSetIntI4(config, value, & ! integer :: localrc character(len=ESMF_MAXSTR) :: logmsg - character(len=LSZ) :: curVal, newVal + character(len=ESMF_MAXSTR) :: newVal integer :: i, j, k, m, nchar, ninsert, ndelete, lenThisLine ! Initialize return code; assume routine not implemented @@ -3501,116 +3596,9 @@ subroutine ESMF_ConfigSetIntI4(config, value, & !check variables ESMF_INIT_CHECK_DEEP(ESMF_ConfigGetInit,config,rc) - ! Set config buffer at desired attribute - if ( present (label) ) then - call ESMF_ConfigGetString( config, curVal, label=label, rc=localrc) - else - call ESMF_ConfigGetString( config, curVal, rc = localrc ) - endif - - if ( localrc /= ESMF_SUCCESS ) then - if ( localrc == ESMF_RC_NOT_FOUND ) then - ! set config buffer at end for appending - i = config%cptr%nbuf - else - if ( present( rc ) ) then - rc = localrc - endif - return - endif - else ! attribute found - ! set config buffer for overwriting/inserting - i = config%cptr%value_begin - curVal = BLK // trim(curVal) // BLK // EOL ! like config%cptr%this_line - endif - - ! for appending, create new attribute string with label and value - if ( i .eq. config%cptr%nbuf .and. present(label) ) then - write(newVal, *) label, BLK, value - newVal = trim(adjustl(newVal)) // EOL - j = i + len_trim(newVal) - - ! check to ensure len of newVal doesn't exceed LSZ - if ( (j-i) .gt. LSZ) then - write(logmsg, *) ", attribute label, value & EOL are ", j-i, & - " characters long, only ", LSZ, " characters allowed per line" - if (ESMF_LogFoundError(ESMC_RC_LONG_STR, msg=logmsg, & - ESMF_CONTEXT, rcToReturn=rc)) return - endif - - ! check if enough space left in config buffer - if (j .ge. NBUF_MAX) then ! room for EOB if necessary - write(logmsg, *) ", attribute label & value require ", j-i+1, & - " characters (including EOL & EOB), only ", NBUF_MAX-i, & - " characters left in config buffer" - if (ESMF_LogFoundError(ESMC_RC_LONG_STR, msg=logmsg, & - ESMF_CONTEXT, rcToReturn=rc)) return - endif - endif - - ! overwrite, with possible insertion or deletion of extra characters - if (i .eq. config%cptr%value_begin) then - write(newVal, *) value - newVal = BLK // trim(adjustl(newVal)) // EOL - j = i + len_trim(newVal) - 1 - - ! check if we need more space to insert new characters; - ! shift buffer down (linked-list redesign would be better!) - nchar = j-i+1 - lenThisLine = len_trim(curVal) - 1 - if ( nchar .gt. lenThisLine) then - - ! check to ensure length of extended line doesn't exceed LSZ - do m = i, 1, -1 - if (config%cptr%buffer(m:m) .eq. EOL) then - exit - endif - enddo - if (j-m+1 .gt. LSZ) then - write(logmsg, *) ", attribute label, value & EOL are ", j-m+1, & - " characters long, only ", LSZ, " characters allowed per line" - if (ESMF_LogFoundError(ESMC_RC_LONG_STR, msg=logmsg, & - ESMF_CONTEXT, rcToReturn=rc)) return - endif - - ! check if enough space left in config buffer to extend line - if (j+1 .ge. NBUF_MAX) then ! room for EOB if necessary - write(logmsg, *) ", attribute label & value require ", j-m+1, & - " characters (including EOL & EOB), only ", NBUF_MAX-i, & - " characters left in config buffer" - if (ESMF_LogFoundError(ESMC_RC_LONG_STR, msg=logmsg, & - ESMF_CONTEXT, rcToReturn=rc)) return - endif - - ninsert = nchar - lenThisLine - do k = config%cptr%nbuf, j, -1 - config%cptr%buffer(k+ninsert:k+ninsert) = config%cptr%buffer(k:k) - enddo - config%cptr%nbuf = config%cptr%nbuf + ninsert - - ! or if we need less space and remove characters; - ! shift buffer up - elseif ( nchar .lt. lenThisLine ) then - ndelete = lenThisLine - nchar - do k = j+1, config%cptr%nbuf - config%cptr%buffer(k-ndelete:k-ndelete) = config%cptr%buffer(k:k) - enddo - config%cptr%nbuf = config%cptr%nbuf - ndelete - endif - endif - - ! write new attribute value into config - config%cptr%buffer(i:j) = newVal(1:len_trim(newVal)) - - ! if appended, reset EOB marker and nbuf - if (i .eq. config%cptr%nbuf) then - config%cptr%buffer(j:j) = EOB - config%cptr%nbuf = j - endif + write(newVal, *) value - if( present( rc )) then - rc = ESMF_SUCCESS - endif + call ESMF_ConfigSetAttribute(config, value=newVal, label=label, rc=rc) return end subroutine ESMF_ConfigSetIntI4 @@ -3620,7 +3608,7 @@ end subroutine ESMF_ConfigSetIntI4 #define ESMF_METHOD "ESMF_ConfigSetString" !BOPI ! -! !IROUTINE: ESMF_ConfigSetAttribute - Set a 4-byte integer number +! !IROUTINE: ESMF_ConfigSetAttribute - Set a string ! ! !INTERFACE: @@ -3655,7 +3643,7 @@ subroutine ESMF_ConfigSetString(config, value, & ! integer :: localrc character(len=ESMF_MAXSTR) :: logmsg - character(len=LSZ) :: curVal, newVal + character(len=NBUF_MAX) :: curVal, newVal integer :: i, j, k, m, nchar, ninsert, ndelete, lenThisLine ! Initialize return code; assume routine not implemented @@ -3685,22 +3673,18 @@ subroutine ESMF_ConfigSetString(config, value, & else ! attribute found ! set config buffer for overwriting/inserting i = config%cptr%value_begin - curVal = BLK // trim(curVal) // BLK // EOL ! like config%cptr%this_line endif ! for appending, create new attribute string with label and value - if ( i .eq. config%cptr%nbuf .and. present(label) ) then - write(newVal, *) label, BLK, value - newVal = trim(adjustl(newVal)) // EOL - j = i + len_trim(newVal) - - ! check to ensure len of newVal doesn't exceed LSZ - if ( (j-i) .gt. LSZ) then - write(logmsg, *) ", attribute label, value & EOL are ", j-i, & - " characters long, only ", LSZ, " characters allowed per line" - if (ESMF_LogFoundError(ESMC_RC_LONG_STR, msg=logmsg, & - ESMF_CONTEXT, rcToReturn=rc)) return + if ( i .eq. config%cptr%nbuf ) then + if ( present(label) ) then + write(newVal, *) trim(label), BLK, value + else + write(newVal, *) "__MISSING__:", BLK, value endif + newVal = trim(adjustl(newVal)) // EOL + nchar = len_trim(newVal) + j = i + nchar ! check if enough space left in config buffer if (j .ge. NBUF_MAX) then ! room for EOB if necessary @@ -3716,29 +3700,24 @@ subroutine ESMF_ConfigSetString(config, value, & if (i .eq. config%cptr%value_begin) then write(newVal, *) value newVal = BLK // trim(adjustl(newVal)) // EOL - j = i + len_trim(newVal) - 1 + + nchar = len_trim(newVal) + + j = i + nchar - 1 ! check if we need more space to insert new characters; ! shift buffer down (linked-list redesign would be better!) - nchar = j-i+1 - lenThisLine = len_trim(curVal) - 1 - if ( nchar .gt. lenThisLine) then + lenThisLine = index(config%cptr%buffer(i:config%cptr%next_line),EOL) + if (lenThisLine .eq. 0) lenThisLine = config%cptr%nbuf - i - ! check to ensure length of extended line doesn't exceed LSZ - do m = i, 1, -1 - if (config%cptr%buffer(m:m) .eq. EOL) then - exit - endif - enddo - if (j-m+1 .gt. LSZ) then - write(logmsg, *) ", attribute label, value & EOL are ", j-m+1, & - " characters long, only ", LSZ, " characters allowed per line" - if (ESMF_LogFoundError(ESMC_RC_LONG_STR, msg=logmsg, & - ESMF_CONTEXT, rcToReturn=rc)) return - endif + if ( nchar .gt. lenThisLine) then + ninsert = nchar - lenThisLine ! check if enough space left in config buffer to extend line - if (j+1 .ge. NBUF_MAX) then ! room for EOB if necessary + ! leave room for EOB with .ge. + if (config%cptr%nbuf+ninsert .ge. NBUF_MAX) then + m = index(config%cptr%buffer(1:i), EOL, back=.true.) + if (m .lt. 1) m = 1 write(logmsg, *) ", attribute label & value require ", j-m+1, & " characters (including EOL & EOB), only ", NBUF_MAX-i, & " characters left in config buffer" @@ -3746,29 +3725,28 @@ subroutine ESMF_ConfigSetString(config, value, & ESMF_CONTEXT, rcToReturn=rc)) return endif - ninsert = nchar - lenThisLine - do k = config%cptr%nbuf, j, -1 - config%cptr%buffer(k+ninsert:k+ninsert) = config%cptr%buffer(k:k) - enddo config%cptr%nbuf = config%cptr%nbuf + ninsert + config%cptr%buffer(i+lenThisLine+ninsert:config%cptr%nbuf+ninsert) = & + config%cptr%buffer(i+lenThisLine:config%cptr%nbuf) ! or if we need less space and remove characters; ! shift buffer up elseif ( nchar .lt. lenThisLine ) then - ndelete = lenThisLine - nchar - do k = j+1, config%cptr%nbuf - config%cptr%buffer(k-ndelete:k-ndelete) = config%cptr%buffer(k:k) - enddo + ndelete = lenThisLine - nchar + config%cptr%buffer(i+lenThisLine-ndelete:config%cptr%nbuf-ndelete) = & + config%cptr%buffer(i+lenThisLine:config%cptr%nbuf) config%cptr%nbuf = config%cptr%nbuf - ndelete endif endif ! write new attribute value into config - config%cptr%buffer(i:j) = newVal(1:len_trim(newVal)) + config%cptr%buffer(i:j) = newVal(1:nchar) + config%cptr%next_line = j + 1 + config%cptr%next_item = config%cptr%value_begin ! if appended, reset EOB marker and nbuf if (i .eq. config%cptr%nbuf) then - config%cptr%buffer(j:j) = EOB + config%cptr%buffer(j+1:j+1) = EOB config%cptr%nbuf = j endif @@ -4077,58 +4055,6 @@ subroutine ESMF_Config_Trim ( string ) end subroutine ESMF_Config_trim - subroutine ESMF_Config_pad ( string ) - -!-------------------------------------------------------------------------! -! !ROUTINE: ESMF_CONFIG_Pad() --- Pad strings. -! -! !DESCRIPTION: -! -! Pads from the right with the comment character (\#). It also -! replaces TAB's with blanks for convenience. This is a low level -! i90 routine. -! -! !CALLING SEQUENCE: -! -! call ESMF_Config_pad ( string ) -! -! !INPUT PARAMETERS: -! - character(*), intent(inout) :: string ! input string - -! !OUTPUT PARAMETERS: ! modified string -! -! character(*), intent(inout) :: string -! -! !BUGS: -! -! It alters TAB's even inside strings. -! -! -! !REVISION HISTORY: -! -! 19Jun96 da Silva Original code. -!------------------------------------------------------------------------- - - integer :: i - -! Pad end of string with # -! ------------------------ - do i = len (string), 1, -1 - if ( string(i:i) .ne. ' ' .and. & - string(i:i) .ne. '$' ) exit - string(i:i) = '#' - end do - -! Replace TAB's with blanks -! ------------------------- - do i = 1, len (string) - if ( string(i:i) .eq. TAB ) string(i:i) = BLK - if ( string(i:i) .eq. '#' ) exit - end do - - end subroutine ESMF_Config_pad - !----------------------------------------------------------------------- ! !IROUTINE: opntext - portably open a text file ! diff --git a/src/Infrastructure/Field/tests/ESMF_FieldRegridCsrvUTest.F90 b/src/Infrastructure/Field/tests/ESMF_FieldRegridCsrvUTest.F90 index 401df49f98..f74e8c2583 100644 --- a/src/Infrastructure/Field/tests/ESMF_FieldRegridCsrvUTest.F90 +++ b/src/Infrastructure/Field/tests/ESMF_FieldRegridCsrvUTest.F90 @@ -7416,7 +7416,7 @@ subroutine test_RegridCsrvCartPHMesh(itrp, csrv, rc) elemIds=(/5/) ! Allocate and fill the element topology type array. - allocate(elemTypes(numElemConn)) + allocate(elemTypes(numTotElems)) elemTypes=(/5/) ! elem id 5 ! Allocate and fill the element connection type array. @@ -8146,7 +8146,7 @@ subroutine test_RegridCsrvCartMesh(itrp, csrv, rc) elemMask=(/0/) ! Allocate and fill the element topology type array. - allocate(elemTypes(numElemConn)) + allocate(elemTypes(numTotElems)) elemTypes=(/ESMF_MESHELEMTYPE_QUAD/) ! elem id 4 ! Allocate and fill the element connection type array. @@ -8504,7 +8504,7 @@ subroutine test_RegridCsrvCartMesh(itrp, csrv, rc) elemIds=(/5/) ! Allocate and fill the element topology type array. - allocate(elemTypes(numElemConn)) + allocate(elemTypes(numTotElems)) elemTypes=(/ESMF_MESHELEMTYPE_QUAD/) ! elem id 4 ! Allocate and fill the element connection type array. @@ -10406,7 +10406,7 @@ subroutine test_RegridCsrvCartPHFracNorm(itrp, csrv, rc) elemIds=(/5/) ! Allocate and fill the element topology type array. - allocate(elemTypes(numElemConn)) + allocate(elemTypes(numTotElems)) elemTypes=(/5/) ! elem id 5 ! Allocate and fill the element connection type array. diff --git a/src/Infrastructure/Mesh/include/ESMCI_Mesh.h b/src/Infrastructure/Mesh/include/ESMCI_Mesh.h index 7f783eb1a2..fe24b9ca8a 100644 --- a/src/Infrastructure/Mesh/include/ESMCI_Mesh.h +++ b/src/Infrastructure/Mesh/include/ESMCI_Mesh.h @@ -102,11 +102,16 @@ void RemoveGhost(); bool HasGhost() const { return sghost != NULL; } - CommReg &GhostComm() { ThrowRequire(sghost); return *sghost; } +CommReg &GhostComm() { ThrowRequire(sghost); return *sghost; } - // Convenience function to communicate all fields to ghost locations - void GhostCommAllFields(); +// Convenience function to communicate fields to ghost locations +void GhostCommFields(UInt nfields, MEField<> *const *sfields, MEField<> *const *rfields); + + +// Convenience function to communicate all fields to ghost locations +void GhostCommAllFields(); + // Create the sym rel void build_sym_comm_rel(UInt obj_type); diff --git a/src/Infrastructure/Mesh/src/ESMCI_Mesh.C b/src/Infrastructure/Mesh/src/ESMCI_Mesh.C index c7c53ea6c3..9ca20f813a 100644 --- a/src/Infrastructure/Mesh/src/ESMCI_Mesh.C +++ b/src/Infrastructure/Mesh/src/ESMCI_Mesh.C @@ -1689,6 +1689,32 @@ void Mesh::RemoveGhost() { ESMCI::Par::Init("MESHLOG", false, curr_comm); } + +// Function to communicate fields to ghost locations + void Mesh::GhostCommFields(UInt nfields, MEField<> *const *sfields, MEField<> *const *rfields) { + + // Only do on the original comm that this mesh was committed on, so + // leave if that's not set + if (orig_comm == MPI_COMM_NULL) return; + + // Error check + if (!sghost) Throw()<<"Ghost communicator must be present for ghost communication."; + + // Save current comm + MPI_Comm curr_comm=Par::Comm(); + + // Switch to orig comm + ESMCI::Par::Init("MESHLOG", false, orig_comm); + + // Send Fields + sghost->SendFields(nfields, sfields, rfields); + + // Switch back to curr comm + ESMCI::Par::Init("MESHLOG", false, curr_comm); + } + + + // Convenience function to communicate all fields to ghost locations void Mesh::GhostCommAllFields() { @@ -1725,6 +1751,8 @@ void Mesh::RemoveGhost() { // Switch back to curr comm ESMCI::Par::Init("MESHLOG", false, curr_comm); } + + void Mesh::build_sym_comm_rel(UInt obj_type) { diff --git a/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C b/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C index d0de2e6a7d..234d918034 100644 --- a/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C +++ b/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C @@ -192,12 +192,6 @@ namespace ESMCI { // Communicate values to ghost cells src_mesh->GhostCommAllFields(); - // BOB: Use convenince method to comm all fields -#if 0 - src_mesh->GhostComm().SendFields(num_snd, snd, rcv); -#endif - - #ifdef DEBUG_WRITE_MESH {int *rc; int len = 18; char fname[len]; diff --git a/src/Infrastructure/Mesh/src/Regridding/ESMCI_MeshRegrid.C b/src/Infrastructure/Mesh/src/Regridding/ESMCI_MeshRegrid.C index e95cad2505..f0ff264eea 100644 --- a/src/Infrastructure/Mesh/src/Regridding/ESMCI_MeshRegrid.C +++ b/src/Infrastructure/Mesh/src/Regridding/ESMCI_MeshRegrid.C @@ -111,7 +111,7 @@ namespace ESMCI { } srcmesh->CreateGhost(); - srcmesh->GhostComm().SendFields(num_snd, snd, rcv); + srcmesh->GhostCommFields(num_snd, snd, rcv); } // Create a layer of ghost elements since the higher order conservative needs a @@ -154,7 +154,7 @@ namespace ESMCI { } srcmesh->CreateGhost(); - srcmesh->GhostComm().SendFields(num_snd, snd, rcv); + srcmesh->GhostCommFields(num_snd, snd, rcv); #if 0 // DEBUG diff --git a/src/Superstructure/Component/src/ESMCI_FTable.C b/src/Superstructure/Component/src/ESMCI_FTable.C index 6840843f3f..7dc9ce77d5 100644 --- a/src/Superstructure/Component/src/ESMCI_FTable.C +++ b/src/Superstructure/Component/src/ESMCI_FTable.C @@ -30,6 +30,7 @@ #include #include #include +#include #ifndef ESMF_NO_DLFCN #include #endif @@ -43,6 +44,7 @@ #include "ESMCI_Info.h" using std::string; +using std::vector; //----------------------------------------------------------------------------- // leave the following line as-is; it will insert the cvs ident string @@ -246,7 +248,16 @@ extern "C" { if (llen>0){ string sharedObj(sharedObjArg, llen); sharedObj.resize(sharedObj.find_last_not_of(" ")+1); - lib = dlopen(sharedObj.c_str(), RTLD_LAZY); + if (sharedObj.back()=='*'){ + vector suffixes{"so", "dylib", "dll"}; + for (auto it=suffixes.begin(); it!=suffixes.end(); ++it){ + string sharedObjTemp = sharedObj; + sharedObjTemp.replace(sharedObjTemp.end()-1,sharedObjTemp.end(), *it); + lib = dlopen(sharedObjTemp.c_str(), RTLD_LAZY); + if (lib) break; + } + }else + lib = dlopen(sharedObj.c_str(), RTLD_LAZY); }else lib = dlopen(NULL, RTLD_LAZY); // search in executable if (lib == NULL){ @@ -298,7 +309,16 @@ extern "C" { if (llen>0){ string sharedObj(sharedObjArg, llen); sharedObj.resize(sharedObj.find_last_not_of(" ")+1); - lib = dlopen(sharedObj.c_str(), RTLD_LAZY); + if (sharedObj.back()=='*'){ + vector suffixes{"so", "dylib", "dll"}; + for (auto it=suffixes.begin(); it!=suffixes.end(); ++it){ + string sharedObjTemp = sharedObj; + sharedObjTemp.replace(sharedObjTemp.end()-1,sharedObjTemp.end(), *it); + lib = dlopen(sharedObjTemp.c_str(), RTLD_LAZY); + if (lib) break; + } + }else + lib = dlopen(sharedObj.c_str(), RTLD_LAZY); }else lib = dlopen(NULL, RTLD_LAZY); // search in executable if (lib == NULL){ diff --git a/src/Superstructure/Component/src/ESMF_CplComp.F90 b/src/Superstructure/Component/src/ESMF_CplComp.F90 index 14f1b86227..bf76e7bf8d 100644 --- a/src/Superstructure/Component/src/ESMF_CplComp.F90 +++ b/src/Superstructure/Component/src/ESMF_CplComp.F90 @@ -2251,8 +2251,12 @@ recursive subroutine ESMF_CplCompSetServicesShObj(cplcomp, userRoutine, & ! standard Component Initialize(), Run(), and Finalize() methods. ! \end{sloppypar} ! \item[{[sharedObj]}] -! Name of shared object that contains {\tt userRoutine}. If the -! {\tt sharedObj} argument is not provided the executable itself will be +! Name of shared object that contains {\tt userRoutine}. The asterisk +! character {\tt (*)} is supported as a wildcard for the file name suffix. +! When present, the asterisk is replaced by "so", "dylib", and "dll", in this +! order, and the first successfully loaded object is used to search for +! {\tt userRoutine}. +! If the {\tt sharedObj} argument is not provided, the executable itself is ! searched for {\tt userRoutine}. ! \item[{[userRoutineFound]}] ! Report back whether the specified {\tt userRoutine} was found and executed, @@ -2631,8 +2635,12 @@ recursive subroutine ESMF_CplCompSetVMShObj(cplcomp, userRoutine, & ! {\tt ESMF\_CplCompSetVMxxx()} methods to set the properties of the VM ! associated with the Coupler Component. ! \item[{[sharedObj]}] -! Name of shared object that contains {\tt userRoutine}. If the -! {\tt sharedObj} argument is not provided the executable itself will be +! Name of shared object that contains {\tt userRoutine}. The asterisk +! character {\tt (*)} is supported as a wildcard for the file name suffix. +! When present, the asterisk is replaced by "so", "dylib", and "dll", in this +! order, and the first successfully loaded object is used to search for +! {\tt userRoutine}. +! If the {\tt sharedObj} argument is not provided, the executable itself is ! searched for {\tt userRoutine}. ! \item[{[userRoutineFound]}] ! Report back whether the specified {\tt userRoutine} was found and executed, diff --git a/src/Superstructure/Component/src/ESMF_GridComp.F90 b/src/Superstructure/Component/src/ESMF_GridComp.F90 index b9c377824b..da71f1d5f2 100644 --- a/src/Superstructure/Component/src/ESMF_GridComp.F90 +++ b/src/Superstructure/Component/src/ESMF_GridComp.F90 @@ -2608,8 +2608,12 @@ recursive subroutine ESMF_GridCompSetServicesShObj(gridcomp, userRoutine, & ! standard Component Initialize(), Run(), and Finalize() methods. ! \end{sloppypar} ! \item[{[sharedObj]}] -! Name of shared object that contains {\tt userRoutine}. If the -! {\tt sharedObj} argument is not provided the executable itself will be +! Name of shared object that contains {\tt userRoutine}. The asterisk +! character {\tt (*)} is supported as a wildcard for the file name suffix. +! When present, the asterisk is replaced by "so", "dylib", and "dll", in this +! order, and the first successfully loaded object is used to search for +! {\tt userRoutine}. +! If the {\tt sharedObj} argument is not provided, the executable itself is ! searched for {\tt userRoutine}. ! \item[{[userRoutineFound]}] ! Report back whether the specified {\tt userRoutine} was found and executed, @@ -2989,8 +2993,12 @@ recursive subroutine ESMF_GridCompSetVMShObj(gridcomp, userRoutine, & ! {\tt ESMF\_GridCompSetVMxxx()} methods to set the properties of the VM ! associated with the Gridded Component. ! \item[{[sharedObj]}] -! Name of shared object that contains {\tt userRoutine}. If the -! {\tt sharedObj} argument is not provided the executable itself will be +! Name of shared object that contains {\tt userRoutine}. The asterisk +! character {\tt (*)} is supported as a wildcard for the file name suffix. +! When present, the asterisk is replaced by "so", "dylib", and "dll", in this +! order, and the first successfully loaded object is used to search for +! {\tt userRoutine}. +! If the {\tt sharedObj} argument is not provided, the executable itself is ! searched for {\tt userRoutine}. ! \item[{[userRoutineFound]}] ! Report back whether the specified {\tt userRoutine} was found and executed, diff --git a/src/Superstructure/ESMFMod/include/ESMC_Init.h b/src/Superstructure/ESMFMod/include/ESMC_Init.h index 775aed3913..24dbe298ff 100644 --- a/src/Superstructure/ESMFMod/include/ESMC_Init.h +++ b/src/Superstructure/ESMFMod/include/ESMC_Init.h @@ -146,12 +146,12 @@ extern "C" { // internal resources cleanly. // // The \texttt{endFlag} argument has one of three options: -// \being{description} -// \item [\texttt{ESMC_END_NORMAL}] +// \begin{description} +// \item [\texttt{ESMC\_END\_NORMAL}] // Finalize normally. -// \item [\texttt{ESMC_END_KEEPMPI}] +// \item [\texttt{ESMC\_END\_KEEPMPI}] // Finalize normally without finalizing MPI. -// \item [\texttt{ESMC_END_ABORT}] +// \item [\texttt{ESMC\_END\_ABORT}] // Abort on finalization. // \end{description} //EOP diff --git a/src/addon/ESMX/Driver/CMakeLists.txt b/src/addon/ESMX/Driver/CMakeLists.txt index 6da0a279be..034e300385 100644 --- a/src/addon/ESMX/Driver/CMakeLists.txt +++ b/src/addon/ESMX/Driver/CMakeLists.txt @@ -165,6 +165,7 @@ set(CMP_OPTIONS BUILD_TYPE; LIBRARIES; LINK_LIBRARIES; LINK_PATHS; + LINK_INTO_APP; BUILD_ARGS; BUILD_SCRIPT; TEST_DIR; @@ -391,64 +392,68 @@ foreach(CMP IN ITEMS ${COMPS}) endif() # include modules and link libraries - find_file(FND_CMAKE_CONFIG - NAMES ${CMP_CMAKE_CONFIG} - HINTS ${CMP_INSTALL_PREFIX} ${CMAKE_BINARY_DIR}/${CMP} - PATH_SUFFIXES ${CMP_CONFIG_DIR} "." "cmake" "config" - NO_CACHE NO_DEFAULT_PATH - ) - if(FND_CMAKE_CONFIG) - include(${FND_CMAKE_CONFIG}) - endif() - find_path(FND_FORT_MODULE - NAMES ${CMP_FORT_MODULE} - HINTS ${CMP_INSTALL_PREFIX} ${CMAKE_BINARY_DIR}/${CMP} - PATH_SUFFIXES ${CMP_INCLUDE_DIR} "." "include" "mod" - NO_CACHE NO_DEFAULT_PATH - ) - if(FND_FORT_MODULE) - target_include_directories(esmx_driver PUBLIC ${FND_FORT_MODULE}) - elseif(NOT FND_CMAKE_CONFIG) - message(FATAL_ERROR "Cannot find fort_module ${CMP_FORT_MODULE} in ${CMP_INSTALL_PREFIX}") - endif() - unset(FND_FORT_MODULE) - unset(FND_CMAKE_CONFIG) - foreach(CMP_LIBRARY IN ITEMS ${CMP_LIBRARIES}) - if(TARGET ${CMP_LIBRARY}) - target_link_libraries(esmx_driver PUBLIC ${CMP_LIBRARY}) - else() - find_library(FND_LIBRARY - NAMES ${CMP_LIBRARY} - HINTS ${CMP_INSTALL_PREFIX} ${CMAKE_BINARY_DIR}/${CMP} - PATH_SUFFIXES ${CMP_LIBRARY_DIR} "." "lib" "lib64" - NO_CACHE NO_DEFAULT_PATH - ) - if(NOT FND_LIBRARY) - message(FATAL_ERROR "Cannot find libraries ${CMP_LIBRARY} in ${CMP_INSTALL_PREFIX}") - endif() - target_link_libraries(esmx_driver PUBLIC ${FND_LIBRARY}) - unset(FND_LIBRARY) + if(${CMP_LINK_INTO_APP} STREQUAL "True") + find_file(FND_CMAKE_CONFIG + NAMES ${CMP_CMAKE_CONFIG} + HINTS ${CMP_INSTALL_PREFIX} ${CMAKE_BINARY_DIR}/${CMP} + PATH_SUFFIXES ${CMP_CONFIG_DIR} "." "cmake" "config" + NO_CACHE NO_DEFAULT_PATH + ) + if(FND_CMAKE_CONFIG) + include(${FND_CMAKE_CONFIG}) endif() - endforeach() + find_path(FND_FORT_MODULE + NAMES ${CMP_FORT_MODULE} + HINTS ${CMP_INSTALL_PREFIX} ${CMAKE_BINARY_DIR}/${CMP} + PATH_SUFFIXES ${CMP_INCLUDE_DIR} "." "include" "mod" + NO_CACHE NO_DEFAULT_PATH + ) + if(FND_FORT_MODULE) + target_include_directories(esmx_driver PUBLIC ${FND_FORT_MODULE}) + elseif(NOT FND_CMAKE_CONFIG) + message(FATAL_ERROR "Cannot find fort_module ${CMP_FORT_MODULE} in ${CMP_INSTALL_PREFIX}") + endif() + unset(FND_FORT_MODULE) + unset(FND_CMAKE_CONFIG) + foreach(CMP_LIBRARY IN ITEMS ${CMP_LIBRARIES}) + if(TARGET ${CMP_LIBRARY}) + target_link_libraries(esmx_driver PUBLIC ${CMP_LIBRARY}) + else() + find_library(FND_LIBRARY + NAMES ${CMP_LIBRARY} + HINTS ${CMP_INSTALL_PREFIX} ${CMAKE_BINARY_DIR}/${CMP} + PATH_SUFFIXES ${CMP_LIBRARY_DIR} "." "lib" "lib64" + NO_CACHE NO_DEFAULT_PATH + ) + if(NOT FND_LIBRARY) + message(FATAL_ERROR "Cannot find libraries ${CMP_LIBRARY} in ${CMP_INSTALL_PREFIX}") + endif() + target_link_libraries(esmx_driver PUBLIC ${FND_LIBRARY}) + unset(FND_LIBRARY) + endif() + endforeach() + endif() # link external libraries - foreach(CMP_LINK_LIBRARY IN ITEMS ${CMP_LINK_LIBRARIES}) - if(TARGET ${CMP_LINK_LIBRARY}) - target_link_libraries(esmx_driver PUBLIC ${CMP_LINK_LIBRARY}) - else() - find_library(FND_LINK_LIBRARY - NAMES ${CMP_LINK_LIBRARY} - HINTS ${CMP_LINK_PATHS} - PATH_SUFFIXES "." "lib" "lib64" - NO_CACHE - ) - if(NOT FND_LINK_LIBRARY) - message(FATAL_ERROR "Cannot find link_libraries ${CMP_LINK_LIBRARY} in ${CMP_LINK_PATHS}") + if(${CMP_LINK_INTO_APP} STREQUAL "True") + foreach(CMP_LINK_LIBRARY IN ITEMS ${CMP_LINK_LIBRARIES}) + if(TARGET ${CMP_LINK_LIBRARY}) + target_link_libraries(esmx_driver PUBLIC ${CMP_LINK_LIBRARY}) + else() + find_library(FND_LINK_LIBRARY + NAMES ${CMP_LINK_LIBRARY} + HINTS ${CMP_LINK_PATHS} + PATH_SUFFIXES "." "lib" "lib64" + NO_CACHE + ) + if(NOT FND_LINK_LIBRARY) + message(FATAL_ERROR "Cannot find link_libraries ${CMP_LINK_LIBRARY} in ${CMP_LINK_PATHS}") + endif() + target_link_libraries(esmx_driver PUBLIC ${FND_LINK_LIBRARY}) + unset(FND_LINK_LIBRARY) endif() - target_link_libraries(esmx_driver PUBLIC ${FND_LINK_LIBRARY}) - unset(FND_LINK_LIBRARY) - endif() - endforeach() + endforeach() + endif() # add component test if(ESMX_TEST) diff --git a/src/addon/ESMX/Driver/esmx_comp_config.py b/src/addon/ESMX/Driver/esmx_comp_config.py index dd1e2ff9c4..2f22313f61 100755 --- a/src/addon/ESMX/Driver/esmx_comp_config.py +++ b/src/addon/ESMX/Driver/esmx_comp_config.py @@ -24,6 +24,7 @@ def create_compList(cmpCfg: ESMXCmpCfg, odir): ESMXOpt('build_args', '', str), ESMXOpt('link_libraries', '', str), ESMXOpt('link_paths', '', dir), + ESMXOpt('link_into_app', 'True', str), ESMXOpt('git_repository', '', str), ESMXOpt('git_tag', '', str), ESMXOpt('git_dir', '', dir), @@ -44,6 +45,9 @@ def create_compList(cmpCfg: ESMXCmpCfg, odir): dirs[i] = os.path.abspath(dirs[i]) val = ';'.join(dirs) f.write('set({}-{} {})\n'.format(cmp, opt.upper(), val)) + if opt.option == "link_into_app": + if not val: + cmpCfg.remove_ci(cmp) def create_compUse(comps: ESMXCmpCfg, odir): # open file @@ -107,7 +111,7 @@ def main(argv): for dis in disable_comps: comps.remove_ci(dis) - # create compList.txt for CMake + # create compList.txt for CMake, and remove unlinked components from list create_compList(comps, odir) # create compUse.inc diff --git a/src/addon/ESMX/README.md b/src/addon/ESMX/README.md index 2cae54482b..43ae3dd640 100644 --- a/src/addon/ESMX/README.md +++ b/src/addon/ESMX/README.md @@ -9,6 +9,7 @@ The ESMX layer is built on top of the ESMF and NUOPC APIs. The idea behind ESMX is to make it as simple as possible for a user to build, run, and test NUOPC based systems. The approach implemented is the same whether applied to a single component, or a fully coupled system of NUOPC-compliant components. ESMX user interfaces are implemented through [YAML](https://yaml.org/) based configuration files. Major objectives of ESMX are: + - **Simplification** of standing up new NUOPC-based systems. - **Promotion** of hierarchical model component testing. - **Reduction** of maintenance cost for established NUOPC-based systems. @@ -160,6 +161,7 @@ This section contains a key for for each *component-name*, specifying component | `library_dir` | subdirectory for library file | `lib` | | `include_dir` | subdirectory for fortran module file | `include` | | `link_paths` | search path for external libraries | *None* | +| `link_into_app` | whether to link component into the app | `True` | | `link_libraries` | external libraries, linked to esmx | *None* | | `git_repository` | URL for downloading git repository | *None* | | `git_tag` | tag for downloading git repository | *None* | @@ -299,8 +301,9 @@ This section affects the specific component instance. ### Dynamically loading components from shared objects at run-time There are two options recognized when specifying the value of the `model` field for a component in the `esmxRun.yaml` file: -- First, if the value specified is recognized as a *component-name* provided by any of the components built into `esmx` during build-time, as specified by `esmxBuild.yaml`, the respective component is accessed via its Fortran module. -- Second, if the value does not match a build-time dependency, it is assumed to correspond to a shared object instead. In that case the attempt is made to load the specified shared object at run-time, and to associate with the generic component label. + +- First, if the value specified is recognized as a *component-name* provided by any of the components built into the `esmx_app` during build-time, as specified by `esmxBuild.yaml`, the respective component is accessed via its Fortran module. +- Second, if the value does *not* match a build-time dependency, it is assumed to correspond to a shared object file instead. In that case the attempt is made to load the specified shared object file at run-time, and, if successful, is associated with the generic component label. The search order details of the OS dependent dynamic linker apply when looking for the specified shared object file on the system. A convenient way to target a shared object file at a specific location is to use absolute or relative paths, i.e. the value specified in the `model` field contains at least one slash ("/") character. The asterisk character ("*") is supported as a wildcard for the file name suffix of the specified shared object. This allows portability across systems that differ in shared object suffix. The implemented search order is "so", followed by "dylib", and finally "dll", where the first successfully loaded shared object file is used. ## The Unfied ESMX_Driver @@ -383,6 +386,7 @@ ESMX includes a data component, which can be used for testing NUOPC caps. This c ## ESMX Software Dependencies The ESMX layer has the following dependencies: + - **ESMF Library**: The ESMX layer is part of the ESMF repository. In order to use ESMX as described above, the ESMF library first needs to be built following the instructions for [Building ESMF](https://github.com/esmf-org/esmf#building-esmf). - **CMake**: v3.22 or greater. - **Python**: v3.5 or greater. diff --git a/src/addon/NUOPC/include/NUOPC.h b/src/addon/NUOPC/include/NUOPC.h new file mode 100644 index 0000000000..67f8cbecad --- /dev/null +++ b/src/addon/NUOPC/include/NUOPC.h @@ -0,0 +1,87 @@ +// $Id$ +// +// Earth System Modeling Framework +// Copyright (c) 2002-2024, University Corporation for Atmospheric Research, +// Massachusetts Institute of Technology, Geophysical Fluid Dynamics +// Laboratory, University of Michigan, National Centers for Environmental +// Prediction, Los Alamos National Laboratory, Argonne National Laboratory, +// NASA Goddard Space Flight Center. +// Licensed under the University of Illinois-NCSA License. +//----------------------------------------------------------------------------- + +#include "ESMC.h" + +//----------------------------------------------------------------------------- +// This file is part of the pure C public NUOPC API +//----------------------------------------------------------------------------- + +#ifndef NUOPC_H +#define NUOPC_H + +#ifdef __cplusplus +extern "C" { +#endif + +// TODO: access these string constants via ISO_C interop. from Fortran definition +const char *label_InternalState = "ModelBase_InternalState"; +const char *label_Advance = "ModelBase_Advance"; +const char *label_AdvanceClock = "ModelBase_AdvanceClock"; +const char *label_CheckImport = "ModelBase_CheckImport"; +const char *label_SetRunClock = "ModelBase_SetRunClock"; +const char *label_TimestampExport = "ModelBase_TimestampExport"; +const char *label_Finalize = "ModelBase_Finalize"; +const char *label_Advertise = "ModelBase_Advertise"; +const char *label_ModifyAdvertised = "ModelBase_ModifyAdvertised"; +const char *label_RealizeProvided = "ModelBase_RealizeProvided"; +const char *label_AcceptTransfer = "ModelBase_AcceptTransfer"; +const char *label_RealizeAccepted = "ModelBase_RealizeAccepted"; +const char *label_SetClock = "ModelBase_SetClock"; +const char *label_DataInitialize = "ModelBase_DataInitialize"; + +int NUOPC_CompDerive( + ESMC_GridComp comp, // in + void (*userRoutine)(ESMC_GridComp, int *) // in +); + +int NUOPC_CompSpecialize( + ESMC_GridComp comp, // in + const char *specLabel, // in + void (*specRoutine)(ESMC_GridComp, int *) // in +); + +void NUOPC_ModelSetServices( + ESMC_GridComp comp, // in + int *rc // out +); + +void NUOPC_ModelSetVM( + ESMC_GridComp comp, // in + int *rc // out +); + +ESMC_State NUOPC_ModelGetExportState( + ESMC_GridComp comp, // in + int *rc // out +); + +ESMC_State NUOPC_ModelGetImportState( + ESMC_GridComp comp, // in + int *rc // out +); + +int NUOPC_Advertise( + ESMC_State state, // in + const char *standardName, // in + const char *fieldName // in +); + +int NUOPC_Realize( + ESMC_State state, // in + ESMC_Field field // in +); + +#ifdef __cplusplus +} // extern "C" +#endif + +#endif // NUOPC_H diff --git a/src/addon/NUOPC/interface/NUOPC_C.F90 b/src/addon/NUOPC/interface/NUOPC_C.F90 new file mode 100644 index 0000000000..905a52a119 --- /dev/null +++ b/src/addon/NUOPC/interface/NUOPC_C.F90 @@ -0,0 +1,216 @@ +! $Id$ +! +! Earth System Modeling Framework +! Copyright (c) 2002-2024, University Corporation for Atmospheric Research, +! Massachusetts Institute of Technology, Geophysical Fluid Dynamics +! Laboratory, University of Michigan, National Centers for Environmental +! Prediction, Los Alamos National Laboratory, Argonne National Laboratory, +! NASA Goddard Space Flight Center. +! Licensed under the University of Illinois-NCSA License. +! +!============================================================================== +#define FILENAME "src/addon/NUOPC/interface/NUOPC_C.F90" +!============================================================================== +!------------------------------------------------------------------------------ +! INCLUDES +#include "ESMF.h" + +!------------------------------------------------------------------------------ +subroutine f_nuopc_compspecialize(gcomp, specLabel, specRoutine, rc) +#undef ESMF_METHOD +#define ESMF_METHOD "f_nuopc_compspecialize" + use ESMF + use NUOPC + implicit none + + type(ESMF_GridComp) :: gcomp !in + character(len=*), intent(in) :: specLabel + interface + subroutine specRoutine(gridcomp, rc) + use ESMF + implicit none + type(ESMF_GridComp) :: gridcomp ! must not be optional + integer, intent(out) :: rc ! must not be optional + end subroutine + end interface + integer, intent(out) :: rc !out + + integer :: localrc + + ! Initialize return code; assume routine not implemented + rc = ESMF_RC_NOT_IMPL + + call NUOPC_CompSpecialize(gcomp, specLabel, specRoutine=specRoutine, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Return successfully + rc = ESMF_SUCCESS +end subroutine f_nuopc_compspecialize +!------------------------------------------------------------------------------ + + +!------------------------------------------------------------------------------ +subroutine f_nuopc_modelsetservices(gcomp, rc) +#undef ESMF_METHOD +#define ESMF_METHOD "f_nuopc_modelsetservices" + use ESMF + use NUOPC + use NUOPC_Model, only: SetServices + implicit none + + type(ESMF_GridComp) :: gcomp !in + integer, intent(out) :: rc !out + + integer :: localrc + + ! Initialize return code; assume routine not implemented + rc = ESMF_RC_NOT_IMPL + + call SetServices(gcomp, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Return successfully + rc = ESMF_SUCCESS +end subroutine f_nuopc_modelsetservices +!------------------------------------------------------------------------------ + + +!------------------------------------------------------------------------------ +subroutine f_nuopc_modelsetvm(gcomp, rc) +#undef ESMF_METHOD +#define ESMF_METHOD "f_nuopc_modelsetvm" + use ESMF + use NUOPC + use NUOPC_Model, only: SetVM + implicit none + + type(ESMF_GridComp) :: gcomp !in + integer, intent(out) :: rc !out + + integer :: localrc + + ! Initialize return code; assume routine not implemented + rc = ESMF_RC_NOT_IMPL + + call SetVM(gcomp, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Return successfully + rc = ESMF_SUCCESS +end subroutine f_nuopc_modelsetvm +!------------------------------------------------------------------------------ + + +!------------------------------------------------------------------------------ +subroutine f_nuopc_modelgetexportstate(gcomp, state, rc) +#undef ESMF_METHOD +#define ESMF_METHOD "f_nuopc_modelgetexportstate" + use ESMF + use NUOPC + use NUOPC_Model, only: NUOPC_ModelGet + implicit none + + type(ESMF_GridComp) :: gcomp !in + type(ESMF_State) :: state !out + integer, intent(out) :: rc !out + + integer :: localrc + + ! Initialize return code; assume routine not implemented + rc = ESMF_RC_NOT_IMPL + + call NUOPC_ModelGet(gcomp, exportState=state, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Return successfully + rc = ESMF_SUCCESS +end subroutine f_nuopc_modelgetexportstate +!------------------------------------------------------------------------------ + + +!------------------------------------------------------------------------------ +subroutine f_nuopc_modelgetimportstate(gcomp, state, rc) +#undef ESMF_METHOD +#define ESMF_METHOD "f_nuopc_modelgetimportstate" + use ESMF + use NUOPC + use NUOPC_Model, only: NUOPC_ModelGet + implicit none + + type(ESMF_GridComp) :: gcomp !in + type(ESMF_State) :: state !out + integer, intent(out) :: rc !out + + integer :: localrc + + ! Initialize return code; assume routine not implemented + rc = ESMF_RC_NOT_IMPL + + call NUOPC_ModelGet(gcomp, importState=state, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Return successfully + rc = ESMF_SUCCESS +end subroutine f_nuopc_modelgetimportstate +!------------------------------------------------------------------------------ + + +!------------------------------------------------------------------------------ +subroutine f_nuopc_advertise(state, standardName, fieldName, rc) +#undef ESMF_METHOD +#define ESMF_METHOD "f_nuopc_advertise" + use ESMF + use NUOPC + implicit none + + type(ESMF_State) :: state !in + character(len=*), intent(in) :: standardName !in + character(len=*), intent(in) :: fieldName !in + integer, intent(out) :: rc !out + + integer :: localrc + + ! Initialize return code; assume routine not implemented + rc = ESMF_RC_NOT_IMPL + + call NUOPC_Advertise(state, standardName, name=fieldName, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Return successfully + rc = ESMF_SUCCESS +end subroutine f_nuopc_advertise +!------------------------------------------------------------------------------ + + +!------------------------------------------------------------------------------ +subroutine f_nuopc_realize(state, field, rc) +#undef ESMF_METHOD +#define ESMF_METHOD "f_nuopc_realize" + use ESMF + use NUOPC + implicit none + + type(ESMF_State) :: state !in + type(ESMF_Field) :: field !in + integer, intent(out) :: rc !out + + integer :: localrc + + ! Initialize return code; assume routine not implemented + rc = ESMF_RC_NOT_IMPL + + call NUOPC_Realize(state, field, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Return successfully + rc = ESMF_SUCCESS +end subroutine f_nuopc_realize +!------------------------------------------------------------------------------ diff --git a/src/addon/NUOPC/interface/NUOPC_F.C b/src/addon/NUOPC/interface/NUOPC_F.C new file mode 100644 index 0000000000..254b7121b0 --- /dev/null +++ b/src/addon/NUOPC/interface/NUOPC_F.C @@ -0,0 +1,196 @@ +// $Id$ +// +// Earth System Modeling Framework +// Copyright (c) 2002-2024, University Corporation for Atmospheric Research, +// Massachusetts Institute of Technology, Geophysical Fluid Dynamics +// Laboratory, University of Michigan, National Centers for Environmental +// Prediction, Los Alamos National Laboratory, Argonne National Laboratory, +// NASA Goddard Space Flight Center. +// Licensed under the University of Illinois-NCSA License. +//----------------------------------------------------------------------------- +#define ESMC_FILENAME "NUOPC_F.C" +//============================================================================== +// +// ESMC Array method implementation (body) file +// +//----------------------------------------------------------------------------- +// include associated header file +#include "NUOPC.h" + +// include ESMF headers +#include "ESMCI_Base.h" +#include "ESMCI_Arg.h" +#include "ESMCI_LogErr.h" +#include "ESMCI_Comp.h" +#include "ESMCI_State.h" + +// include std headers +#include + +extern "C" { + +//----------------------------------------------------------------------------- +#undef ESMC_METHOD +#define ESMC_METHOD "NUOPC_CompDerive()" +int NUOPC_CompDerive( + ESMC_GridComp comp, // in + void (*userRoutine)(ESMC_GridComp, int *) // in +){ + // initialize return code; assume routine not implemented + int localrc = ESMC_RC_NOT_IMPL; // local return code + int rc = ESMC_RC_NOT_IMPL; // final return code + + (*userRoutine)(comp, &localrc); + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, + &rc)) return rc; // bail out + + // return successfully + rc = ESMF_SUCCESS; + return rc; +} +//----------------------------------------------------------------------------- + + +//----------------------------------------------------------------------------- +void FTN_X(f_nuopc_compspecialize)(const ESMCI::Comp *, const char *, + void (*specRoutine)(ESMC_GridComp, int *), int *rc, ESMCI_FortranStrLenArg); +#undef ESMC_METHOD +#define ESMC_METHOD "NUOPC_CompSpecialize()" +int NUOPC_CompSpecialize( + ESMC_GridComp comp, // in + const char *specLabel, // in + void (*specRoutine)(ESMC_GridComp, int *) // in +){ + // initialize return code; assume routine not implemented + int localrc = ESMC_RC_NOT_IMPL; // local return code + int rc = ESMC_RC_NOT_IMPL; // final return code + + FTN_X(f_nuopc_compspecialize)((const ESMCI::Comp *)comp.ptr, specLabel, + specRoutine, &localrc, (ESMCI_FortranStrLenArg)strlen(specLabel)); + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, + &rc)) return rc; // bail out + + // return successfully + rc = ESMF_SUCCESS; + return rc; +} +//----------------------------------------------------------------------------- + + +//----------------------------------------------------------------------------- +void FTN_X(f_nuopc_modelsetservices)(const ESMCI::Comp *, int* rc); +#undef ESMC_METHOD +#define ESMC_METHOD "NUOPC_ModelSetServices()" +void NUOPC_ModelSetServices(ESMC_GridComp comp, int *rc){ + // initialize return code; assume routine not implemented + int localrc = ESMC_RC_NOT_IMPL; // local return code + FTN_X(f_nuopc_modelsetservices)((const ESMCI::Comp *)comp.ptr, &localrc); + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, + rc)) return; // bail out + + // return successfully + if (rc!=NULL) *rc = ESMF_SUCCESS; +} +//----------------------------------------------------------------------------- + + +//----------------------------------------------------------------------------- +void FTN_X(f_nuopc_modelsetvm)(const ESMCI::Comp *, int* rc); +#undef ESMC_METHOD +#define ESMC_METHOD "NUOPC_ModelSetVM()" +void NUOPC_ModelSetVM(ESMC_GridComp comp, int *rc){ + // initialize return code; assume routine not implemented + int localrc = ESMC_RC_NOT_IMPL; // local return code + FTN_X(f_nuopc_modelsetvm)((const ESMCI::Comp *)comp.ptr, &localrc); + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, + rc)) return; // bail out + + // return successfully + if (rc!=NULL) *rc = ESMF_SUCCESS; +} +//----------------------------------------------------------------------------- + + +//----------------------------------------------------------------------------- +void FTN_X(f_nuopc_modelgetexportstate)(const ESMCI::Comp *, ESMCI::State*, + int* rc); +#undef ESMC_METHOD +#define ESMC_METHOD "NUOPC_ModelGetExportState()" +ESMC_State NUOPC_ModelGetExportState(ESMC_GridComp comp, int *rc){ + // initialize return code; assume routine not implemented + int localrc = ESMC_RC_NOT_IMPL; // local return code + ESMC_State state; + state.ptr = new ESMCI::State; //TODO: this leaves a memory leak! + FTN_X(f_nuopc_modelgetexportstate)((const ESMCI::Comp *)comp.ptr, + (ESMCI::State *)state.ptr, &localrc); + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, + rc)) return state; // bail out + // return successfully + if (rc!=NULL) *rc = ESMF_SUCCESS; + return state; +} +//----------------------------------------------------------------------------- + + +//----------------------------------------------------------------------------- +void FTN_X(f_nuopc_modelgetimportstate)(const ESMCI::Comp *, ESMCI::State*, + int* rc); +#undef ESMC_METHOD +#define ESMC_METHOD "NUOPC_ModelGetImportState()" +ESMC_State NUOPC_ModelGetImportState(ESMC_GridComp comp, int *rc){ + // initialize return code; assume routine not implemented + int localrc = ESMC_RC_NOT_IMPL; // local return code + ESMC_State state; + state.ptr = new ESMCI::State; //TODO: this leaves a memory leak! + FTN_X(f_nuopc_modelgetimportstate)((const ESMCI::Comp *)comp.ptr, + (ESMCI::State *)state.ptr, &localrc); + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, + rc)) return state; // bail out + // return successfully + if (rc!=NULL) *rc = ESMF_SUCCESS; + return state; +} +//----------------------------------------------------------------------------- + + +//----------------------------------------------------------------------------- +void FTN_X(f_nuopc_advertise)(const ESMCI::State*, const char *, const char *, + int* rc, ESMCI_FortranStrLenArg, ESMCI_FortranStrLenArg); +#undef ESMC_METHOD +#define ESMC_METHOD "NUOPC_Advertise()" +int NUOPC_Advertise(ESMC_State state, const char *standardName, + const char *fieldName){ + // initialize return code; assume routine not implemented + int localrc = ESMC_RC_NOT_IMPL; // local return code + int rc = ESMC_RC_NOT_IMPL; // final return code + FTN_X(f_nuopc_advertise)((const ESMCI::State *)state.ptr, standardName, + fieldName, &localrc, (ESMCI_FortranStrLenArg)strlen(standardName), + (ESMCI_FortranStrLenArg)strlen(fieldName)); + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, + &rc)) return rc; // bail out + // return successfully + rc = ESMF_SUCCESS; + return rc; +} +//----------------------------------------------------------------------------- + + +//----------------------------------------------------------------------------- +void FTN_X(f_nuopc_realize)(const ESMCI::State*, const ESMCI::Field*, int* rc); +#undef ESMC_METHOD +#define ESMC_METHOD "NUOPC_Realize()" +int NUOPC_Realize(ESMC_State state, ESMC_Field field){ + // initialize return code; assume routine not implemented + int localrc = ESMC_RC_NOT_IMPL; // local return code + int rc = ESMC_RC_NOT_IMPL; // final return code + FTN_X(f_nuopc_realize)((const ESMCI::State *)state.ptr, + (const ESMCI::Field *)field.ptr, &localrc); + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, + &rc)) return rc; // bail out + // return successfully + rc = ESMF_SUCCESS; + return rc; +} +//----------------------------------------------------------------------------- + +}; // extern "C" diff --git a/src/addon/NUOPC/interface/makefile b/src/addon/NUOPC/interface/makefile new file mode 100644 index 0000000000..753351743e --- /dev/null +++ b/src/addon/NUOPC/interface/makefile @@ -0,0 +1,26 @@ +# $Id$ + +ALL: build_here + +SOURCEC = NUOPC_F.C +SOURCEF = NUOPC_C.F90 +SOURCEH = + +# List all .h files which should be copied to common include dir +STOREH = NUOPC.h + +OBJSC = $(addsuffix .o, $(basename $(SOURCEC))) +OBJSF = $(addsuffix .o, $(basename $(SOURCEF))) +TEXFILES = $(addsuffix _fapi.tex, $(basename $(AUTOGEN))) + +LIBBASE = libesmf +LOCDIR = src/addon/NUOPC/interface + +CLEANDIRS = +CLEANFILES = $(addprefix ../doc/, $(TEXFILES) ) +CLOBBERDIRS = + +include $(ESMF_DIR)/makefile + +DIRS = + diff --git a/src/addon/NUOPC/makefile b/src/addon/NUOPC/makefile index 47979d74b5..b686c57fdb 100644 --- a/src/addon/NUOPC/makefile +++ b/src/addon/NUOPC/makefile @@ -13,7 +13,7 @@ include ${ESMF_DIR}/makefile # directly below this directory, and have either library, # example/test code, or documents which need to be generated. -DIRS = src tests doc examples +DIRS = src interface tests doc examples CLEANDIRS = CLEANFILES = diff --git a/src/addon/NUOPC/src/NUOPC_Comp.F90 b/src/addon/NUOPC/src/NUOPC_Comp.F90 index 8ee7b9d80c..67d2d8a9d1 100644 --- a/src/addon/NUOPC/src/NUOPC_Comp.F90 +++ b/src/addon/NUOPC/src/NUOPC_Comp.F90 @@ -4112,6 +4112,11 @@ recursive subroutine NUOPC_GridCompSetServices(comp, sharedObj, userRc, rc) ! and execute the routine. An attempt is made to find a routine that ! is close in name to "{\tt SetServices}", allowing for compiler name ! mangling, i.e. upper and lower case, as well as trailing underscores. +! The asterisk character {\tt (*)} is supported as a wildcard for the +! file name suffix in {\tt sharedObj}. When present, the asterisk is replaced +! by "so", "dylib", and "dll", in this order, and the first successfully +! loaded object is used. If the {\tt sharedObj} argument is not provided, the +! executable itself is searched. !EOP !----------------------------------------------------------------------------- ! local variables @@ -4247,6 +4252,11 @@ recursive subroutine NUOPC_GridCompSetVM(comp, sharedObj, userRc, rc) ! and execute the routine. An attempt is made to find a routine that ! is close in name to "{\tt SetVM}", allowing for compiler name ! mangling, i.e. upper and lower case, as well as trailing underscores. +! The asterisk character {\tt (*)} is supported as a wildcard for the +! file name suffix in {\tt sharedObj}. When present, the asterisk is replaced +! by "so", "dylib", and "dll", in this order, and the first successfully +! loaded object is used. If the {\tt sharedObj} argument is not provided, the +! executable itself is searched. !EOP !----------------------------------------------------------------------------- ! local variables diff --git a/src/addon/NUOPC/src/NUOPC_Driver.F90 b/src/addon/NUOPC/src/NUOPC_Driver.F90 index f04e0d4a7e..25a3cb6ae6 100644 --- a/src/addon/NUOPC/src/NUOPC_Driver.F90 +++ b/src/addon/NUOPC/src/NUOPC_Driver.F90 @@ -4648,11 +4648,12 @@ recursive subroutine SetVMRoutine(gridcomp, rc) ! or by default across all of the Driver PETs. ! ! The specified {\tt compSetServicesRoutine()} is called back immediately after -! the new child component has been created internally. Very little around the -! component is set up at that time (e.g. NUOPC component attributes will not be -! available). The routine should therefore be very light weight, with the sole -! purpose of setting the entry points of the component -- typically by deriving -! from a generic component followed by the appropriate specilizations. +! the new child component has been created internally. +! Very little around the component is set up at that time (e.g. NUOPC component +! attributes are not yet available at this stage). The routine should therefore +! be very light weight, with the sole purpose of setting the entry points of +! the component -- typically by deriving from a generic component followed by +! the appropriate specilizations. ! ! If provided, the {\tt compSetVMRoutine()} is called back before the ! {\tt compSetServicesRoutine()}. This allows the child component to set @@ -4826,13 +4827,21 @@ recursive subroutine NUOPC_DriverAddGridCompSO(driver, compLabel, & ! component to a Driver. The component is created on the provided {\tt petList}, ! or by default across all of the Driver PETs. ! -! The {\tt SetServices()} routine in the {\tt sharedObj} is called back -! immediately after the -! new child component has been created internally. Very little around the -! component is set up at that time (e.g. NUOPC component attributes will not be -! available). The routine should therefore be very light weight, with the sole -! purpose of setting the entry points of the component -- typically by deriving -! from a generic component followed by the appropriate specilizations. +! The {\tt SetVM()} and {\tt SetServices()} routines in {\tt sharedObj} +! are called back immediately after the new child component has been created +! internally. +! Very little around the component is set up at that time (e.g. NUOPC component +! attributes are not yet available at this stage). The routine should therefore +! be very light weight, with the sole purpose of setting the entry points of +! the component -- typically by deriving from a generic component followed by +! the appropriate specilizations. +! +! The asterisk character {\tt (*)} is supported as a wildcard for the +! file name suffix in {\tt sharedObj}. When present, the asterisk is replaced +! by "so", "dylib", and "dll", in this order, and the first successfully +! loaded object is used. If the {\tt sharedObj} argument is not provided, the +! executable itself is searched for the "{\tt SetVM}" and "{\tt SetServices}" +! symbols. ! ! The {\tt info} argument can be used to pass custom attributes to the child ! component. These attributes are available on the component when @@ -5039,11 +5048,12 @@ recursive subroutine SetVMRoutine(cplcomp, rc) ! and {\tt dstCompLabel}. ! ! The specified {\tt SetServices()} routine is called back immediately after the -! new child component has been created internally. Very little around the -! component is set up at that time (e.g. NUOPC component attributes will not be -! available). The routine should therefore be very light weight, with the sole -! purpose of setting the entry points of the component -- typically by deriving -! from a generic component followed by the appropriate specilizations. +! new child component has been created internally. +! Very little around the component is set up at that time (e.g. NUOPC component +! attributes are not yet available at this stage). The routine should therefore +! be very light weight, with the sole purpose of setting the entry points of +! the component -- typically by deriving from a generic component followed by +! the appropriate specilizations. ! ! The {\tt info} argument can be used to pass custom attributes to the child ! component. These attributes are available on the component when diff --git a/src/addon/NUOPC/src/makefile b/src/addon/NUOPC/src/makefile index ac0897a446..0d98dbc9b3 100644 --- a/src/addon/NUOPC/src/makefile +++ b/src/addon/NUOPC/src/makefile @@ -16,6 +16,9 @@ SOURCEF = NUOPC_FreeFormatDef.F90 \ NUOPC_Connector.F90 SOURCEH = +# List all .h files which should be copied to common include dir +STOREH = + OBJSC = $(addsuffix .o, $(basename $(SOURCEC))) OBJSF = $(addsuffix .o, $(basename $(SOURCEF))) TEXFILES = $(addsuffix _fapi.tex, $(basename $(AUTOGEN))) diff --git a/src/system_tests/ESMF_FieldRegridPatchDisjoint/ESMF_FieldRegridPatchDisjointSTest.F90 b/src/system_tests/ESMF_FieldRegridPatchDisjoint/ESMF_FieldRegridPatchDisjointSTest.F90 new file mode 100644 index 0000000000..8bbb54ecd7 --- /dev/null +++ b/src/system_tests/ESMF_FieldRegridPatchDisjoint/ESMF_FieldRegridPatchDisjointSTest.F90 @@ -0,0 +1,400 @@ +! $Id$ +! +! System test code FieldRegrid + +!------------------------------------------------------------------------- +!ESMF_MULTI_PROC_SYSTEM_TEST String used by test script to count system tests. +!========================================================================= + +!BOP +! +! !DESCRIPTION: +! System test FieldRegrid. +! Regrid test. 2 components and 1 coupler, one-way coupling. +! The first component has a small mesh running on 1 PET. With a +! Field whose data is set to 20.0+x+y. The second component +! contains a Grid spread across 4 procs. The Field on the Mesh +! is interpolated to the Grid. +! +! +!\begin{verbatim} + + program ESMF_FieldRegridPatchDisjointSTest +#define ESMF_METHOD "program ESMF_FieldRegridPatchDisjointSTest" + +#include "ESMF.h" + + ! ESMF Framework module + use ESMF + use ESMF_TestMod + + use user_model1, only : userm1_register + use user_model2, only : userm2_register + use user_coupler, only : usercpl_register + + implicit none + + ! Local variables + integer :: pet_id, npets, rc, localrc, userrc,i + character(len=ESMF_MAXSTR) :: cname1, cname2, cplname + type(ESMF_VM):: vm + type(ESMF_State) :: c1exp, c2imp + type(ESMF_GridComp) :: comp1, comp2 + type(ESMF_CplComp) :: cpl + + ! instantiate a clock, a calendar, and timesteps + type(ESMF_Clock) :: clock + type(ESMF_Calendar) :: gregorianCalendar + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Time) :: startTime + type(ESMF_Time) :: stopTime + + ! cumulative result: count failures; no failures equals "all pass" + integer :: result = 0 + + ! individual test name + character(ESMF_MAXSTR) :: testname + + ! individual test failure message, and final status msg + character(ESMF_MAXSTR) :: failMsg, finalMsg + + ! set rc = ESMF_SUCCESS + rc = ESMF_SUCCESS + +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- + + print *, "-------------------------------- " + print *, "Start of System Test ESMF_FieldRegridPatchDisjointSTest:" + print *, "-------------------------------- " + +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- +! Create section +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- +! + ! Initialize framework and get back default global VM + call ESMF_Initialize(vm=vm, defaultlogfilename="FieldRegridPatchDisjointSTest.Log", & + logkindflag=ESMF_LOGKIND_MULTI, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_LogSet (flush=.true.) + + ! Get number of PETs we are running with + call ESMF_VMGet(vm, petCount=npets, localPet=pet_id, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + ! Check for correct number of PETs + if ( npets < 5 ) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD,& + msg="This system test does not run on fewer than 5 PETs.",& + ESMF_CONTEXT, rcToReturn=rc) + call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + endif + + ! Create the 2 model components and coupler + cname1 = "user model 1" + comp1 = ESMF_GridCompCreate(name=cname1, petList=(/0/), rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + print *, "Created component ", trim(cname1), "rc =", rc + ! call ESMF_GridCompPrint(comp1, "", rc) + + cname2 = "user model 2" + comp2 = ESMF_GridCompCreate(name=cname2, petList=(/1,2,3,4/),rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + print *, "Created component ", trim(cname2), "rc =", rc + ! call ESMF_GridCompPrint(comp2, "", rc) + + cplname = "user one-way coupler" + cpl = ESMF_CplCompCreate(name=cplname, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + print *, "Created component ", trim(cplname), ", rc =", rc + ! call ESMF_CplCompPrint(cpl, "", rc) + + print *, "Comp Creates finished" + +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- +! Register section +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- + call ESMF_GridCompSetServices(comp1, userRoutine=userm1_register, & + userRc=userrc, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + if (ESMF_LogFoundError(userrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + print *, "Comp SetServices finished, rc= ", rc, userrc + + call ESMF_GridCompSetServices(comp2, userRoutine=userm2_register, & + userRc=userrc, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + if (ESMF_LogFoundError(userrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + print *, "Comp SetServices finished, rc= ", rc, userrc + + call ESMF_CplCompSetServices(cpl, userRoutine=usercpl_register, & + userRc=userrc, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + if (ESMF_LogFoundError(userrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + print *, "Comp SetServices finished, rc= ", rc, userrc + +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- +! Create and initialize a clock. +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- + ! initialize calendar to be Gregorian type + gregorianCalendar = ESMF_CalendarCreate(ESMF_CALKIND_GREGORIAN, & + name="Gregorian", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + ! initialize time interval to 6 hours + call ESMF_TimeIntervalSet(timeStep, h=6, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + ! initialize start time to 5/01/2003 + call ESMF_TimeSet(startTime, yy=2003, mm=5, dd=1, & + calendar=gregorianCalendar, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + ! initialize stop time to 5/02/2003 + call ESMF_TimeSet(stopTime, yy=2003, mm=5, dd=1, h=6, & + calendar=gregorianCalendar, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + ! initialize the clock with the above values + clock = ESMF_ClockCreate(timeStep, startTime, stopTime=stopTime, & + name="Clock 1", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- +! Init section +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- + + c1exp = ESMF_StateCreate(name="comp1 export", & + stateintent=ESMF_STATEINTENT_EXPORT, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + call ESMF_GridCompInitialize(comp1, exportState=c1exp, clock=clock, & + userRc=userrc, rc=localrc) + + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + if (ESMF_LogFoundError(userrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + c2imp = ESMF_StateCreate(name="comp2 import", & + stateintent=ESMF_STATEINTENT_IMPORT, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + call ESMF_GridCompInitialize(comp2, importState=c2imp, clock=clock, & + userRc=userrc, rc=localrc) + + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + if (ESMF_LogFoundError(userrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + ! note that the coupler's import is comp1's export + call ESMF_CplCompInitialize(cpl, importState=c1exp, & + exportState=c2imp, clock=clock, & + userRc=userrc, rc=localrc) + + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + if (ESMF_LogFoundError(userrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- +! Run section +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- + +! do while (.not. ESMF_ClockIsStopTime(clock, rc=rc)) + +!do i=1,2 + + call ESMF_GridCompRun(comp1, exportState=c1exp, clock=clock, & + userRc=userrc, rc=localrc) + + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + if (ESMF_LogFoundError(userrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_CplCompRun(cpl, importState=c1exp, & + exportState=c2imp, clock=clock, & + userRc=userrc, rc=localrc) + + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + if (ESMF_LogFoundError(userrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_GridCompRun(comp2, importState=c2imp, clock=clock, & + userRc=userrc, rc=localrc) + + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + if (ESMF_LogFoundError(userrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + +! call ESMF_ClockAdvance(clock, rc=localrc) +! !call ESMF_ClockPrint(clock, rc=rc) +! if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & +! ESMF_CONTEXT, rcToReturn=rc)) & +! call ESMF_Finalize(endflag=ESMF_END_ABORT) + +! enddo + +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- +! Finalize section +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- +! Print result + + call ESMF_GridCompFinalize(comp1, exportState=c1exp, clock=clock, & + userRc=userrc, rc=localrc) + print *, "Comp 1 Finalize finished, rc =", rc + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + if (ESMF_LogFoundError(userrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_GridCompFinalize(comp2, importState=c2imp, clock=clock, & + userRc=userrc, rc=localrc) + print *, "Comp 2 Finalize finished, rc =", rc + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + if (ESMF_LogFoundError(userrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_CplCompFinalize(cpl, importState=c1exp, & + exportState=c2imp, clock=clock, & + userRc=userrc, rc=localrc) + print *, "Coupler Finalize finished, rc =", rc + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + if (ESMF_LogFoundError(userrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + + + + print *, "------------------------------------------------------------" + print *, "------------------------------------------------------------" + print *, "Test finished, pet_id = ", pet_id + print *, "------------------------------------------------------------" + print *, "------------------------------------------------------------" + + print *, "Comp Finalize returned" + +! +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- +! Destroy section +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- +! Clean up + + call ESMF_StateDestroy(c1exp, rc=rc) + call ESMF_StateDestroy(c2imp, rc=rc) + + call ESMF_ClockDestroy(clock, rc=rc) + call ESMF_CalendarDestroy(gregorianCalendar, rc=rc) + + call ESMF_GridCompDestroy(comp1, rc=rc) + call ESMF_GridCompDestroy(comp2, rc=rc) + call ESMF_CplCompDestroy(cpl, rc=rc) + + print *, "All Destroy routines done" + +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- +10 print *, "System Test FieldRegridPatchDisjoint complete." + + + ! Normal ESMF Test output + write(failMsg, *) "System Test failure" + write(testname, *) "System Test FieldRegridPatchDisjoint: Field Regrid" + + if (rc .ne. ESMF_SUCCESS) then + ! Separate message to console, for quick confirmation of success/failure + if (rc .eq. ESMF_SUCCESS) then + write(finalMsg, *) "SUCCESS: Regrid test finished correctly." + else + write(finalMsg, *) "System Test did not succeed. Error code ", rc + endif + write(0, *) "" + write(0, *) trim(testname) + write(0, *) trim(finalMsg) + write(0, *) "" + + endif + + ! IMPORTANT: ESMF_STest() prints the PASS string and the # of processors in the log + ! file that the scripts grep for. + call ESMF_STest((rc.eq.ESMF_SUCCESS), testname, failMsg, result, ESMF_SRCLINE) + + + call ESMF_Finalize(rc=rc) + + end program ESMF_FieldRegridPatchDisjointSTest + +!\end{verbatim} + diff --git a/src/system_tests/ESMF_FieldRegridPatchDisjoint/makefile b/src/system_tests/ESMF_FieldRegridPatchDisjoint/makefile new file mode 100644 index 0000000000..ee8750249e --- /dev/null +++ b/src/system_tests/ESMF_FieldRegridPatchDisjoint/makefile @@ -0,0 +1,33 @@ +# $Id$ + +ALL: tree_build_system_tests + +run: tree_run_system_tests + +LOCDIR = src/system_tests/ESMF_FieldRegridPatchDisjoint + + +SYSTEM_TESTS_BUILD = $(ESMC_TESTDIR)/ESMF_FieldRegridPatchDisjointSTest + +# Object files other than SysTest%.o that the +# system tests executable will depend on. +# List objects files in the order that they +# are to be compiled/created. +SYSTEM_TESTS_OBJ = user_model1.o user_model2.o user_coupler.o + +SYSTEM_TESTS_RUN = RUN_FieldRegridPatchDisjoint + +SYSTEM_TESTS_RUN_UNI = + +ESMF_FieldRegridPatchDisjointSTest.o : $(SYSTEM_TESTS_OBJ) + +include $(ESMF_DIR)/makefile + +DIRS = + +CLEANDIRS = +CLEANFILES = $(SYSTEM_TESTS_BUILD) +CLOBBERDIRS = + +RUN_FieldRegridPatchDisjoint: + $(MAKE) TNAME=FieldRegridPatchDisjoint NP=5 stest diff --git a/src/system_tests/ESMF_FieldRegridPatchDisjoint/user_coupler.F90 b/src/system_tests/ESMF_FieldRegridPatchDisjoint/user_coupler.F90 new file mode 100644 index 0000000000..806ae069c7 --- /dev/null +++ b/src/system_tests/ESMF_FieldRegridPatchDisjoint/user_coupler.F90 @@ -0,0 +1,177 @@ +! $Id$ +! +! Example/test code which shows User Component calls. + +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- + +!BOP +! +! !DESCRIPTION: +! User-supplied Coupler +! +! +!\begin{verbatim} + + module user_coupler + + ! ESMF Framework module + use ESMF + + implicit none + + public usercpl_register + + ! global data + type(ESMF_RouteHandle), save :: routehandle + + contains + +!------------------------------------------------------------------------- +! ! The Register routine sets the subroutines to be called +! ! as the init, run, and finalize routines. Note that these are +! ! private to the module. + + subroutine usercpl_register(comp, rc) + type(ESMF_CplComp) :: comp + integer, intent(out) :: rc + + rc = ESMF_SUCCESS + print *, "in user setservices routine" + + ! Register the callback routines. + call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, user_init, rc=rc) + if(rc/=ESMF_SUCCESS) return + call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_RUN, user_run, rc=rc) + if(rc/=ESMF_SUCCESS) return + call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, user_final, rc=rc) + if(rc/=ESMF_SUCCESS) return + + print *, "Registered Initialize, Run, and Finalize routines" + + end subroutine + +!------------------------------------------------------------------------- +! !User Comp Component created by higher level calls, here is the +! ! Initialization routine. + + + subroutine user_init(comp, importState, exportState, clock, rc) + type(ESMF_CplComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! Local variables + integer :: localPET, petCount + type(ESMF_Field) :: srcField,dstField + type(ESMF_VM) :: vm + + rc = ESMF_SUCCESS + + ! Need to reconcile import and export states + call ESMF_CplCompGet(comp, vm=vm, rc=rc) + if (rc/=ESMF_SUCCESS) return ! bail out + + call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=rc) + if(rc/=ESMF_SUCCESS) return + + write(*,*) localPET,"User Coupler Init Start" + + call ESMF_StateReconcile(importState, vm=vm, rc=rc) + if (rc/=ESMF_SUCCESS) return ! bail out + + write(*,*) localPET,"User Coupler After Import Reconcile" + + call ESMF_StateReconcile(exportState, vm=vm, rc=rc) + if (rc/=ESMF_SUCCESS) return ! bail out + + write(*,*) localPET,"User Coupler After Export Reconcile" + + ! Get input data + call ESMF_StateGet(importState, "src", srcField, rc=rc) + if(rc/=ESMF_SUCCESS) return + + ! Get location of output data + call ESMF_StateGet(exportState, "dst", dstField, rc=rc) + if(rc/=ESMF_SUCCESS) return + + ! These are fields on different Grids - call RegridStore to set + ! up the Regrid structure + call ESMF_FieldRegridStore(srcField=srcField, dstField=dstField, & + routeHandle=routehandle, & + regridmethod=ESMF_REGRIDMETHOD_PATCH, & + rc=rc) + if(rc/=ESMF_SUCCESS) return + + + write(*,*) localPET,"User Coupler Init End" + + end subroutine user_init + + +!------------------------------------------------------------------------- +! ! The Run routine where data is coupled. +! ! + + subroutine user_run(comp, importState, exportState, clock, rc) + type(ESMF_CplComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! Local variables + type(ESMF_Field) :: srcField, dstField + integer :: status + + rc = ESMF_SUCCESS + print *, "User Coupler Run starting" + + ! Get input data + call ESMF_StateGet(importState, "src", srcField, rc=rc) + if(rc/=ESMF_SUCCESS) return + + ! Get location of output data + call ESMF_StateGet(exportState, "dst", dstField, rc=rc) + if(rc/=ESMF_SUCCESS) return + + ! These are fields on different Grids - call Regrid to rearrange + ! the data. The communication pattern was computed at init, + ! this simply has to execute the send and receive equivalents. + call ESMF_FieldRegrid(srcField, dstField, routehandle, rc=status) + if(rc/=ESMF_SUCCESS) return + + + print *, "User Coupler Run returning" + + end subroutine user_run + + +!------------------------------------------------------------------------- +! ! The Finalization routine where things are deleted and cleaned up. +! ! + + subroutine user_final(comp, importState, exportState, clock, rc) + type(ESMF_CplComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! Local variables + + rc = ESMF_SUCCESS + print *, "User Coupler Final starting" + + ! Release resources stored for the Regridding. + call ESMF_FieldRegridRelease(routehandle, rc=rc) + if(rc/=ESMF_SUCCESS) return + + print *, "User Coupler Final returning" + + end subroutine user_final + + + end module user_coupler + +!\end{verbatim} + diff --git a/src/system_tests/ESMF_FieldRegridPatchDisjoint/user_model1.F90 b/src/system_tests/ESMF_FieldRegridPatchDisjoint/user_model1.F90 new file mode 100644 index 0000000000..89a9564da4 --- /dev/null +++ b/src/system_tests/ESMF_FieldRegridPatchDisjoint/user_model1.F90 @@ -0,0 +1,282 @@ +! $Id$ +! +! Example/test code which shows User Component calls. + +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- + +!BOP +! +! !DESCRIPTION: +! User-supplied Component, most recent interface revision. +! +! +!\begin{verbatim} + + module user_model1 + + ! ESMF Framework module + use ESMF + + implicit none + + public userm1_register + + contains + +!------------------------------------------------------------------------- +! ! The Register routine sets the subroutines to be called +! ! as the init, run, and finalize routines. Note that these are +! ! private to the module. + + subroutine userm1_register(comp, rc) + type(ESMF_GridComp) :: comp + integer, intent(out) :: rc + + rc = ESMF_SUCCESS + print *, "in user register routine" + + ! Register the callback routines. + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, user_init, rc=rc) + if(rc/=ESMF_SUCCESS) return + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, user_run, rc=rc) + if(rc/=ESMF_SUCCESS) return + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, user_final, rc=rc) + if(rc/=ESMF_SUCCESS) return + + print *, "Registered Initialize, Run, and Finalize routines" + + end subroutine + +!------------------------------------------------------------------------- +! ! User Comp Component created by higher level calls, here is the +! ! Initialization routine. + + + subroutine user_init(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! Local variables + type(ESMF_Field) :: srcField + type(ESMF_VM) :: vm + type(ESMF_Mesh) :: srcMesh + type(ESMF_ArraySpec) :: arrayspec + integer :: petCount, localPet, localrc + real(ESMF_KIND_R8), pointer :: fptr1D(:) + integer, pointer :: nodeIds(:),nodeOwners(:) + real(ESMF_KIND_R8), pointer :: nodeCoords(:) + integer, pointer :: elemIds(:),elemTypes(:),elemConn(:) + integer :: numNodes, numElems + integer :: numQuadElems,numTriElems, numTotElems + integer :: i + real(ESMF_KIND_R8) :: x,y + integer :: spatialDim, numOwnedNodes + real(ESMF_KIND_R8), pointer :: ownedNodeCoords(:) + + ! Query component for VM and create a layout with the right breakdown + call ESMF_GridCompGet(comp, vm=vm, rc=rc) + if(rc/=ESMF_SUCCESS) return + call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=rc) + if(rc/=ESMF_SUCCESS) return + + rc = ESMF_SUCCESS + + !!!!!! Setup source Mesh !!!!!!!!! + + ! Set number of nodes + numNodes=9 + + ! Allocate and fill the node id array. + allocate(nodeIds(numNodes)) + nodeIds=(/1,2,3,4,5,6,7,8,9/) + + ! Allocate and fill node coordinate array. + ! Since this is a 2D Mesh the size is 2x the + ! number of nodes. + allocate(nodeCoords(2*numNodes)) + nodeCoords=(/0.0,0.0, & ! node id 1 + 1.0,0.0, & ! node id 2 + 2.0,0.0, & ! node id 3 + 0.0,1.0, & ! node id 4 + 1.0,1.0, & ! node id 5 + 2.0,1.0, & ! node id 6 + 0.0,2.0, & ! node id 7 + 1.0,2.0, & ! node id 8 + 2.0,2.0 /) ! node id 9 + + ! Allocate and fill the node owner array. + ! Since this Mesh is all on PET 0, it's just set to all 0. + allocate(nodeOwners(numNodes)) + nodeOwners=0 ! everything on PET 0 + + ! Set the number of each type of element, plus the total number. + numQuadElems=3 + numTriElems=2 + numTotElems=numQuadElems+numTriElems + + ! Allocate and fill the element id array. + allocate(elemIds(numTotElems)) + elemIds=(/1,2,3,4,5/) + + ! Allocate and fill the element topology type array. + allocate(elemTypes(numTotElems)) + elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! elem id 1 + ESMF_MESHELEMTYPE_TRI, & ! elem id 2 + ESMF_MESHELEMTYPE_TRI, & ! elem id 3 + ESMF_MESHELEMTYPE_QUAD, & ! elem id 4 + ESMF_MESHELEMTYPE_QUAD/) ! elem id 5 + + + ! Allocate and fill the element connection type array. + ! Note that entries in this array refer to the + ! positions in the nodeIds, etc. arrays and that + ! the order and number of entries for each element + ! reflects that given in the Mesh options + ! section for the corresponding entry + ! in the elemTypes array. + allocate(elemConn(4*numQuadElems+3*numTriElems)) + elemConn=(/1,2,5,4, & ! elem id 1 + 2,3,5, & ! elem id 2 + 3,6,5, & ! elem id 3 + 4,5,8,7, & ! elem id 4 + 5,6,9,8/) ! elem id 5 + + ! Create Mesh structure in 1 step + srcMesh=ESMF_MeshCreate(parametricDim=2,spatialDim=2, & + coordSys=ESMF_COORDSYS_CART, & + nodeIds=nodeIds, nodeCoords=nodeCoords, & + nodeOwners=nodeOwners, elementIds=elemIds,& + elementTypes=elemTypes, elementConn=elemConn, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + ! Create source field + call ESMF_ArraySpecSet(arrayspec, 1, ESMF_TYPEKIND_R8, rc=rc) + + srcField = ESMF_FieldCreate(srcMesh, arrayspec, & + name="src", rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + ! Load test data into the source Field + ! Should only be 1 localDE + call ESMF_FieldGet(srcField, 0, fptr1D, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + ! Get number of local nodes to allocate space + ! to hold local node coords + call ESMF_MeshGet(srcMesh, numOwnedNodes=numOwnedNodes, & + rc=rc) + + ! Allocate space to hold local node coordinates + ! (spatial dimension of Mesh*number of local nodes) + allocate(ownedNodeCoords(2*numOwnedNodes)) + + ! Get local node coordinates + call ESMF_MeshGet(srcMesh, & + ownedNodeCoords=ownedNodeCoords, rc=rc) + + ! Set the source Field to the function 20.0+x+y + do i=1,numOwnedNodes + ! Get coordinates + x=ownedNodeCoords(2*i-1) + y=ownedNodeCoords(2*i) + + ! Set source function + fptr1D(i) = 20.0+x+y + enddo + + + ! deallocate node data + deallocate(nodeIds) + deallocate(nodeCoords) + deallocate(nodeOwners) + + ! deallocate elem data + deallocate(elemIds) + deallocate(elemTypes) + deallocate(elemConn) + + ! deallocate space to hold local node coordinates + deallocate(ownedNodeCoords) + + ! Add Field to State + call ESMF_StateAdd(exportState, (/srcField/), rc=rc) + if (rc .ne. ESMF_SUCCESS) return + ! call ESMF_StatePrint(exportState, rc=rc) + + end subroutine user_init + + +!------------------------------------------------------------------------- +! ! The Run routine where data is computed. +! ! + + subroutine user_run(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! Local variables + type(ESMF_Field) :: humidity + type(ESMF_grid) :: grid + real(ESMF_KIND_R8) :: pi + real(ESMF_KIND_R8), dimension(:,:), pointer :: idata, coordX, coordY + integer :: i, j, i1, j1 + + rc = ESMF_SUCCESS + print *, "User Comp Run starting" + + print *, "User Comp Run returning" + + end subroutine user_run + + +!------------------------------------------------------------------------- +! ! The Finalization routine where things are deleted and cleaned up. +! ! + + subroutine user_final(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! Local variables + type(ESMF_Field) :: srcField + type(ESMF_Mesh) :: srcMesh + + rc = ESMF_SUCCESS + print *, "User Comp Final starting" + + ! garbage collection + call ESMF_StateGet(exportState, "src", srcField, rc=rc) + if (rc .ne. ESMF_SUCCESS) return + call ESMF_FieldGet(srcField, mesh=srcMesh, rc=rc) + if (rc .ne. ESMF_SUCCESS) return + call ESMF_FieldDestroy(srcField, rc=rc) + if (rc .ne. ESMF_SUCCESS) return + call ESMF_MeshDestroy(srcMesh, rc=rc) + if (rc .ne. ESMF_SUCCESS) return + + print *, "User Comp Final returning" + + end subroutine user_final + + + end module user_model1 + +!\end{verbatim} + diff --git a/src/system_tests/ESMF_FieldRegridPatchDisjoint/user_model2.F90 b/src/system_tests/ESMF_FieldRegridPatchDisjoint/user_model2.F90 new file mode 100644 index 0000000000..a7a8e8a98b --- /dev/null +++ b/src/system_tests/ESMF_FieldRegridPatchDisjoint/user_model2.F90 @@ -0,0 +1,437 @@ +! $Id$ +! +! Example/test code which shows User Component calls. + +!-------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------- + +!BOP +! +! !DESCRIPTION: +! User-supplied Component +! +! +!\begin{verbatim} + + module user_model2 + + ! ESMF Framework module + use ESMF + + implicit none + + public userm2_register + + contains + +!-------------------------------------------------------------------------------- +! ! The Register routine sets the subroutines to be called +! ! as the init, run, and finalize routines. Note that these are +! ! private to the module. + + subroutine userm2_register(comp, rc) + type(ESMF_GridComp) :: comp + integer, intent(out) :: rc + + rc = ESMF_SUCCESS + print *, "In user register routine" + + ! Register the callback routines. + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, user_init, rc=rc) + if(rc/=ESMF_SUCCESS) return + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, user_run, rc=rc) + if(rc/=ESMF_SUCCESS) return + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, user_final, rc=rc) + if(rc/=ESMF_SUCCESS) return + + print *, "Registered Initialize, Run, and Finalize routines" + + end subroutine + +!-------------------------------------------------------------------------------- +! ! User Comp Component created by higher level calls, here is the +! ! Initialization routine. + + subroutine user_init(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + +! ! Local variables + type(ESMF_Field) :: dstField + type(ESMF_VM) :: vm + type(ESMF_Mesh) :: dstMesh + type(ESMF_ArraySpec) :: arrayspec + integer :: localPET, petCount,localrc + integer i + real(ESMF_KIND_R8), pointer :: fptr1D(:) + integer, pointer :: nodeIds(:),nodeOwners(:) + real(ESMF_KIND_R8), pointer :: nodeCoords(:) + integer, pointer :: elemIds(:),elemTypes(:),elemConn(:) + integer :: numNodes, numElems + integer :: numQuadElems,numTriElems, numTotElems + + ! Query component for VM and create a layout with the right breakdown + call ESMF_GridCompGet(comp, vm=vm, rc=rc) + if(rc/=ESMF_SUCCESS) return + call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=rc) + if(rc/=ESMF_SUCCESS) return + + ! Setup mesh data depending on PET + if (localPET .eq. 0) then !!! This part only for PET 0 + ! Set number of nodes + numNodes=4 + + ! Allocate and fill the node id array. + allocate(nodeIds(numNodes)) + nodeIds=(/1,2,4,5/) + + ! Allocate and fill node coordinate array. + ! Since this is a 2D Mesh the size is 2x the + ! number of nodes. + allocate(nodeCoords(2*numNodes)) + nodeCoords=(/0.0,0.0, & ! node id 1 + 1.0,0.0, & ! node id 2 + 0.0,1.0, & ! node id 4 + 1.0,1.0 /) ! node id 5 + + ! Allocate and fill the node owner array. + allocate(nodeOwners(numNodes)) + nodeOwners=(/0, & ! node id 1 + 0, & ! node id 2 + 0, & ! node id 4 + 0/) ! node id 5 + + ! Set the number of each type of element, plus the total number. + numQuadElems=1 + numTriElems=0 + numTotElems=numQuadElems+numTriElems + + ! Allocate and fill the element id array. + allocate(elemIds(numTotElems)) + elemIds=(/1/) + + ! Allocate and fill the element topology type array. + allocate(elemTypes(numTotElems)) + elemTypes=(/ESMF_MESHELEMTYPE_QUAD/) ! elem id 1 + + ! Allocate and fill the element connection type array. + ! Note that entry are local indices + allocate(elemConn(4*numQuadElems+3*numTriElems)) + elemConn=(/1,2,4,3/) ! elem id 1 + + else if (localPET .eq. 1) then !!! This part only for PET 1 + ! Set number of nodes + numNodes=4 + + ! Allocate and fill the node id array. + allocate(nodeIds(numNodes)) + nodeIds=(/2,3,5,6/) + + ! Allocate and fill node coordinate array. + ! Since this is a 2D Mesh the size is 2x the + ! number of nodes. + allocate(nodeCoords(2*numNodes)) + nodeCoords=(/1.0,0.0, & ! node id 2 + 2.0,0.0, & ! node id 3 + 1.0,1.0, & ! node id 5 + 2.0,1.0 /) ! node id 6 + + ! Allocate and fill the node owner array. + allocate(nodeOwners(numNodes)) + nodeOwners=(/0, & ! node id 2 + 1, & ! node id 3 + 0, & ! node id 5 + 1/) ! node id 6 + + ! Set the number of each type of element, plus the total number. + numQuadElems=0 + numTriElems=2 + numTotElems=numQuadElems+numTriElems + + ! Allocate and fill the element id array. + allocate(elemIds(numTotElems)) + elemIds=(/2,3/) + + ! Allocate and fill the element topology type array. + allocate(elemTypes(numTotElems)) + elemTypes=(/ESMF_MESHELEMTYPE_TRI, & ! elem id 2 + ESMF_MESHELEMTYPE_TRI/) ! elem id 3 + + ! Allocate and fill the element connection type array. + allocate(elemConn(4*numQuadElems+3*numTriElems)) + elemConn=(/1,2,3, & ! elem id 2 + 2,4,3/) ! elem id 3 + + else if (localPET .eq. 2) then !!! This part only for PET 2 + ! Set number of nodes + numNodes=4 + + ! Allocate and fill the node id array. + allocate(nodeIds(numNodes)) + nodeIds=(/4,5,7,8/) + + ! Allocate and fill node coordinate array. + ! Since this is a 2D Mesh the size is 2x the + ! number of nodes. + allocate(nodeCoords(2*numNodes)) + nodeCoords=(/0.0,1.0, & ! node id 4 + 1.0,1.0, & ! node id 5 + 0.0,2.0, & ! node id 7 + 1.0,2.0 /) ! node id 8 + + ! Allocate and fill the node owner array. + ! Since this Mesh is all on PET 0, it's just set to all 0. + allocate(nodeOwners(numNodes)) + nodeOwners=(/0, & ! node id 4 + 0, & ! node id 5 + 2, & ! node id 7 + 2/) ! node id 8 + + ! Set the number of each type of element, plus the total number. + numQuadElems=1 + numTriElems=0 + numTotElems=numQuadElems+numTriElems + + ! Allocate and fill the element id array. + allocate(elemIds(numTotElems)) + elemIds=(/4/) + + ! Allocate and fill the element topology type array. + allocate(elemTypes(numTotElems)) + elemTypes=(/ESMF_MESHELEMTYPE_QUAD/) ! elem id 4 + + ! Allocate and fill the element connection type array. + allocate(elemConn(4*numQuadElems+3*numTriElems)) + elemConn=(/1,2,4,3/) ! elem id 4 + + else if (localPET .eq. 3) then !!! This part only for PET 3 + ! Set number of nodes + numNodes=4 + + ! Allocate and fill the node id array. + allocate(nodeIds(numNodes)) + nodeIds=(/5,6,8,9/) + + ! Allocate and fill node coordinate array. + ! Since this is a 2D Mesh the size is 2x the + ! number of nodes. + allocate(nodeCoords(2*numNodes)) + nodeCoords=(/1.0,1.0, & ! node id 5 + 2.0,1.0, & ! node id 6 + 1.0,2.0, & ! node id 8 + 2.0,2.0 /) ! node id 9 + + ! Allocate and fill the node owner array. + allocate(nodeOwners(numNodes)) + nodeOwners=(/0, & ! node id 5 + 1, & ! node id 6 + 2, & ! node id 8 + 3/) ! node id 9 + + ! Set the number of each type of element, plus the total number. + numQuadElems=1 + numTriElems=0 + numTotElems=numQuadElems+numTriElems + + ! Allocate and fill the element id array. + allocate(elemIds(numTotElems)) + elemIds=(/5/) + + ! Allocate and fill the element topology type array. + allocate(elemTypes(numTotElems)) + elemTypes=(/ESMF_MESHELEMTYPE_QUAD/) ! elem id 5 + + ! Allocate and fill the element connection type array. + allocate(elemConn(4*numQuadElems+3*numTriElems)) + elemConn=(/1,2,4,3/) ! elem id 5 + endif + + + ! Create Mesh structure in 1 step + dstMesh=ESMF_MeshCreate(parametricDim=2,spatialDim=2, & + coordSys=ESMF_COORDSYS_CART, & + nodeIds=nodeIds, nodeCoords=nodeCoords, & + nodeOwners=nodeOwners, elementIds=elemIds,& + elementTypes=elemTypes, elementConn=elemConn, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + ! deallocate node data + deallocate(nodeIds) + deallocate(nodeCoords) + deallocate(nodeOwners) + + ! deallocate elem data + deallocate(elemIds) + deallocate(elemTypes) + deallocate(elemConn) + + + ! Create dest field + call ESMF_ArraySpecSet(arrayspec, 1, ESMF_TYPEKIND_R8, rc=rc) + + dstField = ESMF_FieldCreate(dstMesh, arrayspec, & + name="dst", rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + ! clear destination Field + ! Should only be 1 localDE + call ESMF_FieldGet(dstField, 0, fptr1D, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + fptr1D=0.0 + + ! Set Field Into State + call ESMF_StateAdd(importState, (/dstField/), rc=rc) + if (rc/=ESMF_SUCCESS) return + + ! Return success + rc = ESMF_SUCCESS + + end subroutine user_init + + +!-------------------------------------------------------------------------------- +! ! The Run routine where data is computed. +! ! + + subroutine user_run(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + +! ! Local variables + type(ESMF_Field) :: dstField + type(ESMF_Mesh) :: dstMesh + type(ESMF_VM) :: vm + integer :: localrc,i + integer :: localPet, petCount + real(ESMF_KIND_R8), pointer :: fptr1D(:) + real(ESMF_KIND_R8) :: x,y + integer :: numOwnedNodes + real(ESMF_KIND_R8), pointer :: ownedNodeCoords(:) + + rc = ESMF_SUCCESS + + ! Query component for VM and create a layout with the right breakdown + call ESMF_GridCompGet(comp, vm=vm, rc=rc) + if(rc/=ESMF_SUCCESS) return + call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=rc) + if(rc/=ESMF_SUCCESS) return + + ! Get information from the component. + call ESMF_StateGet(importState, "dst", dstField, rc=rc) + if(rc/=ESMF_SUCCESS) return + + + ! Get Grid from field + call ESMF_FieldGet(dstField, mesh=dstMesh, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + ! Check destination field + ! Should only be 1 localDE + call ESMF_FieldGet(dstField, 0, fptr1D, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + ! Get number of local nodes to allocate space + ! to hold local node coords + call ESMF_MeshGet(dstMesh, numOwnedNodes=numOwnedNodes, & + rc=rc) + + ! Allocate space to hold local node coordinates + ! (spatial dimension of Mesh*number of local nodes) + allocate(ownedNodeCoords(2*numOwnedNodes)) + + ! Get local node coordinates + call ESMF_MeshGet(dstMesh, & + ownedNodeCoords=ownedNodeCoords, rc=rc) + + + ! loop through nodes and make sure interpolated values are reasonable + do i=1,numOwnedNodes + ! Get coordinates + x=ownedNodeCoords(2*i-1) + y=ownedNodeCoords(2*i) + + !! if error is too big report an error + if ( abs( fptr1D(i)-(x+y+20.0) ) > 0.0001) then + rc=ESMF_FAILURE + return + endif + enddo + + ! deallocate space to hold local node coordinates + deallocate(ownedNodeCoords) + + ! RESET DESTINATION BACK TO 0 + fptr1D=0.0 + + ! Return success + rc = ESMF_SUCCESS + + end subroutine user_run + + +!-------------------------------------------------------------------------------- +! ! The Finalization routine where things are deleted and cleaned up. +! ! + + subroutine user_final(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! Local variables + type(ESMF_Field) :: dstField + type(ESMF_Mesh) :: dstMesh + + rc = ESMF_SUCCESS + print *, "User Comp Final starting" + + ! check validity of results + ! Get Fields from import state + call ESMF_StateGet(importState, "dst", dstField, rc=rc) + if(rc/=ESMF_SUCCESS) return + + ! garbage collection + call ESMF_FieldGet(dstField, mesh=dstMesh, rc=rc) + if (rc .ne. ESMF_SUCCESS) return + + call ESMF_FieldDestroy(dstField, rc=rc) + if (rc .ne. ESMF_SUCCESS) return + + call ESMF_MeshDestroy(dstMesh, rc=rc) + if (rc .ne. ESMF_SUCCESS) return + + print *, "User Comp Final returning" + + ! Return success + rc = ESMF_SUCCESS + end subroutine user_final + + + end module user_model2 + +!\end{verbatim} + diff --git a/src/system_tests/makefile b/src/system_tests/makefile index 569e7d4ba8..ed09c94a85 100644 --- a/src/system_tests/makefile +++ b/src/system_tests/makefile @@ -44,6 +44,7 @@ DIRS = ESMF_CompCreate \ ESMF_FieldRegridMesh \ ESMF_FieldRegridMeshToMesh \ ESMF_FieldRegridLS \ + ESMF_FieldRegridPatchDisjoint \ ESMF_FieldSparseMatMul \ ESMF_FieldSharedDeSSI \ ESMF_FieldLSRedistArb2Arb \