From 8b5207459b9eb789944193ea7ffe328c1cadf2bb Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 25 May 2022 13:40:23 -0400 Subject: [PATCH 1/4] allow monotonic dynamic masking and update history kewords --- base/MAPL_EsmfRegridder.F90 | 61 +++++++++++++++++++- base/RegridMethods.F90 | 4 ++ gridcomps/History/MAPL_HistoryCollection.F90 | 2 +- gridcomps/History/MAPL_HistoryGridComp.F90 | 29 +++++++--- 4 files changed, 85 insertions(+), 11 deletions(-) diff --git a/base/MAPL_EsmfRegridder.F90 b/base/MAPL_EsmfRegridder.F90 index 9749a184acdc..8ebdab4767bb 100644 --- a/base/MAPL_EsmfRegridder.F90 +++ b/base/MAPL_EsmfRegridder.F90 @@ -83,8 +83,10 @@ logical function supports(spec, unusable, rc) supports = any(spec%regrid_method == & [ & REGRID_METHOD_BILINEAR, & + REGRID_METHOD_BILINEAR_MONOTONIC, & REGRID_METHOD_BILINEAR_ROTATE, & REGRID_METHOD_CONSERVE, & + REGRID_METHOD_CONSERVE_MONOTONIC, & REGRID_METHOD_VOTE, & REGRID_METHOD_FRACTION, & REGRID_METHOD_CONSERVE_2ND, & @@ -1172,7 +1174,56 @@ subroutine simpleDynMaskProcV(dynamicMaskList, dynamicSrcMaskValue, & rc = ESMF_SUCCESS end subroutine simpleDynMaskProcV + subroutine monotonicDynMaskProcV(dynamicMaskList, dynamicSrcMaskValue, & + dynamicDstMaskValue, rc) + type(ESMF_DynamicMaskElementR4R8R4V), pointer :: dynamicMaskList(:) + real(ESMF_KIND_R4), intent(in), optional :: dynamicSrcMaskValue + real(ESMF_KIND_R4), intent(in), optional :: dynamicDstMaskValue + integer, intent(out) :: rc + integer :: i, j, k, n + real(ESMF_KIND_R4), allocatable :: renorm(:),max_input(:),min_input(:) + + _UNUSED_DUMMY(dynamicDstMaskValue) + + if (associated(dynamicMaskList)) then + n = size(dynamicMaskList(1)%srcElement(1)%ptr) + allocate(renorm(n),max_input(n),min_input(n)) + do i=1, size(dynamicMaskList) + dynamicMaskList(i)%dstElement = 0.0 ! set to zero + + renorm = 0.d0 ! reset + max_input = -huge(0.0) + min_input = huge(0.0) + do j=1, size(dynamicMaskList(i)%factor) + do k = 1, size(dynamicMaskList(i)%srcElement(j)%ptr) + if (.not. & + match(dynamicSrcMaskValue,dynamicMaskList(i)%srcElement(j)%ptr(k))) then + dynamicMaskList(i)%dstElement(k) = dynamicMaskList(i)%dstElement(k) & + + dynamicMaskList(i)%factor(j) & + * dynamicMaskList(i)%srcElement(j)%ptr(k) + renorm(k) = renorm(k) + dynamicMaskList(i)%factor(j) + if (dynamicMaskList(i)%srcElement(j)%ptr(k) > max_input(k)) max_input(k) = dynamicMaskList(i)%srcElement(j)%ptr(k) + if (dynamicMaskList(i)%srcElement(j)%ptr(k) < min_input(k)) min_input(k) = dynamicMaskList(i)%srcElement(j)%ptr(k) + endif + end do + end do + where (renorm > 0.d0) + dynamicMaskList(i)%dstElement = dynamicMaskList(i)%dstElement / renorm + elsewhere + dynamicMaskList(i)%dstElement = dynamicSrcMaskValue + end where + where (renorm > 0.d0 .and. dynamicMaskList(i)%dstElement > max_input) + dynamicMaskList(i)%dstElement = max_input + end where + where (renorm > 0.d0 .and. dynamicMaskList(i)%dstElement < min_input) + dynamicMaskList(i)%dstElement = min_input + end where + enddo + endif + ! return successfully + rc = ESMF_SUCCESS + end subroutine monotonicDynMaskProcV logical function match(missing,b) @@ -1337,6 +1388,12 @@ subroutine initialize_subclass(this, unusable, rc) & dynamicMaskRoutine=simpleDynMaskProcV, & & rc=rc) _VERIFY(rc) + case (REGRID_METHOD_BILINEAR_MONOTONIC, REGRID_METHOD_CONSERVE_MONOTONIC) + call ESMF_DynamicMaskSetR4R8R4V(this%dynamic_mask, & + & dynamicSrcMaskValue=MAPL_undef, & + & dynamicMaskRoutine=monotonicDynMaskProcV, & + & rc=rc) + _VERIFY(rc) case (REGRID_METHOD_VOTE) call ESMF_DynamicMaskSetR4R8R4V(this%dynamic_mask, & & dynamicSrcMaskValue=MAPL_undef, & @@ -1435,7 +1492,7 @@ subroutine create_route_handle(this, kind, rc) if (.not.global) unmappedaction=ESMF_UNMAPPEDACTION_IGNORE end if select case (spec%regrid_method) - case (REGRID_METHOD_BILINEAR) + case (REGRID_METHOD_BILINEAR, REGRID_METHOD_BILINEAR_MONOTONIC) call ESMF_FieldRegridStore(src_field, dst_field, & & regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & @@ -1462,7 +1519,7 @@ subroutine create_route_handle(this, kind, rc) & factorList=factorList, factorIndexList=factorIndexList, & & routehandle=route_handle, unmappedaction=unmappedaction, rc=status) _VERIFY(status) - case (REGRID_METHOD_CONSERVE, REGRID_METHOD_VOTE, REGRID_METHOD_FRACTION) + case (REGRID_METHOD_CONSERVE, REGRID_METHOD_CONSERVE_MONOTONIC, REGRID_METHOD_VOTE, REGRID_METHOD_FRACTION) call ESMF_FieldRegridStore(src_field, dst_field, & & regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & & srcTermProcessing = srcTermProcessing, & diff --git a/base/RegridMethods.F90 b/base/RegridMethods.F90 index dfdc698a2c48..ba16f543c914 100644 --- a/base/RegridMethods.F90 +++ b/base/RegridMethods.F90 @@ -5,8 +5,10 @@ module mapl_RegridMethods public :: REGRID_HINT_LOCAL public :: REGRID_METHOD_IDENTITY public :: REGRID_METHOD_BILINEAR + public :: REGRID_METHOD_BILINEAR_MONOTONIC public :: REGRID_METHOD_BILINEAR_ROTATE public :: REGRID_METHOD_CONSERVE + public :: REGRID_METHOD_CONSERVE_MONOTONIC public :: REGRID_METHOD_VOTE public :: REGRID_METHOD_FRACTION public :: REGRID_METHOD_CONSERVE_2ND @@ -27,6 +29,8 @@ module mapl_RegridMethods enumerator :: REGRID_METHOD_PATCH enumerator :: REGRID_METHOD_NEAREST_STOD enumerator :: REGRID_METHOD_CONSERVE_HFLUX + enumerator :: REGRID_METHOD_BILINEAR_MONOTONIC + enumerator :: REGRID_METHOD_CONSERVE_MONOTONIC enumerator :: UNSPECIFIED_REGRID_METHOD = -1 end enum integer, parameter :: TILING_METHODS(3) = [REGRID_METHOD_CONSERVE,REGRID_METHOD_VOTE,REGRID_METHOD_FRACTION] diff --git a/gridcomps/History/MAPL_HistoryCollection.F90 b/gridcomps/History/MAPL_HistoryCollection.F90 index 1655a760a7b4..ae367ae7e1b2 100644 --- a/gridcomps/History/MAPL_HistoryCollection.F90 +++ b/gridcomps/History/MAPL_HistoryCollection.F90 @@ -70,7 +70,7 @@ module MAPL_HistoryCollectionMod real :: vscale character(len=ESMF_MAXSTR) :: vunit character(len=ESMF_MAXSTR) :: vvars(2) - integer :: conservative + integer :: regrid_method integer :: voting integer :: nbits integer :: deflate diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 08868fff6ad4..bb49d05a23b9 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -426,6 +426,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) character(len=ESMF_MAXSTR), allocatable :: regexList(:) type(StringStringMap) :: global_attributes character(len=ESMF_MAXSTR) :: name + logical :: has_conservative_keyword, has_regrid_keyword ! Begin !------ @@ -880,13 +881,25 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) call ESMF_ConfigGetAttribute ( cfg, list(n)%tm, default=tm_default, & label=trim(string) // 'tm:', rc=status ) _VERIFY(STATUS) - call ESMF_ConfigGetAttribute ( cfg, list(n)%conservative, default=0, & - label=trim(string) // 'conservative:' ,rc=status ) - _VERIFY(STATUS) - if (list(n)%conservative==0) then - list(n)%conservative=REGRID_METHOD_BILINEAR - else if (list(n)%conservative==1) then - list(n)%conservative=REGRID_METHOD_CONSERVE + + call ESMF_ConfigFindLabel ( cfg, label=trim(string) // 'conservative:',isPresent=has_conservative_keyword,_RC) + call ESMF_ConfigFindLabel ( cfg, label=trim(string) // 'regrid_method:',isPresent=has_regrid_keyword,_RC) + _ASSERT(has_conservative_keyword .and. has_regrid_keyword,trim(string)//" specified both conservative and regrid_method") + + if (has_conservative_keyword) then + call ESMF_ConfigGetAttribute ( cfg, list(n)%regrid_method, default=0, & + label=trim(string) // 'conservative:' ,rc=status ) + _VERIFY(STATUS) + if (list(n)%regrid_method==0) then + list(n)%regrid_method=REGRID_METHOD_BILINEAR + else if (list(n)%regrid_method==1) then + list(n)%regrid_method=REGRID_METHOD_CONSERVE + end if + end if + if (has_regrid_keyword) then + call ESMF_ConfigGetAttribute ( cfg, list(n)%regrid_method, default=REGRID_METHOD_BILINEAR, & + label=trim(string) // 'regrid_method:' ,rc=status ) + _VERIFY(STATUS) end if ! Get an optional file containing a 1-D track for the output @@ -2482,7 +2495,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) _VERIFY(status) call list(n)%mGriddedIO%set_param(nbits=list(n)%nbits,rc=status) _VERIFY(status) - call list(n)%mGriddedIO%set_param(regrid_method=list(n)%conservative,rc=status) + call list(n)%mGriddedIO%set_param(regrid_method=list(n)%regrid_method,rc=status) _VERIFY(status) call list(n)%mGriddedIO%set_param(itemOrder=intState%fileOrderAlphabetical,rc=status) _VERIFY(status) From 9ae0462bebb1038145ad88f80f681f20b6e720e4 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Thu, 26 May 2022 11:38:20 -0400 Subject: [PATCH 2/4] update to add "monotonic" option to regridding --- base/RegridMethods.F90 | 38 +++++++++++++++++++ gridcomps/ExtData2G/ExtDataConfig.F90 | 6 +-- .../ExtData2G/ExtDataOldTypesCreator.F90 | 13 ++----- gridcomps/History/MAPL_HistoryGridComp.F90 | 8 ++-- griddedio/Regrid_Util.F90 | 19 +--------- 5 files changed, 52 insertions(+), 32 deletions(-) diff --git a/base/RegridMethods.F90 b/base/RegridMethods.F90 index ba16f543c914..b8b809adc77a 100644 --- a/base/RegridMethods.F90 +++ b/base/RegridMethods.F90 @@ -1,4 +1,5 @@ module mapl_RegridMethods + use ESMF implicit none private @@ -17,6 +18,7 @@ module mapl_RegridMethods public :: REGRID_METHOD_CONSERVE_HFLUX public :: UNSPECIFIED_REGRID_METHOD public :: TILING_METHODS + public :: get_regrid_method enum, bind(c) enumerator :: REGRID_METHOD_IDENTITY @@ -36,5 +38,41 @@ module mapl_RegridMethods integer, parameter :: TILING_METHODS(3) = [REGRID_METHOD_CONSERVE,REGRID_METHOD_VOTE,REGRID_METHOD_FRACTION] integer, parameter :: REGRID_HINT_LOCAL = 1 + contains + + function get_regrid_method(string_regrid_method) result(int_regrid_method) + integer :: int_regrid_method + character(len=*), intent(in) :: string_regrid_method + + character(len=:), allocatable :: temp_str + temp_str = ESMF_UtilStringUpperCase(trim(string_regrid_method)) + + select case (temp_str) + case ("IDENTITY") + int_regrid_method = REGRID_METHOD_IDENTITY + case ("BILINEAR") + int_regrid_method = REGRID_METHOD_BILINEAR + case ("BILINEAR_ROTATE") + int_regrid_method = REGRID_METHOD_BILINEAR_ROTATE + case ("CONSERVE") + int_regrid_method = REGRID_METHOD_CONSERVE + case ("VOTE") + int_regrid_method = REGRID_METHOD_VOTE + case ("FRACTION") + int_regrid_method = REGRID_METHOD_FRACTION + case ("CONSERVE_2ND") + int_regrid_method = REGRID_METHOD_CONSERVE_2ND + case ("PATCH") + int_regrid_method = REGRID_METHOD_PATCH + case ("CONSERVE_HFLUX") + int_regrid_method = REGRID_METHOD_CONSERVE_HFLUX + case ("CONSERVE_MONOTONIC") + int_regrid_method = REGRID_METHOD_CONSERVE_MONOTONIC + case ("BILINEAR_MONOTONIC") + int_regrid_method = REGRID_METHOD_BILINEAR_MONOTONIC + case default + int_regrid_method = UNSPECIFIED_REGRID_METHOD + end select + end function end module mapl_RegridMethods diff --git a/gridcomps/ExtData2G/ExtDataConfig.F90 b/gridcomps/ExtData2G/ExtDataConfig.F90 index 14b8489eb16f..54f87021b213 100644 --- a/gridcomps/ExtData2G/ExtDataConfig.F90 +++ b/gridcomps/ExtData2G/ExtDataConfig.F90 @@ -344,14 +344,14 @@ subroutine add_new_rule(this,key,export_rule,multi_rule,rc) uname = key(1:semi_pos-1) vname = key(semi_pos+1:len_trim(key)) temp_rule => this%rule_map%at(trim(uname)) - _ASSERT(.not.associated(temp_rule),"duplicated export entry key") + _ASSERT(.not.associated(temp_rule),"duplicated export entry key: "//trim(key)) call this%rule_map%insert(trim(uname),ucomp) temp_rule => this%rule_map%at(trim(vname)) - _ASSERT(.not.associated(temp_rule),"duplicated export entry key") + _ASSERT(.not.associated(temp_rule),"duplicated export entry key: "//trim(key)) call this%rule_map%insert(trim(vname),vcomp) else temp_rule => this%rule_map%at(trim(key)) - _ASSERT(.not.associated(temp_rule),"duplicated export entry key") + _ASSERT(.not.associated(temp_rule),"duplicated export entry key: "//trim(key)) call this%rule_map%insert(trim(key),rule) end if _RETURN(_SUCCESS) diff --git a/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 index c8af31d007f8..305c93d6727c 100644 --- a/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 +++ b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 @@ -108,19 +108,14 @@ subroutine fillin_primary(this,item_name,base_name,primary_item,time,clock,unusa end if ! regrid method - if (trim(rule%regrid_method) == "BILINEAR") then - primary_item%trans = REGRID_METHOD_BILINEAR - else if (trim(rule%regrid_method) == "CONSERVE") then - primary_item%trans = REGRID_METHOD_CONSERVE - else if (trim(rule%regrid_method) == "VOTE") then - primary_item%trans = REGRID_METHOD_VOTE - else if (index(rule%regrid_method,"FRACTION;")>0) then + if (index(rule%regrid_method,"FRACTION;")>0) then semi_pos = index(rule%regrid_method,";") read(rule%regrid_method(semi_pos+1:),*) primary_item%fracVal primary_item%trans = REGRID_METHOD_FRACTION - else - _FAIL("Invalid regridding method") + else + primary_item%trans = get_regrid_method(rule%regrid_method) end if + _ASSERT(primary_item%trans/=UNSPECIFIED_REGRID_METHOD,"improper regrid method chosen") if (trim(time_sample%extrap_outside) =="clim") then primary_item%cycling=.true. diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index bb49d05a23b9..2076ddb621e0 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -425,7 +425,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) type(ESMF_Field), allocatable :: fldList(:) character(len=ESMF_MAXSTR), allocatable :: regexList(:) type(StringStringMap) :: global_attributes - character(len=ESMF_MAXSTR) :: name + character(len=ESMF_MAXSTR) :: name,regrid_method logical :: has_conservative_keyword, has_regrid_keyword ! Begin @@ -884,8 +884,9 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) call ESMF_ConfigFindLabel ( cfg, label=trim(string) // 'conservative:',isPresent=has_conservative_keyword,_RC) call ESMF_ConfigFindLabel ( cfg, label=trim(string) // 'regrid_method:',isPresent=has_regrid_keyword,_RC) - _ASSERT(has_conservative_keyword .and. has_regrid_keyword,trim(string)//" specified both conservative and regrid_method") + _ASSERT(.not.(has_conservative_keyword .and. has_regrid_keyword),trim(string)//" specified both conservative and regrid_method") + list(n)%regrid_method = REGRID_METHOD_BILINEAR if (has_conservative_keyword) then call ESMF_ConfigGetAttribute ( cfg, list(n)%regrid_method, default=0, & label=trim(string) // 'conservative:' ,rc=status ) @@ -897,9 +898,10 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) end if end if if (has_regrid_keyword) then - call ESMF_ConfigGetAttribute ( cfg, list(n)%regrid_method, default=REGRID_METHOD_BILINEAR, & + call ESMF_ConfigGetAttribute ( cfg, regrid_method, default="REGRID_METHOD_BILINEAR", & label=trim(string) // 'regrid_method:' ,rc=status ) _VERIFY(STATUS) + list(n)%regrid_method = get_regrid_method(trim(regrid_method)) end if ! Get an optional file containing a 1-D track for the output diff --git a/griddedio/Regrid_Util.F90 b/griddedio/Regrid_Util.F90 index b23a7f008765..574aa15058ba 100644 --- a/griddedio/Regrid_Util.F90 +++ b/griddedio/Regrid_Util.F90 @@ -182,23 +182,8 @@ subroutine process_command_line(this,rc) end select enddo - if (trim(regridMth) .ne. 'bilinear' .and. trim(regridMth ) .ne. 'conservative' .and. trim(regridMth ) .ne. 'conservative2' .and. & - trim(regridMth).ne.'patch') then - if (MAPL_AM_I_Root()) write(*,*)'invalid regrid method choose bilinear or conservative' - _FAIL('needs informative message') - end if - if (trim(regridMth) == 'bilinear') then - this%regridMethod = REGRID_METHOD_BILINEAR - end if - if (trim(regridMth) == 'patch') then - this%regridMethod = REGRID_METHOD_PATCH - end if - if (trim(regridMth) == 'conservative') then - this%regridMethod = REGRID_METHOD_CONSERVE - end if - if (trim(regridMth) == 'conservative2') then - this%regridMethod = REGRID_METHOD_CONSERVE_2ND - end if + this%regridMethod = get_regrid_method(regridMth) + _ASSERT(this%regridMethod/=UNSPECIFIED_REGRID_METHOD,"improper regrid method chosen") this%filenames = split_string(cfilenames,',') this%outputfiles = split_string(coutputfiles,',') From 4fb27228dd75da8a7bdfb56c46781d9561f9b55d Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Thu, 26 May 2022 11:44:04 -0400 Subject: [PATCH 3/4] update changelog --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 9a0e2990c095..04ad508563a9 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,6 +17,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Add debug loggers for start/stop during stages in MAPL_Generic - Handling for double precision input when retrieving single precision attributes - Enable GCM run test in CircleCI (1-hour, no ExtData) +- Added monotonic regridding option +- Make availalbe to History and ExtData2G all supported regridding methods ### Changed From 0569e4bfeb336ebcbcc7da2a8877328cbea9f0a8 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Thu, 26 May 2022 13:01:20 -0400 Subject: [PATCH 4/4] oops, forgot the most important part! --- base/MAPL_EsmfRegridder.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/base/MAPL_EsmfRegridder.F90 b/base/MAPL_EsmfRegridder.F90 index 8ebdab4767bb..519f216ef6f9 100644 --- a/base/MAPL_EsmfRegridder.F90 +++ b/base/MAPL_EsmfRegridder.F90 @@ -1392,6 +1392,7 @@ subroutine initialize_subclass(this, unusable, rc) call ESMF_DynamicMaskSetR4R8R4V(this%dynamic_mask, & & dynamicSrcMaskValue=MAPL_undef, & & dynamicMaskRoutine=monotonicDynMaskProcV, & + & handleAllElements=.true., & & rc=rc) _VERIFY(rc) case (REGRID_METHOD_VOTE)