FV3: this commits #refs 56863: Updating one of the advanced physics s…

…uite for physics testing

atmos_cubed_sphere/model/fv_arrays.F90

@@ -602,7 +602,11 @@ module fv_arrays_mod
                             !< produces a good first guess by examining the resolution, 
                             !< dt_atmos, and k_split.
 
-   integer :: m_split = 0    ! Number of time splits for Riemann solver
+   real    :: fac_n_spl = 1.0 !< factor multiplying n_split up tp forecast hour fhouri
+   real    :: fhouri    = 0.0 !< forecast hour up to which the number of small dynamics (acoustic) time steps
+                              !< are nint(n_split*fac_n_spl)
+
+   integer :: m_split = 0   !< Number of time splits for Riemann solver
    integer :: k_split = 1   !< Number of vertical remappings per dt_atmos (physics timestep).
                             !< 1 by default.
 
@@ -1426,12 +1430,12 @@ subroutine allocate_fv_atmos_type(Atm, isd_in, ied_in, jsd_in, jed_in, is_in, ie
     Atm%bd%ng  = ng
 
     !Convenience pointers
-    Atm%npx => Atm%flagstruct%npx
-    Atm%npy => Atm%flagstruct%npy
-    Atm%npz => Atm%flagstruct%npz
+    Atm%npx   => Atm%flagstruct%npx
+    Atm%npy   => Atm%flagstruct%npy
+    Atm%npz   => Atm%flagstruct%npz
     Atm%ncnst => Atm%flagstruct%ncnst
 
-    Atm%ng => Atm%bd%ng
+    Atm%ng    => Atm%bd%ng
 
 !!$    Atm%npx = npx_in
 !!$    Atm%npy = npy_in

atmos_cubed_sphere/model/fv_control.F90

@@ -221,6 +221,9 @@ module fv_control_mod
    real    , pointer :: p_fac
    real    , pointer :: a_imp
    integer , pointer :: n_split 
+
+   real    , pointer :: fac_n_spl
+   real    , pointer :: fhouri
                              ! Default 
    integer , pointer :: m_split 
    integer , pointer :: k_split 
@@ -433,8 +436,8 @@ subroutine fv_init(Atm, dt_atmos, grids_on_this_pe, p_split)
             endif
 
             !!CLEANUP: Convenience pointers
-            Atm(n)%gridstruct%nested    => Atm(n)%neststruct%nested
-            Atm(n)%gridstruct%grid_type => Atm(n)%flagstruct%grid_type
+            Atm(n)%gridstruct%nested      => Atm(n)%neststruct%nested
+            Atm(n)%gridstruct%grid_type   => Atm(n)%flagstruct%grid_type
             Atm(n)%flagstruct%grid_number => Atm(n)%grid_number
             Atm(n)%gridstruct%regional  => Atm(n)%flagstruct%regional
 
@@ -658,7 +661,7 @@ subroutine run_setup(Atm, dt_atmos, grids_on_this_pe, p_split)
                          nested, twowaynest, parent_grid_num, parent_tile, nudge_qv, &
                          refinement, nestbctype, nestupdate, nsponge, s_weight, &
                          ioffset, joffset, check_negative, nudge_ic, halo_update_type, gfs_phil, agrid_vel_rst,     &
-                         do_uni_zfull, adj_mass_vmr, regional, bc_update_interval
+                         do_uni_zfull, adj_mass_vmr, fac_n_spl, fhouri, regional, bc_update_interval
 
    namelist /test_case_nml/test_case, bubble_do, alpha, nsolitons, soliton_Umax, soliton_size
 
@@ -749,14 +752,14 @@ subroutine run_setup(Atm, dt_atmos, grids_on_this_pe, p_split)
       if (.not. (nested .or. regional)) Atm(n)%neststruct%npx_global = npx
 
       ! Define n_split if not in namelist
-      if (ntiles==6) then
+      if (ntiles == 6) then
          dimx = 4.0*(npx-1)
          if ( hydrostatic ) then
             if ( npx >= 120 ) ns0 = 6
          else
             if ( npx <= 45 ) then
                ns0 = 6
-            elseif ( npx <=90 ) then
+            elseif ( npx <= 90 ) then
                ns0 = 7
             else
                ns0 = 8
@@ -1189,6 +1192,8 @@ subroutine setup_pointers(Atm)
      p_fac                         => Atm%flagstruct%p_fac
      a_imp                         => Atm%flagstruct%a_imp
      n_split                       => Atm%flagstruct%n_split
+     fac_n_spl                     => Atm%flagstruct%fac_n_spl
+     fhouri                        => Atm%flagstruct%fhouri
      m_split                       => Atm%flagstruct%m_split
      k_split                       => Atm%flagstruct%k_split
      use_logp                      => Atm%flagstruct%use_logp

atmos_cubed_sphere/model/fv_dynamics.F90

@@ -91,6 +91,10 @@ module fv_dynamics_mod
 !     <td>neg_adj3</td>
 !   </tr>
 !   <tr>
+!     <td>fv_sg_mod</td>
+!     <td>neg_adj2</td>
+!   </tr>
+!   <tr>
 !     <td>fv_timing_mod</td>
 !     <td>timing_on, timing_off</td>
 !   </tr>
@@ -132,7 +136,7 @@ module fv_dynamics_mod
    use mpp_mod,             only: mpp_pe
    use field_manager_mod,   only: MODEL_ATMOS
    use tracer_manager_mod,  only: get_tracer_index
-   use fv_sg_mod,           only: neg_adj3
+   use fv_sg_mod,           only: neg_adj3, neg_adj2
    use fv_nesting_mod,      only: setup_nested_grid_BCs
    use fv_regional_mod,     only: regional_boundary_update, set_regional_BCs
    use fv_regional_mod,     only: dump_field, H_STAGGER, U_STAGGER, V_STAGGER
@@ -754,6 +758,38 @@ subroutine fv_dynamics(npx, npy, npz, nq_tot,  ng, bdt, consv_te, fill,
      endif
   endif
 
+  if( nwat == 5 ) then
+     if (cld_amt > 0) then
+      call neg_adj2(is, ie, js, je, ng, npz,        &
+                    flagstruct%hydrostatic,         &
+                    peln, delz,                     &
+                    pt, delp, q(isd,jsd,1,sphum),   &
+                              q(isd,jsd,1,liq_wat), &
+                              q(isd,jsd,1,rainwat), &
+                              q(isd,jsd,1,ice_wat), &
+                              q(isd,jsd,1,snowwat), &
+                              q(isd,jsd,1,cld_amt), flagstruct%check_negative)
+     else
+        call neg_adj2(is, ie, js, je, ng, npz,        &
+                      flagstruct%hydrostatic,         &
+                      peln, delz,                     &
+                      pt, delp, q(isd,jsd,1,sphum),   &
+                                q(isd,jsd,1,liq_wat), &
+                                q(isd,jsd,1,rainwat), &
+                                q(isd,jsd,1,ice_wat), &
+                                q(isd,jsd,1,snowwat), &
+                                check_negative=flagstruct%check_negative)
+     endif
+     if ( flagstruct%fv_debug ) then
+       call prt_mxm('T_dyn_a3',    pt, is, ie, js, je, ng, npz, 1., gridstruct%area_64, domain)
+       call prt_mxm('SPHUM_dyn',   q(isd,jsd,1,sphum  ), is, ie, js, je, ng, npz, 1.,gridstruct%area_64, domain)
+       call prt_mxm('liq_wat_dyn', q(isd,jsd,1,liq_wat), is, ie, js, je, ng, npz, 1.,gridstruct%area_64, domain)
+       call prt_mxm('rainwat_dyn', q(isd,jsd,1,rainwat), is, ie, js, je, ng, npz, 1.,gridstruct%area_64, domain)
+       call prt_mxm('ice_wat_dyn', q(isd,jsd,1,ice_wat), is, ie, js, je, ng, npz, 1.,gridstruct%area_64, domain)
+       call prt_mxm('snowwat_dyn', q(isd,jsd,1,snowwat), is, ie, js, je, ng, npz, 1.,gridstruct%area_64, domain)
+     endif
+  endif
+
   if( (flagstruct%consv_am.or.idiag%id_amdt>0.or.idiag%id_aam>0) .and. (.not.do_adiabatic_init)  ) then
       call compute_aam(npz, is, ie, js, je, isd, ied, jsd, jed, gridstruct, bd,   &
                        ptop, ua, va, u, v, delp, te_2d, ps, m_fac)