Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fixes #1455. Added support for 4d variables except in coupler's readR… #1469

Merged
merged 1 commit into from
Apr 6, 2022
Merged

Fixes #1455. Added support for 4d variables except in coupler's readR… #1469

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions CHANGELOG.md
View file
Open in desktop
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
Open in desktop
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