diff --git a/CHANGELOG.md b/CHANGELOG.md index 0cf88ab0c833..c830f20ef8d5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,6 +13,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Add missing `rc=status` in `MAPL_GetResourceFromMAPL_scalar` ### Added +- Added support for 4d variables in the coupler. Intentionally decided not to support 4d in the coupler's ReadRestart and WriteRestart to catch errors ### Changed diff --git a/generic/GenericCplComp.F90 b/generic/GenericCplComp.F90 index 180f75dc7959..e8d740541ecf 100644 --- a/generic/GenericCplComp.F90 +++ b/generic/GenericCplComp.F90 @@ -53,9 +53,10 @@ module MAPL_GenericCplCompMod !EOP type MAPL_CplCnt - integer, pointer :: PTR1C(:) => null() - integer, pointer :: PTR2C(:,:) => null() - integer, pointer :: PTR3C(:,:,:) => null() + integer, pointer :: PTR1C(:) => null() + integer, pointer :: PTR2C(:,:) => null() + integer, pointer :: PTR3C(:,:,:) => null() + integer, pointer :: PTR4C(:,:,:,:) => null() end type MAPL_CplCnt type MAPL_GenericCplState @@ -283,9 +284,11 @@ subroutine Initialize(CC, SRC, DST, CLOCK, RC) real, pointer :: PTR1 (: ) real, pointer :: PTR2 (:,: ) real, pointer :: PTR3 (:,:,:) + real, pointer :: PTR4 (:,:,:,:) real, pointer :: PTR10(: ) real, pointer :: PTR20(:,: ) real, pointer :: PTR30(:,:,:) + real, pointer :: PTR40(:,:,:,:) integer :: OFFSET integer, pointer :: ungrd(:) logical :: has_ungrd @@ -487,7 +490,7 @@ subroutine Initialize(CC, SRC, DST, CLOCK, RC) if (has_ungrd) then DIMS = DIMS + size(UNGRD) end if - _ASSERT(DIMS < 4,'needs informative message') ! ALT: due to laziness we are supporting only 3 dims + _ASSERT(DIMS < 5,'needs informative message') ! ALT: due to laziness we are supporting only 4 dims STATE%ACCUM_RANK(J) = DIMS @@ -508,6 +511,25 @@ subroutine Initialize(CC, SRC, DST, CLOCK, RC) select case(DIMS) + case(4) +! Get SRC pointer, making sure it is allocated. + call MAPL_GetPointer(SRC, PTR4, NAME, ALLOC=.TRUE., RC=STATUS) + _VERIFY(STATUS) +! Allocate space for accumulator + L1 = LBOUND(PTR4,3) + LN = UBOUND(PTR4,3) + allocate(PTR40(size(PTR4,1),size(PTR4,2),L1:LN,size(PTR4,4)), STAT=STATUS) + _VERIFY(STATUS) + if (STATE%couplerType(J) /= MAPL_CplAverage .and. STATE%couplerType(J) /= MAPL_CplAccumulate) then + PTR40 = MAPL_UNDEF + else +! Set accumulator values to zero + PTR40 = 0.0 + endif +! Put pointer in accumulator + STATE%ACCUMULATORS(J)=ESMF_LocalArrayCreate( PTR40, RC=STATUS) + _VERIFY(STATUS) + case(3) ! Get SRC pointer, making sure it is allocated. call MAPL_GetPointer(SRC, PTR3, NAME, ALLOC=.TRUE., RC=STATUS) @@ -657,19 +679,22 @@ subroutine ACCUMULATE(SRC, STATE, RC) ! local vars integer :: J - integer :: I1, I2, I3 + integer :: I1, I2, I3, I4 integer :: couplerType character (len=ESMF_MAXSTR) :: NAME integer :: DIMS real, pointer :: PTR1 (:) real, pointer :: PTR2 (:,:) real, pointer :: PTR3 (:,:,:) + real, pointer :: PTR4 (:,:,:,:) real, pointer :: PTR10(:) real, pointer :: PTR20(:,:) real, pointer :: PTR30(:,:,:) + real, pointer :: PTR40(:,:,:,:) integer, pointer :: PTR1c(:) => NULL() integer, pointer :: PTR2c(:,:) => NULL() integer, pointer :: PTR3c(:,:,:) => NULL() + integer, pointer :: PTR4c(:,:,:,:) => NULL() character(*), parameter :: IAm="ACCUMULATE" integer :: STATUS @@ -694,6 +719,53 @@ subroutine ACCUMULATE(SRC, STATE, RC) select case(DIMS) + case(4) + call MAPL_GetPointer (SRC, PTR4, NAME, RC=STATUS) + _VERIFY(STATUS) + call ESMF_LocalArrayGet(STATE%ACCUMULATORS(J),farrayPtr=PTR40,RC=STATUS) + _VERIFY(STATUS) + PTR4c => STATE%ARRAY_COUNT(J)%PTR4C + + if(.not.associated(PTR4C)) then + if( any( PTR4==MAPL_UNDEF ) ) then + allocate(PTR4C(size(PTR4,1), size(PTR4,2), size(PTR4,3), size(PTR4,4)),STAT=STATUS) + _VERIFY(STATUS) + PTR4C = STATE%ACCUM_COUNT(J) +! put it back into array + STATE%ARRAY_COUNT(J)%PTR4C => PTR4c + _VERIFY(STATUS) + end if + end if + + if (couplerType == MAPL_CplAverage .or. couplerType == MAPL_CplAccumulate) then + if(associated(PTR3C)) then + where (PTR4 /= MAPL_Undef) + PTR40 = PTR40 + PTR4 + PTR4c = PTR4c + 1 + end where + else + PTR40 = PTR40 + PTR4 + end if + else + DO I1=1,size(PTR4,1) + DO I2=1,size(PTR4,2) + DO I3=1,size(PTR4,3) + DO I4=1,size(PTR4,4) + if (PTR40(I1,I2,I3,I4)== MAPL_Undef) then + PTR40(I1,I2,I3,I4) = PTR4(I1,I2,I3,I4) + else + if (couplerType == MAPL_CplMax) then + PTR40(I1,I2,I3,I4) = max(PTR40(I1,I2,I3,I4),PTR4(I1,I2,I3,I4)) + else if (couplerType == MAPL_CplMin) then + PTR40(I1,I2,I3,I4) = min(PTR40(I1,I2,I3,I4),PTR4(I1,I2,I3,I4)) + end if + end if + end DO + end DO + end DO + end DO + end if + case(3) call MAPL_GetPointer (SRC, PTR3, NAME, RC=STATUS) _VERIFY(STATUS) @@ -849,12 +921,10 @@ subroutine ZERO_CLEAR_COUNT(STATE, RC) integer :: J integer :: DIMS logical :: RINGING - real, pointer :: PTR1 (:) - real, pointer :: PTR2 (:,:) - real, pointer :: PTR3 (:,:,:) real, pointer :: PTR10(:) real, pointer :: PTR20(:,:) real, pointer :: PTR30(:,:,:) + real, pointer :: PTR40(:,:,:) character(*), parameter :: IAm="ZERO_CLEAR_COUNT" integer :: STATUS @@ -872,11 +942,21 @@ subroutine ZERO_CLEAR_COUNT(STATE, RC) DIMS = STATE%ACCUM_RANK(J) -! Process the 3 dimension possibilities +! Process the 4 dimension possibilities !-------------------------------------- select case(DIMS) + case(4) + call ESMF_LocalArrayGet(STATE%ACCUMULATORS(J),farrayPtr=PTR40,RC=STATUS) + _VERIFY(STATUS) + if (STATE%couplerType(J) /= MAPL_CplAverage .and. STATE%couplerType(J) /= MAPL_CplAccumulate) then + PTR40 = MAPL_UNDEF + else + PTR40 = 0.0 + endif + if (associated(STATE%ARRAY_COUNT(J)%PTR4C)) STATE%ARRAY_COUNT(J)%PTR4C = 0 + case(3) call ESMF_LocalArrayGet(STATE%ACCUMULATORS(J),farrayPtr=PTR30,RC=STATUS) _VERIFY(STATUS) @@ -925,6 +1005,10 @@ subroutine ZERO_CLEAR_COUNT(STATE, RC) deallocate(STATE%ARRAY_COUNT(J)%PTR3C) nullify(STATE%ARRAY_COUNT(J)%PTR3C) end if + if (associated(STATE%ARRAY_COUNT(J)%PTR4C)) then + deallocate(STATE%ARRAY_COUNT(J)%PTR4C) + nullify(STATE%ARRAY_COUNT(J)%PTR4C) + end if end if end do @@ -946,12 +1030,15 @@ subroutine COUPLE(SRC, STATE, RC) real, pointer :: PTR1 (:) real, pointer :: PTR2 (:,:) real, pointer :: PTR3 (:,:,:) + real, pointer :: PTR4 (:,:,:,:) real, pointer :: PTR10(:) real, pointer :: PTR20(:,:) real, pointer :: PTR30(:,:,:) + real, pointer :: PTR40(:,:,:,:) integer, pointer :: PTR1c(:) integer, pointer :: PTR2c(:,:) integer, pointer :: PTR3c(:,:,:) + integer, pointer :: PTR4c(:,:,:,:) logical :: RINGING integer :: couplerType @@ -975,11 +1062,45 @@ subroutine COUPLE(SRC, STATE, RC) DIMS = STATE%ACCUM_RANK(J) -! Process the three dimension possibilities +! Process the four dimension possibilities !------------------------------------------ select case(DIMS) + case(4) + call ESMF_LocalArrayGet(STATE%ACCUMULATORS(J),farrayPtr=PTR40,RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer (DST, PTR4, NAME, RC=STATUS) + _VERIFY(STATUS) + PTR4c => STATE%ARRAY_COUNT(J)%PTR4C + if(associated(PTR4C)) then + if (couplerType /= MAPL_CplAccumulate) then + where (PTR4C /= 0) + PTR40 = PTR40 / PTR4C + elsewhere + PTR40 = MAPL_Undef + end where + else + where (PTR4C /= 0) + PTR40 = PTR40 + elsewhere + PTR40 = MAPL_Undef + end where + end if + elseif(STATE%ACCUM_COUNT(J)>0) then + if (couplerType /= MAPL_CplAccumulate) then + PTR40 = PTR40 / STATE%ACCUM_COUNT(J) + else + PTR40 = PTR40 + end if + else + PTR40 = MAPL_Undef + end if + +! Regrid stubbed + + PTR4 = PTR40 + case(3) call ESMF_LocalArrayGet(STATE%ACCUMULATORS(J),farrayPtr=PTR30,RC=STATUS) _VERIFY(STATUS)