Skip to content

Commit

Permalink
Merge pull request #1469 from GEOS-ESM/feature/atrayano/#1455_4d_var_…
Browse files Browse the repository at this point in the history 
…coupler

Fixes #1455. Added support for 4d variables except in coupler's readR…
  • Loading branch information
@tclune
tclune authored Apr 6, 2022
2 parents 8b89e00 + ce43020 commit dc356b8
Show file tree
Hide file tree
Showing 2 changed files with 132 additions and 10 deletions.
1 change: 1 addition & 0 deletions CHANGELOG.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
141 changes: 131 additions & 10 deletions generic/GenericCplComp.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand All @@ -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)
Expand Down Expand Up @@ -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
Expand All @@ -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)
Expand Down Expand Up @@ -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
Expand All @@ -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)
Expand Down Expand Up @@ -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
Expand All @@ -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

Expand All @@ -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)
Expand Down

0 comments on commit dc356b8

Please sign in to comment.