Merge branch 'rljacob/mbcpl/fix-srof' into next (PR #7444)

rljacob · rljacob · commit 347235b48b46 · 2025-06-25T22:32:48.000-05:00
When rof_present is false, as in a case with SROF, be sure to zero out the river fluxes sent to the land model.
These tags are still present and acted on by the land model. Also only add them in ocean merge if rof_c2_ocn is true.

[BFB]
diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90
@@ -532,6 +532,9 @@ subroutine rof_final_mct( EClock, cdata_r, x2r_r, r2x_r)
     ! DESCRIPTION:
     ! Finalize rof surface model
     !
+#ifdef HAVE_MOAB
+    use seq_comm_mct,     only : mrofid ! id of moab rof app
+#endif
     ! ARGUMENTS:
     implicit none
     type(ESMF_Clock) , intent(inout) :: EClock    ! Input synchronization clock from driver
@@ -543,7 +546,9 @@ subroutine rof_final_mct( EClock, cdata_r, x2r_r, r2x_r)
    ! fill this in
 #ifdef HAVE_MOAB
     ! deallocate moab fields array
+    if (mrofid > 0) then
       deallocate (r2x_rm)
+    endif
 #endif
   end subroutine rof_final_mct
 
diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90
@@ -15,7 +15,7 @@ module cplcomp_exchange_mod
   use seq_flds_mod, only: seq_flds_x2o_fields ! needed for MOAB init of ocean fields x2o to be able to transfer from coupler
   use seq_flds_mod, only: seq_flds_i2x_fields, seq_flds_x2i_fields ! needed for MOAB init of ice fields x2o on coupler side, to save them
   use seq_flds_mod, only: seq_flds_l2x_fields, seq_flds_x2l_fields ! 
-  use seq_flds_mod, only: seq_flds_r2x_fields, seq_flds_x2r_fields !
+  use seq_flds_mod, only: seq_flds_r2x_fields, seq_flds_x2r_fields, seq_flds_r2x_fluxes
   use seq_comm_mct, only: cplid, logunit
   use seq_comm_mct, only: seq_comm_getinfo => seq_comm_setptrs, seq_comm_iamin
   use seq_diag_mct
@@ -1020,7 +1020,7 @@ subroutine cplcomp_moab_Init(infodata,comp)
       !-----------------------------------------------------
       !
       use iMOAB, only: iMOAB_RegisterApplication, iMOAB_ReceiveMesh, iMOAB_SendMesh, &
-      iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_GetMeshInfo, &
+      iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorage, &
       iMOAB_FreeSenderBuffers, iMOAB_ComputeCommGraph, iMOAB_LoadMesh
       !
       use seq_infodata_mod
@@ -1056,11 +1056,13 @@ subroutine cplcomp_moab_Init(infodata,comp)
       integer                  :: typeA, typeB, ATM_PHYS_CID ! used to compute par graph between atm phys
                                                             ! and atm spectral on coupler
       character(CXX)           :: tagname
+      character(CXX)           :: newlist
       integer                  nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3)
+      logical                  :: rof_present
       real(r8),    allocatable    :: tagValues(:) ! used for setting aream tags for atm domain read case
-      integer                     :: arrSize ! for the size of tagValues
-      ! type(mct_list)           :: temp_list
-      ! integer                  :: nfields, arrsize
+      integer                     :: arrsize ! for the size of tagValues
+      type(mct_list)             :: temp_list
+      integer                    :: nfields
       ! real(R8), allocatable, target :: values(:)
 
 
@@ -1497,6 +1499,7 @@ subroutine cplcomp_moab_Init(infodata,comp)
       if (comp%oneletterid == 'l'  .and. maxMLID /= -1) then
          call seq_comm_getinfo(cplid ,mpigrp=mpigrp_cplid)  ! receiver group
          call seq_comm_getinfo(id_old,mpigrp=mpigrp_old)   !  component group pes
+         call seq_infodata_GetData(infodata,rof_present=rof_present)
 
          ! use land full mesh 
          if (MPI_COMM_NULL /= mpicom_new ) then !  we are on the coupler pes
@@ -1550,6 +1553,26 @@ subroutine cplcomp_moab_Init(infodata,comp)
                call shr_sys_abort(subname//' ERROR in defining tags x2l on coupler land')
             endif        
 
+            if (.not.rof_present) then  ! need to zero out some Flrr fields
+               call shr_string_listIntersect(seq_flds_x2l_fields,seq_flds_r2x_fluxes,newlist)
+               call mct_list_init(temp_list, newlist)
+               nfields=mct_list_nitem (temp_list)
+               if (nfields > 0) then
+                 ierr  = iMOAB_GetMeshInfo ( mblxid, nvert, nvise, nbl, nsurf, nvisBC )
+                 arrsize = nvise(1)*nfields
+                 allocate(tagValues(arrsize))
+                 tagname = trim(newlist)//C_NULL_CHAR
+                 tagValues = 0.0_r8
+                 ent_type = 1 ! cells
+                 ierr = iMOAB_SetDoubleTagStorage ( mblxid, tagname, arrsize , ent_type, tagValues)
+                 if (ierr .ne. 0) then
+                    write(logunit,*) subname,' error in zeroing Flrr tags on land', ierr
+                    call shr_sys_abort(subname//' ERROR in zeroing Flrr tags land')
+                 endif
+               endif
+            endif
+
+
             !add the normalization tag
             tagname = trim(seq_flds_dom_fields)//":norm8wt"//C_NULL_CHAR
             ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco,  tagindex )
diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90
@@ -284,7 +284,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln
                mapper_Fr2l%tgt_mbid = mblxid
                mapper_Fr2l%src_context = rof(1)%cplcompid
                mapper_Fr2l%intx_context = lnd(1)%cplcompid
-            else
+            else  ! samegrid_lr is false. Bi-grid case
               if (compute_maps_online_r2l) then
                   ierr =  iMOAB_ComputeMeshIntersectionOnSphere( mbrxid, mblxid, mbintxrl )
                   if (ierr .ne. 0) then
@@ -318,7 +318,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln
                     write(logunit,*) subname,' error in computing comm graph for second hop, lnd-rof'
                     call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, lnd-rof')
                   endif
-              endif
+              endif ! (compute_maps_online_r2l)
               ! now take care of the mapper
               if ( mapper_Fr2l%src_mbid .gt. -1 ) then
                 if (iamroot_CPLID) then
@@ -334,8 +334,6 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln
               mapper_Fr2l%weight_identifier = wgtIdr2l
               mapper_Fr2l%mbname = 'mapper_Fr2l'
 
-              ! because we will project fields from rof to lnd grid, we need to define
-              !  the r2x fields to lnd grid on coupler side
               if (compute_maps_online_r2l) then
                   volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL;
                   dm1 = "fv"//C_NULL_CHAR
@@ -367,7 +365,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln
                     write(logunit,*) subname,' error in computing rl weights '
                     call shr_sys_abort(subname//' ERROR in computing rl weights ')
                   endif
-              else
+              else ! read maps
                   type1 = 3 ! this is type of grid, maybe should be saved on imoab app ?
                   call moab_map_init_rcfile( mbrxid, mblxid, mbintxrl, type1, &
                         'seq_maps.rc', 'rof2lnd_fmapname:', 'rof2lnd_fmaptype:',samegrid_lr, &
@@ -380,9 +378,11 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln
                      write(logunit,*) subname,' error in migrating rof mesh for map rof c2 lnd '
                      call shr_sys_abort(subname//' ERROR in migrating rof mesh for map rof c2 lnd')
                   endif
-              endif
+              endif ! compute or read mape
 
-            endif
+            endif ! samegrid_lr or not
+              ! because we will project fields from rof to lnd grid, we need to define
+              !  the r2x fields to lnd grid on coupler side
             tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR
             tagtype = 1 ! dense
             numco = 1 !
@@ -414,10 +414,10 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln
             endif
             deallocate (tmparray)
 
-         end if ! if ((mbrxid .ge. 0) .and.  (mblxid .ge. 0))
+         end if !((mbrxid .ge. 0) .and.  (mblxid .ge. 0))
 ! endif HAVE_MOAB
 #endif
-       end if
+       end if ! rof_c2_lnd
        call shr_sys_flush(logunit)
 
        if (atm_c2_lnd) then
diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90
@@ -140,6 +140,9 @@ module prep_ocn_mod
   integer        , target  :: x2oacc_om_cnt ! x2oacc_ox: number of time samples accumulated, in moab array
   integer                  :: arrSize_x2o_om !   this will be a module variable, size moabLocal_size * nof
 
+  ! flag that saves rof_c2_ocn value from init routine, to be used for merge routine
+  logical                  :: rof_c2_ocn_saved
+
   ! other module variables
   integer       :: mpicom_CPLID   ! MPI cpl communicator
   logical       :: iamroot_CPLID  ! .true. => CPLID masterproc
@@ -716,6 +719,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc
        endif ! if (ice_present)
        call shr_sys_flush(logunit)
 
+       rof_c2_ocn_saved = rof_c2_ocn  ! save the value, and use it for merge, later
        if (rof_c2_ocn) then
           if (iamroot_CPLID) then
              write(logunit,*) ' '
@@ -1341,8 +1345,10 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox)
       endif
        allocate(a2x_om (lsize, naflds))
        allocate(i2x_om (lsize, niflds))
-       allocate(r2x_om (lsize, nrflds))
-       r2x_om = 0._R8 ! should we zero out all of them ?
+       if (rof_c2_ocn_saved) then
+          allocate(r2x_om (lsize, nrflds))
+          r2x_om = 0._R8 ! should we zero out all of them ?
+       endif
        allocate(xao_om (lsize, nxflds))
        ! allocate fractions too
        ! use the fraclist fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad'
@@ -1745,13 +1751,14 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox)
       call shr_sys_abort(subname//' error in getting i2x_om array ')
     endif
 
-    tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR
-    arrsize = nrflds * lsize !        allocate (r2x_om (lsize, nrflds))
-    ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, r2x_om)
-    if (ierr .ne. 0) then
-      call shr_sys_abort(subname//' error in getting r2x_om array ')
+    if (rof_c2_ocn_saved) then
+      tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR
+      arrsize = nrflds * lsize !        allocate (r2x_om (lsize, nrflds))
+      ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, r2x_om)
+      if (ierr .ne. 0) then
+        call shr_sys_abort(subname//' error in getting r2x_om array ')
+      endif
     endif
-
     tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR
     arrsize = nxflds * lsize !        allocate (xao_om (lsize, nxflds))
     ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, arrsize , ent_type, xao_om)
@@ -1810,14 +1817,15 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox)
        x2o_om(n,index_x2o_Faxa_prec ) = x2o_om(n,index_x2o_Faxa_rain ) + &
             x2o_om(n,index_x2o_Faxa_snow )
 
-       x2o_om(n,index_x2o_Foxx_rofl) = (r2x_om(n,index_r2x_Forr_rofl ) + &
+       if (rof_c2_ocn_saved) then 
+         x2o_om(n,index_x2o_Foxx_rofl) = (r2x_om(n,index_r2x_Forr_rofl ) + &
             r2x_om(n,index_r2x_Flrr_flood) )
            ! g2x_om(n,index_g2x_Fogg_rofl )) * flux_epbalfact
-       x2o_om(n,index_x2o_Foxx_rofi) = (r2x_om(n,index_r2x_Forr_rofi ) ) * flux_epbalfact
+         x2o_om(n,index_x2o_Foxx_rofi) = (r2x_om(n,index_r2x_Forr_rofi ) ) * flux_epbalfact
           !  g2x_om(n,index_g2x_Fogg_rofi )) * flux_epbalfact
+       endif
 
-
-       if ( index_x2o_Foxx_rofl_16O /= 0 ) then
+       if ( index_x2o_Foxx_rofl_16O /= 0 .and. rof_c2_ocn_saved ) then
           x2o_om(n,index_x2o_Foxx_rofl_16O) = (r2x_om(n,index_r2x_Forr_rofl_16O) + &
                r2x_om(n,index_r2x_Flrr_flood) ) * flux_epbalfact
              !  g2x_om(n,index_g2x_Fogg_rofl )) * flux_epbalfact
