Skip to content

Commit

Permalink
Merge branch 'work/reconcile-scaling' into develop
Browse files Browse the repository at this point in the history
  • Loading branch information
@theurich
theurich committed Nov 15, 2024
2 parents a6e7c07 + 83bc51d commit f3bc6c1
Show file tree
Hide file tree
Showing 6 changed files with 142 additions and 25 deletions.
10 changes: 8 additions & 2 deletions AtmOcnMirrorFieldsProto/atm.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -245,7 +245,13 @@ subroutine ModifyAdvertised(model, rc)
!TODO: settings, and go between components on different threading levels.
!TODO: This is an edge case, but long term it should be supported.

#if 0
!TODO: The problem in StateReconcile() comes from the UNIQUE_GEOM_INFO_TREAT_on
!TODO: handling. Once that part is reworked inside StateReconcile() the mixed
!TODO: sharing case should work again!

!TODO: For now share Grid and Field for both fields.

#if 1
! set SharePolicyGeomObject = "share"
call NUOPC_SetAttribute(field, name="SharePolicyGeomObject", &
value="share", rc=rc)
Expand All @@ -254,7 +260,7 @@ subroutine ModifyAdvertised(model, rc)
file=__FILE__)) &
return ! bail out
#endif
#if 0
#if 1
! set SharePolicyField = "share"
call NUOPC_SetAttribute(field, name="SharePolicyField", &
value="share", rc=rc)
Expand Down
1 change: 1 addition & 0 deletions AtmOcnMirrorFieldsProto/ocn.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -96,6 +96,7 @@ subroutine Advertise(model, rc)
StandardName="air_pressure_at_sea_level", name="pmsl", &
#ifdef TEST_SHARING
SharePolicyGeomObject="share", &
SharePolicyField="share", &
#endif
rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
Expand Down
8 changes: 4 additions & 4 deletions ExternalDriverAPIWeakCplDAProto/atmDA.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,6 @@ module atmDA
! ATM DA Code
!-----------------------------------------------------------------------------

use MPI
use ESMF
use NUOPC

Expand All @@ -32,8 +31,8 @@ module atmDA
contains
!-----------------------------------------------------------------------------

subroutine exec(comm)
integer :: comm
subroutine exec(vm)
type(ESMF_VM) :: vm ! context of this interaction

integer :: rc

Expand All @@ -44,7 +43,8 @@ subroutine exec(comm)
call ESMF_Finalize(endflag=ESMF_END_ABORT)

! Connect DA code with NUOPC system top component
call nuopc_da_connect(toNuopcTopStandardNames=(/"precipitation_flux"/), &
call nuopc_da_connect(vm=vm, &
toNuopcTopStandardNames=(/"precipitation_flux"/), &
fmNuopcTopStandardNames=(/"surface_net_downward_shortwave_flux"/), rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
Expand Down
37 changes: 31 additions & 6 deletions ExternalDriverAPIWeakCplDAProto/externalApp.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,8 +21,9 @@ program externalApp
use ESM, only: esmSS => SetServices

use nuopc_da, only: &
nuopc_da_init => init, &
nuopc_da_final => final
nuopc_da_init => init, &
nuopc_da_commToVM => commToVM, &
nuopc_da_final => final

use atmDA, only: atmDAexec => exec
use ocnDA, only: ocnDAexec => exec
Expand All @@ -31,7 +32,8 @@ program externalApp

integer :: rc
integer :: size, rank
integer :: splitComm
integer :: commAtmDA, commOcnDA, splitComm
type(ESMF_VM) :: vmAtmDA, vmOcnDA

! Initialize the NUOPC-DA interface
call nuopc_da_init(nuopcTopSetServices=esmSS, rc=rc)
Expand All @@ -41,17 +43,40 @@ program externalApp
call ESMF_Finalize(endflag=ESMF_END_ABORT)

! Split up the MPI_COMM_WORLD into atmDA (first half) and ocnDA (second half)
! of MPI ranks. Call into the respective DA routine
! of MPI ranks.
call MPI_Comm_size(MPI_COMM_WORLD, size, rc)
call MPI_Comm_rank(MPI_COMM_WORLD, rank, rc)
if (rank < size/2) then
! atm DA processes
call MPI_Comm_split(MPI_COMM_WORLD, 1, rank, splitComm, rc)
call atmDAexec(comm=splitComm)
commAtmDA = splitComm
commOcnDA = MPI_COMM_NULL
else
! ocn DA processes
call MPI_Comm_split(MPI_COMM_WORLD, 2, rank, splitComm, rc)
call ocnDAexec(comm=splitComm)
commOcnDA = splitComm
commAtmDA = MPI_COMM_NULL
endif

! Create corresponding ESMF_VM objects for atmDA and ocnDA
vmAtmDA = nuopc_da_commToVM(commAtmDA, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
vmOcnDA = nuopc_da_commToVM(commOcnDA, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)

! Call into the respective DA routine for ATM and OCN
if (rank < size/2) then
! atm DA processes
call atmDAexec(vmAtmDA)
else
! ocn DA processes
call ocnDAexec(vmOcnDA)
endif

! Finalize the NUOPC-DA interface
Expand Down
103 changes: 94 additions & 9 deletions ExternalDriverAPIWeakCplDAProto/nuopc_da.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,7 @@
module nuopc_da

!-----------------------------------------------------------------------------
! NUOPC - DA interface code
! NUOPC - DA interface code - this is generic code that could move into NUOPC
!-----------------------------------------------------------------------------

use MPI
Expand All @@ -21,12 +21,12 @@ module nuopc_da
implicit none

private

type(ESMF_GridComp) :: nuopcTop
type(ESMF_State) :: toNuopcTop, fmNuopcTop
type(ESMF_Clock) :: clock

public init, connect, step, final
public init, commToVM, connect, step, final

!-----------------------------------------------------------------------------
contains
Expand Down Expand Up @@ -116,10 +116,95 @@ recursive subroutine nuopcTopSetServices(gridcomp, rc)

!-----------------------------------------------------------------------------

subroutine connect(toNuopcTopStandardNames, fmNuopcTopStandardNames, rc)
character(*), intent(in), optional :: toNuopcTopStandardNames(:)
character(*), intent(in), optional :: fmNuopcTopStandardNames(:)
integer, intent(out) :: rc
function commToVM(comm, rc)
type(ESMF_VM) :: commToVM
integer, intent(in) :: comm ! MPI communicator
integer, intent(out) :: rc

type(ESMF_VM) :: vm
integer :: petCount, taskCount, temp_int(1)
integer :: i, j, urc
integer, allocatable :: temp_list(:), petList(:)
type(ESMF_GridComp) :: comp

call ESMF_VMGetCurrent(vm, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__, rcToReturn=rc)) return

call ESMF_VMGet(vm, petCount=petCount, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__, rcToReturn=rc)) return

temp_int(1) = 0 ! default indicate task is not in comm
if (comm /= MPI_COMM_NULL) temp_int(1) = 1 ! indicate task is in comm

allocate(temp_list(petCount))

call ESMF_VMAllGather(vm, temp_int, temp_list, 1, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__, rcToReturn=rc)) return

! determine number of tasks in comm
taskCount = 0
do i=1, petCount
if (temp_list(i)==1) taskCount = taskCount + 1
enddo

! construct petList
allocate(petList(taskCount))
j = 1
do i=1, petCount
if (temp_list(i)==1) then
petList(j) = i-1 ! PETs are basis 0
j = j+1
endif
enddo

deallocate(temp_list)

! create ESMF component on petList
comp = ESMF_GridCompCreate(petList=petList, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__, rcToReturn=rc)) return

deallocate(petList)

! call SetServices with a dummy routine to trigger internal VM creation
call ESMF_GridCompSetServices(comp, dummySS, userRc=urc, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) return
if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__, rcToReturn=rc)) return

! access the VM to be returned
call ESMF_GridCompGet(comp, vm=commToVM, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) return

contains

recursive subroutine dummySS(gridcomp, rc)
type(ESMF_GridComp) :: gridcomp ! must not be optional
integer, intent(out) :: rc ! must not be optional
rc = ESMF_SUCCESS
end subroutine

end function commToVM

!-----------------------------------------------------------------------------

subroutine connect(vm, toNuopcTopStandardNames, fmNuopcTopStandardNames, rc)
type(ESMF_VM), intent(in) :: vm
character(*), intent(in), optional :: toNuopcTopStandardNames(:)
character(*), intent(in), optional :: fmNuopcTopStandardNames(:)
integer, intent(out) :: rc

integer :: urc, phase, i
type(ESMF_Field) :: field
Expand All @@ -128,7 +213,7 @@ subroutine connect(toNuopcTopStandardNames, fmNuopcTopStandardNames, rc)
if (present(toNuopcTopStandardNames)) then
call NUOPC_Advertise(toNuopcTop, StandardNames=toNuopcTopStandardNames, &
TransferOfferGeomObject="cannot provide", SharePolicyField="share", &
rc=rc)
vm=vm, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__, rcToReturn=rc)) return
Expand All @@ -137,7 +222,7 @@ subroutine connect(toNuopcTopStandardNames, fmNuopcTopStandardNames, rc)
if (present(fmNuopcTopStandardNames)) then
call NUOPC_Advertise(fmNuopcTop, StandardNames=fmNuopcTopStandardNames, &
TransferOfferGeomObject="cannot provide", SharePolicyField="share", &
rc=rc)
vm=vm, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__, rcToReturn=rc)) return
Expand Down
8 changes: 4 additions & 4 deletions ExternalDriverAPIWeakCplDAProto/ocnDA.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,6 @@ module ocnDA
! OCN DA Code
!-----------------------------------------------------------------------------

use MPI
use ESMF
use NUOPC

Expand All @@ -32,8 +31,8 @@ module ocnDA
contains
!-----------------------------------------------------------------------------

subroutine exec(comm)
integer :: comm
subroutine exec(vm)
type(ESMF_VM) :: vm ! context of this interaction

integer :: rc

Expand All @@ -44,7 +43,8 @@ subroutine exec(comm)
call ESMF_Finalize(endflag=ESMF_END_ABORT)

! Connect DA code with NUOPC system top component
call nuopc_da_connect(fmNuopcTopStandardNames=(/"sea_surface_temperature"/), &
call nuopc_da_connect(vm=vm, &
fmNuopcTopStandardNames=(/"sea_surface_temperature"/), &
rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
Expand Down

0 comments on commit f3bc6c1

Please sign in to comment.