diff --git a/AtmOcnMirrorFieldsProto/atm.F90 b/AtmOcnMirrorFieldsProto/atm.F90 index 462652e..73ff534 100644 --- a/AtmOcnMirrorFieldsProto/atm.F90 +++ b/AtmOcnMirrorFieldsProto/atm.F90 @@ -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) @@ -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) diff --git a/AtmOcnMirrorFieldsProto/ocn.F90 b/AtmOcnMirrorFieldsProto/ocn.F90 index 96c3fed..f5a8a69 100644 --- a/AtmOcnMirrorFieldsProto/ocn.F90 +++ b/AtmOcnMirrorFieldsProto/ocn.F90 @@ -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, & diff --git a/ExternalDriverAPIWeakCplDAProto/atmDA.F90 b/ExternalDriverAPIWeakCplDAProto/atmDA.F90 index c0cb3d7..6b7f029 100644 --- a/ExternalDriverAPIWeakCplDAProto/atmDA.F90 +++ b/ExternalDriverAPIWeakCplDAProto/atmDA.F90 @@ -14,7 +14,6 @@ module atmDA ! ATM DA Code !----------------------------------------------------------------------------- - use MPI use ESMF use NUOPC @@ -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 @@ -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__, & diff --git a/ExternalDriverAPIWeakCplDAProto/externalApp.F90 b/ExternalDriverAPIWeakCplDAProto/externalApp.F90 index 46a11c4..94c2625 100644 --- a/ExternalDriverAPIWeakCplDAProto/externalApp.F90 +++ b/ExternalDriverAPIWeakCplDAProto/externalApp.F90 @@ -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 @@ -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) @@ -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 diff --git a/ExternalDriverAPIWeakCplDAProto/nuopc_da.F90 b/ExternalDriverAPIWeakCplDAProto/nuopc_da.F90 index 910ef35..0d333cc 100644 --- a/ExternalDriverAPIWeakCplDAProto/nuopc_da.F90 +++ b/ExternalDriverAPIWeakCplDAProto/nuopc_da.F90 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 diff --git a/ExternalDriverAPIWeakCplDAProto/ocnDA.F90 b/ExternalDriverAPIWeakCplDAProto/ocnDA.F90 index 23877e3..2d1ecbf 100644 --- a/ExternalDriverAPIWeakCplDAProto/ocnDA.F90 +++ b/ExternalDriverAPIWeakCplDAProto/ocnDA.F90 @@ -14,7 +14,6 @@ module ocnDA ! OCN DA Code !----------------------------------------------------------------------------- - use MPI use ESMF use NUOPC @@ -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 @@ -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__, &