Bucket change during integration (NOAA-EMC#835)

* set up fhour with multiple values

* updates for diag time

* add fixes for two bucket

* Update fhzero global attribute at runtime

* Update to speed uo writing restart files

* allow fhzero to be non-integer

* Move ESMF_InfoBroadcast call outside ESMF_VMEpochEnter/ESMF_VMEpochExit section to avoid hanging

---------

Co-authored-by: Jun.Wang <Jun.Wang@noaa.gov>
Co-authored-by: Dusan Javic <dusan.javic@noaa.gov>

atmos_model.F90

@@ -533,12 +533,12 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step)
   type (time_type), intent(in) :: Time_init, Time, Time_step
 !--- local variables ---
   integer :: unit, i
-  integer :: mlon, mlat, nlon, nlat, nlev, sec
+  integer :: mlon, mlat, nlon, nlat, nlev, sec, sec_lastfhzerofh
   integer :: ierr, io, logunit
   integer :: tile_num
   integer :: isc, iec, jsc, jec
   real(kind=GFS_kind_phys) :: dt_phys
-  logical              :: p_hydro, hydro
+  logical              :: p_hydro, hydro, tmpflag_fhzero
   logical, save        :: block_message = .true.
   type(GFS_init_type)  :: Init_parm
   integer              :: bdat(8), cdat(8)
@@ -789,8 +789,33 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step)
    !--- WARNING: For special cases that model needs to restart at non-multiple of fhzero
    !--- the fields in first output files are not accumulated from the beginning of
    !--- the bucket, but the restart time.
-   if (mod(sec,int(GFS_Control%fhzero*3600.)) /= 0) then
-     diag_time = Time - real_to_time_type(mod(int((GFS_Control%kdt - 1)*dt_phys/3600.),int(GFS_Control%fhzero))*3600.0)
+   if( GFS_Control%fhzero_array(1) > 0. ) then
+     fhzero_loop: do i=1,size(GFS_Control%fhzero_array)
+       tmpflag_fhzero= .false.
+       if( GFS_Control%fhzero_array(i) > 0.) then
+         if( i == 1 ) then
+           if( sec <= GFS_Control%fhzero_fhour(i)*3600. ) tmpflag_fhzero = .true.
+         else if( i > 1 ) then
+           if( sec > GFS_Control%fhzero_fhour(i-1)*3600. .and. sec <=GFS_Control%fhzero_fhour(i)*3600. ) &
+             tmpflag_fhzero = .true.
+         endif
+         if( tmpflag_fhzero ) then
+           GFS_Control%fhzero = GFS_Control%fhzero_array(i)
+           if( GFS_Control%fhzero > 0) then
+             sec_lastfhzerofh = (int(sec/3600.)/int(GFS_Control%fhzero))*int(GFS_Control%fhzero)*3600
+           else
+             sec_lastfhzerofh = 0
+           endif
+         endif
+       endif
+     enddo fhzero_loop
+   else
+     sec_lastfhzerofh = 0
+   endif
+   if (mpp_pe() == mpp_root_pe()) print *,'in atmos_model, fhzero=',GFS_Control%fhzero, 'fhour=',sec/3600.,sec_lastfhzerofh/3600
+
+   if (mod((sec-sec_lastfhzerofh),int(GFS_Control%fhzero*3600.)) /= 0) then
+     diag_time = Time - real_to_time_type(mod(int((GFS_Control%kdt - 1)*dt_phys-sec_lastfhzerofh),int(GFS_Control%fhzero))*3600.0)
      if (mpp_pe() == mpp_root_pe()) print *,'Warning: in atmos_init,start at non multiple of fhzero'
    endif
    if (Atmos%iau_offset > zero) then
@@ -949,8 +974,9 @@ subroutine update_atmos_model_state (Atmos, rc)
   type (atmos_data_type), intent(inout) :: Atmos
   integer, optional,      intent(out)   :: rc
 !--- local variables
-  integer :: localrc
+  integer :: i, localrc, sec_lastfhzerofh
   integer :: isec, seconds, isec_fhzero
+  logical :: tmpflag_fhzero
   real(kind=GFS_kind_phys) :: time_int, time_intfull
 !
     if (present(rc)) rc = ESMF_SUCCESS
@@ -1001,16 +1027,38 @@ subroutine update_atmos_model_state (Atmos, rc)
                             GFS_control%levs, 1, 1, 1.0_GFS_kind_phys, time_int, time_intfull, &
                             GFS_control%fhswr, GFS_control%fhlwr)
     endif
-    if (nint(GFS_control%fhzero) > 0) then
-      if (mod(isec,3600*nint(GFS_control%fhzero)) == 0) diag_time = Atmos%Time
+
+    !---  find current fhzero
+    if( GFS_Control%fhzero_array(1) > 0. ) then
+      fhzero_loop: do i=1,size(GFS_Control%fhzero_array)
+        tmpflag_fhzero = .false.
+        if( GFS_Control%fhzero_array(i) > 0.) then
+          if( i == 1 ) then
+            if( seconds <= GFS_Control%fhzero_fhour(i)*3600. ) tmpflag_fhzero = .true.
+          else if( i > 1 ) then
+            if( seconds > GFS_Control%fhzero_fhour(i-1)*3600. .and. seconds <= GFS_Control%fhzero_fhour(i)*3600. ) &
+              tmpflag_fhzero = .true.
+          endif
+          if( tmpflag_fhzero) then
+            GFS_Control%fhzero = GFS_Control%fhzero_array(i)
+            if( GFS_Control%fhzero > 0) then
+              sec_lastfhzerofh = (int(seconds/3600.)/int(GFS_Control%fhzero))*int(GFS_Control%fhzero)*3600
+            else
+              sec_lastfhzerofh = 0
+            endif
+          endif
+        endif
+      enddo fhzero_loop
     else
-      if (mod(isec,nint(3600*GFS_control%fhzero)) == 0) diag_time = Atmos%Time
+      sec_lastfhzerofh = 0
     endif
-    call diag_send_complete_instant (Atmos%Time)
+    if (mpp_pe() == mpp_root_pe()) print *,'in atmos_model update, fhzero=',GFS_Control%fhzero, 'fhour=',seconds/3600.,sec_lastfhzerofh/3600.
 
-
-    !--- this may not be necessary once write_component is fully implemented
-    !!!call diag_send_complete_extra (Atmos%Time)
+    if (nint(GFS_Control%fhzero) > 0) then
+      if (mod(isec - sec_lastfhzerofh,nint(GFS_Control%fhzero*3600.)) == 0) diag_time = Atmos%Time
+!    if (mpp_pe() == mpp_root_pe()) print *,'in atmos_model update time=',isec/3600.,'last fhzeo=',sec_lastfhzerofh
+    endif
+    call diag_send_complete_instant (Atmos%Time)
 
     !--- get bottom layer data from dynamical core for coupling
     call atmosphere_get_bottom_layer (Atm_block, DYCORE_Data)

ccpp/data/GFS_typedefs.F90

@@ -710,7 +710,9 @@ module GFS_typedefs
                                                                         !< for use with internal file reads
     integer              :: input_nml_file_length    !< length (number of lines) in namelist for internal reads
     integer              :: logunit
-    real(kind=kind_phys) :: fhzero          !< hours between clearing of diagnostic buckets
+    real(kind=kind_phys) :: fhzero          !< hours between clearing of diagnostic buckets (current bucket)
+    real(kind=kind_phys) :: fhzero_array(2) !< array to hold the the hours between clearing of diagnostic buckets
+    real(kind=kind_phys) :: fhzero_fhour(2) !< the maximum forecast length for the hours between clearing of diagnostic buckets
     logical              :: ldiag3d         !< flag for 3d diagnostic fields
     logical              :: qdiag3d         !< flag for 3d tracer diagnostic fields
     logical              :: flag_for_gwd_generic_tend  !< true if GFS_GWD_generic should calculate tendencies
@@ -3327,6 +3329,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
 
 !--- BEGIN NAMELIST VARIABLES
     real(kind=kind_phys) :: fhzero         = 0.0             !< hours between clearing of diagnostic buckets
+    real(kind=kind_phys) :: fhzero_array(1:2)  = 0.0         !< array with hours between clearing of diagnostic buckets
+    real(kind=kind_phys) :: fhzero_fhour(1:2)  = 0.0         !< the maximum forecast length for the hours between clearing of diagnostic buckets
     logical              :: ldiag3d        = .false.         !< flag for 3d diagnostic fields
     logical              :: qdiag3d        = .false.         !< flag for 3d tracer diagnostic fields
     logical              :: lssav          = .false.         !< logical flag for storing diagnostics
@@ -3983,9 +3987,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
 
     NAMELIST /gfs_physics_nml/                                                              &
                           !--- general parameters
-                               fhzero, ldiag3d, qdiag3d, lssav, naux2d, dtend_select,       &
-                               naux3d, aux2d_time_avg, aux3d_time_avg, fhcyc,               &
-                               thermodyn_id, sfcpress_id,                                   &
+                               fhzero, fhzero_array, fhzero_fhour, ldiag3d, qdiag3d, lssav, &
+                               naux2d, dtend_select, naux3d, aux2d_time_avg,                &
+                               aux3d_time_avg, fhcyc, thermodyn_id, sfcpress_id,            &
                           !--- coupling parameters
                                cplflx, cplice, cplocn2atm, cplwav, cplwav2atm, cplaqm,      &
                                cplchm, cpllnd, cpllnd2atm, cpl_imp_mrg, cpl_imp_dbg,        &
@@ -4196,6 +4200,11 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
     Model%fn_nml           = fn_nml
     Model%logunit          = logunit
     Model%fhzero           = fhzero
+    Model%fhzero_array     = fhzero_array
+    Model%fhzero_fhour     = fhzero_fhour
+    if( Model%fhzero_array(1) > 0. ) then
+      Model%fhzero = Model%fhzero_array(1)
+    endif
     Model%ldiag3d          = ldiag3d
     Model%qdiag3d          = qdiag3d
     if (qdiag3d .and. .not. ldiag3d) then
@@ -5621,6 +5630,10 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
     Model%restart          = restart
     Model%lsm_cold_start   = .not. restart
     Model%hydrostatic      = hydrostatic
+    if (Model%me == Model%master) then
+      print *,'in atm phys init, phour=',Model%phour,'fhour=',Model%fhour,'zhour=',Model%zhour,'kdt=',Model%kdt
+    endif
+
 
     if(Model%hydrostatic .and. Model%lightning_threat) then
       write(0,*) 'Turning off lightning threat index for hydrostatic run.'
@@ -6414,6 +6427,8 @@ subroutine control_print(Model)
       print *, ' nlunit            : ', Model%nlunit
       print *, ' fn_nml            : ', trim(Model%fn_nml)
       print *, ' fhzero            : ', Model%fhzero
+      print *, ' fhzero_array      : ', Model%fhzero_array
+      print *, ' fhzero_fhour      : ', Model%fhzero_fhour
       print *, ' ldiag3d           : ', Model%ldiag3d
       print *, ' qdiag3d           : ', Model%qdiag3d
       print *, ' lssav             : ', Model%lssav

fv3_cap.F90

@@ -1114,6 +1114,8 @@ subroutine ModelAdvance_phase2(gcomp, rc)
 
     real(kind=8)                :: MPI_Wtime, timep2rs
 
+    character(len=ESMF_MAXSTR)  :: fb_name
+    type(ESMF_Info)             :: info
 !-----------------------------------------------------------------------------
 
     rc = ESMF_SUCCESS
@@ -1182,6 +1184,21 @@ subroutine ModelAdvance_phase2(gcomp, rc)
 
         call ESMF_TraceRegionExit("ESMF_VMEpoch:fcstFB->wrtFB", rc=rc)
 
+        do j=1, FBCount
+
+          ! Update fcstFB attributes from fcst PEs to all PEs in this VM
+          ! This is needed in case some attributes are updated during run time
+          call ESMF_FieldBundleGet(fcstFB(j), name=fb_name, rc=rc)
+          if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
+          if (fb_name(1:8) /= "restart_") then
+            call ESMF_InfoGetFromHost(fcstFB(j), info=info, rc=rc)
+            if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
+            call ESMF_InfoBroadcast(info, rootPet=fcstPetList(1), rc=rc)
+            if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
+          endif
+
+        enddo
+
         call ESMF_LogWrite('Model Advance: before wrtcomp run ', ESMF_LOGMSG_INFO, rc=rc)
         if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
 

io/fv3atm_history_io.F90

@@ -50,7 +50,8 @@ module fv3atm_history_io_mod
     integer :: tot_diag_idx = 0
 
     integer :: isco=0,ieco=0,jsco=0,jeco=0,num_axes_phys=0
-    integer :: fhzero=0, ncld=0, nsoil=0, nsoil_lsm=0, imp_physics=0, landsfcmdl=0
+    integer :: ncld=0, nsoil=0, nsoil_lsm=0, imp_physics=0, landsfcmdl=0
+    real(4) :: fhzero=0.
     real(4) :: dtp=0
     integer,dimension(:),        pointer         :: levo => null()
     integer,dimension(:),        pointer         :: nstt => null()
@@ -183,7 +184,7 @@ subroutine history_type_register(hist, Diag, Time, Atm_block, Model, xlon, xlat,
     hist%ieco   = Atm_block%iec
     hist%jsco   = Atm_block%jsc
     hist%jeco   = Atm_block%jec
-    hist%fhzero = nint(Model%fhzero)
+    hist%fhzero = Model%fhzero
     !   hist%ncld   = Model%ncld
     hist%ncld   = Model%imp_physics
     hist%nsoil  = Model%lsoil

io/module_write_internal_state.F90

@@ -93,7 +93,7 @@ module write_internal_state
       logical                  :: write_dopost !< True if inline post is requested.
       character(80)            :: post_namelist !< File name of the inline post namelist.
 !
-      integer                  :: fhzero !< Hours between clearing of diagnostic buckets.
+      real(4)                  :: fhzero !< Hours between clearing of diagnostic buckets.
       integer                  :: ntrac !< Number of tracers.
       integer                  :: ncld !< Number of hydrometeors.
       integer                  :: nsoil !< Number of soil layers.