diff --git a/DynCore_GridCompMod.F90 b/DynCore_GridCompMod.F90 index e25957086..4558ed9bd 100644 --- a/DynCore_GridCompMod.F90 +++ b/DynCore_GridCompMod.F90 @@ -25,7 +25,7 @@ Module FVdycoreCubed_GridComp use fv_arrays_mod, only: REAL4, REAL8, FVPRC !use fv_grid_tools_mod, only: grid_type use FV_StateMod, only : FV_Atm, & - FV_To_State, State_To_FV, DEBUG_FV_STATE, & + DEBUG_FV_STATE, & DynTracers => T_TRACERS, & DynVars => T_FVDYCORE_VARS, & DynGrid => T_FVDYCORE_GRID, & diff --git a/FV_StateMod.F90 b/FV_StateMod.F90 index 152a88459..5169c5d19 100644 --- a/FV_StateMod.F90 +++ b/FV_StateMod.F90 @@ -16,6 +16,7 @@ module FV_StateMod use fv_mp_mod, only: start_group_halo_update, complete_group_halo_update use fv_mp_mod, only: group_halo_update_type + use fv_mp_mod, only: mp_bcst, mp_reduce_max use fms_mod, only: fms_init, set_domain, nullify_domain use mpp_domains_mod, only: mpp_update_domains, CGRID_NE, DGRID_NE, mpp_get_boundary @@ -59,7 +60,7 @@ module FV_StateMod logical :: FV_OFF = .false. integer :: INT_FV_OFF = 0 - logical :: ADJUST_DT = .false. + logical :: ADJUST_SPLITS = .false. logical :: DEBUG = .false. logical :: DEBUG_DYN = .false. logical :: DEBUG_ADV = .false. @@ -74,7 +75,6 @@ module FV_StateMod logical :: fix_mass = .true. integer :: CASE_ID = 11 integer :: AdvCore_Advection = 0 - integer :: FV3_QSPLIT = 0 character(LEN=ESMF_MAXSTR) :: FV3_CONFIG public FV_Atm @@ -210,12 +210,15 @@ module FV_StateMod type (ESMF_Alarm) :: ALARMS(NUM_FVDYCORE_ALARMS) #endif - integer(kind=8) :: RUN_TIMES(4,NUM_TIMES) - logical :: DOTIME, DODYN real(REAL8) :: DT ! Large time step - integer :: KSPLIT - integer :: NSPLIT - integer :: NUM_CALLS + ! Dynamically adjusted FV3 splits (active for this timestep) + integer :: k_split + integer :: n_split + integer :: q_split + ! Original namelist baselines (never change) + integer :: base_k_split + integer :: base_n_split + integer :: base_q_split end type T_FVDYCORE_STATE ! Constants used by fvcore @@ -438,9 +441,7 @@ subroutine FV_Setup(GC,LAYOUT_FILE, RC) call MAPL_GetResource( MAPL, AdvCore_Advection, label='AdvCore_Advection:', default=AdvCore_Advection, rc=status ) VERIFY_(STATUS) - call MAPL_GetResource( MAPL, FV3_QSPLIT, label='FV3_QSPLIT:', default=FV3_QSPLIT, rc=status ) - VERIFY_(STATUS) - call MAPL_GetResource( MAPL, ADJUST_DT, label='ADJUST_DT:' , default=ADJUST_DT, rc=status ) + call MAPL_GetResource( MAPL, ADJUST_SPLITS, label='ADJUST_SPLITS:', default=ADJUST_SPLITS, rc=status ) VERIFY_(STATUS) call MAPL_GetResource( MAPL, INT_fix_mass, label='fix_mass:' , default=INT_fix_mass, rc=status ) VERIFY_(STATUS) @@ -601,31 +602,31 @@ subroutine FV_Setup(GC,LAYOUT_FILE, RC) endif if (FV_Atm(1)%flagstruct%npx >= 1120) then FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 75.0 ) - FV_Atm(1)%flagstruct%rf_cutoff = 25.0 ! Pa + FV_Atm(1)%flagstruct%rf_cutoff = 250.0 ! Pa FV_Atm(1)%flagstruct%tau = 0.75 FV_Atm(1)%flagstruct%RF_fast = .false. endif if (FV_Atm(1)%flagstruct%npx >= 1440) then FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 37.5 ) - FV_Atm(1)%flagstruct%rf_cutoff = 30.0 ! Pa + FV_Atm(1)%flagstruct%rf_cutoff = 500.0 ! Pa FV_Atm(1)%flagstruct%tau = 0.5 FV_Atm(1)%flagstruct%RF_fast = .true. endif if (FV_Atm(1)%flagstruct%npx >= 2880) then FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 18.75 ) - FV_Atm(1)%flagstruct%rf_cutoff = 35.0 ! Pa + FV_Atm(1)%flagstruct%rf_cutoff = 1000.0 ! Pa FV_Atm(1)%flagstruct%tau = 0.25 FV_Atm(1)%flagstruct%RF_fast = .true. endif if (FV_Atm(1)%flagstruct%npx >= 5760) then FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 9.375 ) - FV_Atm(1)%flagstruct%rf_cutoff = 40.0 ! Pa + FV_Atm(1)%flagstruct%rf_cutoff = 1000.0 ! Pa FV_Atm(1)%flagstruct%tau = 0.125 FV_Atm(1)%flagstruct%RF_fast = .true. endif if (FV_Atm(1)%flagstruct%npx >= 10800) then FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 4.6875 ) - FV_Atm(1)%flagstruct%rf_cutoff = 50.0 ! Pa + FV_Atm(1)%flagstruct%rf_cutoff = 1000.0 ! Pa FV_Atm(1)%flagstruct%tau = 0.0625 FV_Atm(1)%flagstruct%RF_fast = .true. endif @@ -634,31 +635,31 @@ subroutine FV_Setup(GC,LAYOUT_FILE, RC) ! based on ideal remapping DT if (FV_Atm(1)%flagstruct%npx*CEILING(FV_Atm(1)%flagstruct%stretch_fac) >= 540) then FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 150.0 ) - FV_Atm(1)%flagstruct%rf_cutoff = 25.0 ! Pa + FV_Atm(1)%flagstruct%rf_cutoff = 100.0 ! Pa FV_Atm(1)%flagstruct%tau = 2.0 FV_Atm(1)%flagstruct%RF_fast = .true. endif if (FV_Atm(1)%flagstruct%npx*CEILING(FV_Atm(1)%flagstruct%stretch_fac) >= 1080) then FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 75.0 ) - FV_Atm(1)%flagstruct%rf_cutoff = 30.0 ! Pa + FV_Atm(1)%flagstruct%rf_cutoff = 500.0 ! Pa FV_Atm(1)%flagstruct%tau = 1.0 FV_Atm(1)%flagstruct%RF_fast = .true. endif if (FV_Atm(1)%flagstruct%npx*CEILING(FV_Atm(1)%flagstruct%stretch_fac) >= 2160) then FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 37.5 ) - FV_Atm(1)%flagstruct%rf_cutoff = 35.0 ! Pa + FV_Atm(1)%flagstruct%rf_cutoff = 1000.0 ! Pa FV_Atm(1)%flagstruct%tau = 0.5 FV_Atm(1)%flagstruct%RF_fast = .true. endif if (FV_Atm(1)%flagstruct%npx*CEILING(FV_Atm(1)%flagstruct%stretch_fac) >= 4320) then - FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 15.0 ) - FV_Atm(1)%flagstruct%rf_cutoff = 40.0 ! Pa + FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 18.75 ) + FV_Atm(1)%flagstruct%rf_cutoff = 1000.0 ! Pa FV_Atm(1)%flagstruct%tau = 0.25 FV_Atm(1)%flagstruct%RF_fast = .true. endif if (FV_Atm(1)%flagstruct%npx*CEILING(FV_Atm(1)%flagstruct%stretch_fac) >= 8640) then - FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 7.5 ) - FV_Atm(1)%flagstruct%rf_cutoff = 45.0 ! Pa + FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 9.375 ) + FV_Atm(1)%flagstruct%rf_cutoff = 1000.0 ! Pa FV_Atm(1)%flagstruct%tau = 0.125 FV_Atm(1)%flagstruct%RF_fast = .true. endif @@ -693,7 +694,7 @@ subroutine FV_Setup(GC,LAYOUT_FILE, RC) FV_Atm(1)%flagstruct%beta = 0.0 FV_Atm(1)%flagstruct%a_imp = 1.0 ! dz_min is a NH delta-z limiter increasing may improve stability - FV_Atm(1)%flagstruct%dz_min = 2.0 + FV_Atm(1)%flagstruct%dz_min = 3.0 ! p_fac is a NH pressure fraction limiter near model top (0:0.25) FV_Atm(1)%flagstruct%p_fac = 0.05 ! General defaults @@ -901,10 +902,17 @@ subroutine FV_InitState (STATE, CLOCK, INTERNAL, IMPORT, GC, RC) STATE%GRID%FVgenstate => MAPL GRID => STATE%GRID ! For convenience - STATE%DOTIME= .TRUE. - STATE%DT = DT - STATE%KSPLIT = FV_Atm(1)%flagstruct%K_SPLIT - STATE%NSPLIT = FV_Atm(1)%flagstruct%N_SPLIT + + STATE%DT = DT + + STATE%q_split = FV_Atm(1)%flagstruct%q_split + STATE%k_split = FV_Atm(1)%flagstruct%k_split + STATE%n_split = FV_Atm(1)%flagstruct%n_split + + STATE%base_q_split = FV_Atm(1)%flagstruct%q_split + STATE%base_k_split = FV_Atm(1)%flagstruct%k_split + STATE%base_n_split = FV_Atm(1)%flagstruct%n_split + GRID%NG = 3 ; ng = 3 GRID%NPX = FV_Atm(1)%flagstruct%NPX-1 GRID%NPY = FV_Atm(1)%flagstruct%NPY-1 @@ -1041,9 +1049,6 @@ subroutine FV_InitState (STATE, CLOCK, INTERNAL, IMPORT, GC, RC) ! Clear wall clock time clocks and global budgets - STATE%RUN_TIMES = 0 - STATE%NUM_CALLS = 0 - call ESMF_ClockGet( CLOCK, currTime=fv_time, rc=STATUS ) VERIFY_(STATUS) call ESMF_TimeGet( fv_time, dayOfYear=days, s=seconds, rc=STATUS ) @@ -1102,7 +1107,7 @@ subroutine FV_InitState (STATE, CLOCK, INTERNAL, IMPORT, GC, RC) FV_Atm(1)%flagstruct%moist_phys, FV_Atm(1)%flagstruct%hydrostatic, hybrid, FV_Atm(1)%delz, FV_Atm(1)%ze0, & FV_Atm(1)%ks, FV_Atm(1)%ptop, FV_Atm(1)%domain, tile_in, FV_Atm(1)%bd) ! Copy FV to internal State - call FV_To_State ( STATE ) + call FV_To_State ( MAPL, STATE ) if( gid==masterproc ) write(*,*) 'Doubly Periodic IC generated LAT:', FV_Atm(1)%flagstruct%deglat else ALLOCATE( UA(isc:iec ,jsc:jec ,1:FV_Atm(1)%npz) ) @@ -1125,7 +1130,7 @@ subroutine FV_InitState (STATE, CLOCK, INTERNAL, IMPORT, GC, RC) call fv_getDELZ(DZ,PT,PE) PT = PT/PKZ endif - call State_To_FV( STATE ) + call State_To_FV( MAPL, STATE ) endif ! doubly-periodic else ! COLDSTART @@ -1137,7 +1142,7 @@ subroutine FV_InitState (STATE, CLOCK, INTERNAL, IMPORT, GC, RC) ! call fv_getDELZ(DZ,PT,PE) ! PT = PT/PKZ !endif - call State_To_FV( STATE ) + call State_To_FV( MAPL, STATE ) endif @@ -1420,6 +1425,7 @@ subroutine FV_Run (STATE, EXPORT, CLOCK, GC, PLE0, RC) deallocate ( griddiffs ) #endif ! Set FV3 surface geopotential + FV_Atm(1)%phis = 0.0 FV_Atm(1)%phis(isc:iec,jsc:jec) = real(phis,kind=FVPRC) FV_Atm(1)%varflt(isc:iec,jsc:jec) = real(varflt,kind=FVPRC) call mpp_update_domains(FV_Atm(1)%phis, FV_Atm(1)%domain, complete=.true.) @@ -1471,6 +1477,7 @@ subroutine FV_Run (STATE, EXPORT, CLOCK, GC, PLE0, RC) cnvfrc = 0.0 ! Pull Tracers + call MAPL_TimerOn(MAPL,"--PULL_TRACERS") nn = 0 if (.not. ADIABATIC) then select case ( FV_Atm(1)%flagstruct%nwat ) @@ -1797,6 +1804,7 @@ subroutine FV_Run (STATE, EXPORT, CLOCK, GC, PLE0, RC) _ASSERT(nn == FV_Atm(1)%ncnst, 'needs informative message') endif + call MAPL_TimerOff(MAPL,"--PULL_TRACERS") myDT = state%dt @@ -1805,7 +1813,7 @@ subroutine FV_Run (STATE, EXPORT, CLOCK, GC, PLE0, RC) if (DEBUG) call debug_fv_state('Before Dynamics Execution',STATE) ! Update FV with Internal State - call State_To_FV( STATE ) + call State_To_FV( MAPL, STATE ) ! Query for PSDRY from AGCM.rc and set to MAPL_PSDRY if not found call MAPL_GetResource( MAPL, massD0, 'PSDRY:', default=MAPL_PSDRY, RC=STATUS ) @@ -1976,13 +1984,12 @@ subroutine FV_Run (STATE, EXPORT, CLOCK, GC, PLE0, RC) if (run_gtfv3 == 0) then call cpu_time(start) #endif - if (FV3_QSPLIT == 0) FV3_QSPLIT = FV_Atm(1)%flagstruct%q_split call fv_dynamics( & FV_Atm(1)%npx, FV_Atm(1)%npy, FV_Atm(1)%npz, FV_Atm(1)%ncnst, FV_Atm(1)%ng, myDT, & FV_Atm(1)%flagstruct%consv_te, FV_Atm(1)%flagstruct%fill, & kappa, cp, zvir, & FV_Atm(1)%ptop, FV_Atm(1)%ks, FV_Atm(1)%flagstruct%ncnst, & - state%ksplit, state%nsplit, FV3_QSPLIT, & + STATE%k_split, STATE%n_split, STATE%q_split, & FV_Atm(1)%u, FV_Atm(1)%v, FV_Atm(1)%w, FV_Atm(1)%delz, & FV_Atm(1)%flagstruct%hydrostatic, & FV_Atm(1)%pt, FV_Atm(1)%delp, FV_Atm(1)%q, & @@ -2083,6 +2090,7 @@ subroutine FV_Run (STATE, EXPORT, CLOCK, GC, PLE0, RC) CLCN_FILLED = .FALSE. ! Push Tracers + call MAPL_TimerOn(MAPL,"--PUSH_TRACERS") nn = 0 if (.not. ADIABATIC) then @@ -2382,9 +2390,10 @@ subroutine FV_Run (STATE, EXPORT, CLOCK, GC, PLE0, RC) if (mpp_pe()==0) print*,'' prt_minmax = .false. endif + call MAPL_TimerOff(MAPL,"--PUSH_TRACERS") ! Copy FV to internal State - call FV_To_State ( STATE ) + call FV_To_State ( MAPL, STATE ) if (DEBUG) call debug_fv_state('After Dynamics Execution',STATE) @@ -2433,10 +2442,11 @@ subroutine FV_Finalize (STATE) end subroutine FV_Finalize -subroutine State_To_FV ( STATE ) +subroutine State_To_FV ( MAPL, STATE ) ! !INPUT PARAMETERS: + type(MAPL_MetaComp), pointer :: MAPL type(T_FVDYCORE_STATE), pointer :: STATE integer :: ISC,IEC, JSC,JEC @@ -2459,8 +2469,14 @@ subroutine State_To_FV ( STATE ) logical :: bad_range_V logical :: bad_range_T - integer :: rc - character(len=ESMF_MAXSTR) :: ERRSTR + integer :: rc, status + character(len=ESMF_MAXSTR) :: IAm='FV_StateMod:State_To_FV' + character(len=ESMF_MAXSTR) :: ERRSTR + + real(REAL4), pointer :: LONS(:,:), LATS(:,:) + + call MAPL_Get(MAPL, LATS=LATS, LONS=LONS, RC=STATUS) ! These are in radians + VERIFY_(STATUS) ISC = state%grid%is IEC = state%grid%ie @@ -2476,6 +2492,8 @@ subroutine State_To_FV ( STATE ) akap = kappa if (SW_DYNAMICS) akap = 1. + call MAPL_TimerOn(MAPL,"--State_To_FV") + !------------ ! Update Winds !------------ @@ -2512,22 +2530,6 @@ subroutine State_To_FV ( STATE ) enddo endif - if ( ADJUST_DT ) then - call range_check('U_S2F', FV_Atm(1)%u, isc, iec, jsc, jec+1, ng, km, FV_Atm(1)%gridstruct%agrid, & - -200., 200., bad_range=bad_range_U) - call range_check('V_S2F', FV_Atm(1)%v, isc, iec+1, jsc, jec, ng, km, FV_Atm(1)%gridstruct%agrid, & - -200., 200., bad_range=bad_range_V) - if ((bad_range_U .or. bad_range_V) .and. (ADJUST_DT)) then - STATE%KSPLIT = FV_Atm(1)%flagstruct%k_split - STATE%NSPLIT = MIN(2*FV_Atm(1)%flagstruct%n_split,NINT(STATE%NSPLIT*1.25)) - elseif (ADJUST_DT) then - STATE%KSPLIT = FV_Atm(1)%flagstruct%k_split - STATE%NSPLIT = MAX( FV_Atm(1)%flagstruct%n_split,NINT(STATE%NSPLIT/1.25)) - endif - if (STATE%NSPLIT /= FV_Atm(1)%flagstruct%n_split) & - call WRITE_PARALLEL( STATE%DT/real(STATE%KSPLIT*STATE%NSPLIT) ,format='("Adjusted Dynamics time step : ",(F10.4))') - endif - if (.not. FV_Atm(1)%flagstruct%hydrostatic) FV_Atm(1)%w(isc:iec,jsc:jec,:) = STATE%VARS%W !------------ @@ -2606,24 +2608,38 @@ subroutine State_To_FV ( STATE ) endif + if ( ADJUST_SPLITS ) then + call adjust_fv3_splits(STATE, & + isc, iec, jsc, jec, & ! Compute domain bounds + isd, ied, jsd, jed, & ! Data/Memory domain bounds + km, & ! Number of vertical levels + FV_Atm(1)%u, & ! D-grid U-wind + FV_Atm(1)%v, & ! D-grid V-wind + FV_Atm(1)%w, & ! W-wind + FV_Atm(1)%delz, & ! Layer thickness + FV_Atm(1)%gridstruct%dxa, & ! Cell center dx (dxa) + FV_Atm(1)%gridstruct%dya) ! Cell center dy (dya) + endif + + call MAPL_TimerOff(MAPL,"--State_To_FV") return end subroutine State_To_FV -subroutine FV_To_State ( STATE ) +subroutine FV_To_State ( MAPL, STATE ) ! ! !INPUT PARAMETERS: + type(MAPL_MetaComp), pointer :: MAPL type(T_FVDYCORE_STATE), pointer :: STATE logical :: bad_range = .false. integer :: ISC,IEC, JSC,JEC, KM, NG integer :: I,J,K - real :: courant_range character(len=ESMF_MAXSTR) :: ERRSTR - integer :: rc + integer :: status ISC = state%grid%is IEC = state%grid%ie @@ -2632,6 +2648,8 @@ subroutine FV_To_State ( STATE ) KM = state%grid%npz NG = state%grid%ng + call MAPL_TimerOn(MAPL,"--FV_To_State") + ! Copy updated FV data to internal state STATE%VARS%U(:,:,:) = FV_Atm(1)%u(isc:iec,jsc:jec,:) STATE%VARS%V(:,:,:) = FV_Atm(1)%v(isc:iec,jsc:jec,:) @@ -2681,10 +2699,127 @@ subroutine FV_To_State ( STATE ) STATE%VARS%PT = STATE%VARS%PT/STATE%VARS%PKZ endif + call MAPL_TimerOff(MAPL,"--FV_To_State") + return end subroutine FV_To_State +subroutine adjust_fv3_splits(state, isc, iec, jsc, jec, isd, ied, jsd, jed, npz, & + u, v, w, delz, dx, dy) + implicit none + + type(T_FVDYCORE_STATE), intent(inout) :: state + + integer, intent(in) :: isc, iec, jsc, jec + integer, intent(in) :: isd, ied, jsd, jed + integer, intent(in) :: npz + + real, intent(in), dimension(isd:ied, jsd:jed+1, npz) :: u + real, intent(in), dimension(isd:ied+1, jsd:jed, npz) :: v + real, intent(in), dimension(isd:ied, jsd:jed, npz) :: w, delz + real, intent(in), dimension(isd:ied, jsd:jed) :: dx, dy + + integer :: i, j, k + real :: u_c, v_c + real :: max_cfl_h, max_cfl_z + + ! Updated constraints + real, parameter :: TARGET_CFL = 1.05 + real, parameter :: H_MULTIPLIER = 4.0 ! For acoustic speed scaling + real, parameter :: Z_MULTIPLIER = 0.25 ! Tune this to dictate max_cfl_z's impact + + integer :: new_k_split, new_n_split, new_q_split + integer :: target_k_split, base_tot + + max_cfl_h = 0.0 + max_cfl_z = 0.0 + + ! --- 1. FIND LOCAL MAXIMUMS --- + do k = 1, npz + do j = jsc, jec + do i = isc, iec + u_c = 0.5 * (u(i,j,k) + u(i,j+1,k)) + v_c = 0.5 * (v(i,j,k) + v(i+1,j,k)) + + max_cfl_h = max(max_cfl_h, abs((u_c/dx(i,j)) + (v_c/dy(i,j))) * state%DT) + max_cfl_z = max(max_cfl_z, abs(w(i,j,k) / delz(i,j,k)) * state%DT) + enddo + enddo + enddo + + ! --- 2. GLOBAL REDUCTION --- + call mp_reduce_max(max_cfl_h) + call mp_reduce_max(max_cfl_z) + + ! --- 3. DYNAMIC ADJUSTMENT ON ROOT PE --- + if (mpp_pe() == 0) then + + ! Calculate total baseline acoustic steps (e.g., 1 * 6 = 6) + ! We want to keep (k_split * n_split) as close to this as possible + base_tot = state%base_k_split * state%base_n_split + + ! Calculate the strictly required k_split + target_k_split = max(state%base_k_split, ceiling(max_cfl_z * Z_MULTIPLIER)) + + ! b. RATE LIMITING VIA FACTORS: + ! Step to the next integer that cleanly divides base_tot + if (target_k_split > state%k_split) then + new_k_split = state%k_split + 1 + ! Increment until we find a clean factor (or exceed base_tot) + do while (new_k_split < base_tot .and. mod(base_tot, new_k_split) /= 0) + new_k_split = new_k_split + 1 + end do + elseif (target_k_split < state%k_split) then + new_k_split = state%k_split - 1 + ! Decrement until we find a clean factor + do while (new_k_split > state%base_k_split .and. mod(base_tot, new_k_split) /= 0) + new_k_split = new_k_split - 1 + end do + ! Safety catch + new_k_split = max(state%base_k_split, new_k_split) + else + new_k_split = state%k_split + endif + + ! c. Calculate n_split + ! Because new_k_split is guaranteed to be a factor, this division is exact! + ! (Unless max_cfl_h independently forces it higher) + new_n_split = ceiling(base_tot / real(new_k_split)) + new_n_split = max(new_n_split, ceiling(max_cfl_h * H_MULTIPLIER / real(new_k_split))) + + ! d. Calculate q_split + if (state%base_q_split == 0) then + new_q_split = 0 + else + new_q_split = max(state%base_q_split, ceiling((max_cfl_h / real(new_k_split)) / TARGET_CFL)) + endif + + ! Apply and report if adjusted + if (state%k_split /= new_k_split .or. & + state%n_split /= new_n_split .or. & + state%q_split /= new_q_split) then + + print *, "=== FV3 DYNAMIC SPLIT ADJUSTMENT ===" + print *, "Max Horz CFL: ", max_cfl_h, " | Max Vert CFL: ", max_cfl_z + print *, "FV3 k_split: ", new_k_split, " (was ", state%k_split, ", target was ", target_k_split, ")" + print *, "FV3 n_split: ", new_n_split, " (was ", state%n_split, ")" + print *, "FV3 q_split: ", new_q_split, " (was ", state%q_split, ")" + print *, "====================================" + + state%k_split = new_k_split + state%n_split = new_n_split + state%q_split = new_q_split + endif + endif + + ! --- 4. BROADCAST --- + call mp_bcst(state%k_split) + call mp_bcst(state%n_split) + call mp_bcst(state%q_split) + +end subroutine adjust_fv3_splits + subroutine fv_getDELZ(delz,temp,pe) real(REAL8), intent(OUT) :: delz(FV_Atm(1)%bd%isc:FV_Atm(1)%bd%iec,FV_Atm(1)%bd%jsc:FV_Atm(1)%bd%jec,1:FV_Atm(1)%npz) real(REAL8), intent( IN) :: temp(FV_Atm(1)%bd%isc:FV_Atm(1)%bd%iec,FV_Atm(1)%bd%jsc:FV_Atm(1)%bd%jec,1:FV_Atm(1)%npz) @@ -3191,7 +3326,7 @@ end subroutine a2d2d subroutine fv_computeMassFluxes_r4(ucI, vcI, ple, mfx, mfy, cx, cy, dt) use tp_core_mod, only: fv_tp_2d - use fv_mp_mod, only: is,js,ie,je, isd,jsd,ied,jed, mp_reduce_max + use fv_mp_mod, only: is,js,ie,je, isd,jsd,ied,jed real(REAL4), intent(IN ) :: ucI(is:ie,js:je,1:FV_Atm(1)%flagstruct%npz) real(REAL4), intent(IN ) :: vcI(is:ie,js:je,1:FV_Atm(1)%flagstruct%npz) real(REAL4), intent(IN ) :: ple(is:ie,js:je,1:FV_Atm(1)%flagstruct%npz+1) @@ -3374,7 +3509,7 @@ end subroutine fv_computeMassFluxes_r4 subroutine fv_computeMassFluxes_r8(ucI, vcI, ple, mfx, mfy, cx, cy, dt) use tp_core_mod, only: fv_tp_2d - use fv_mp_mod, only: is,js,ie,je, isd,jsd,ied,jed, mp_reduce_max + use fv_mp_mod, only: is,js,ie,je, isd,jsd,ied,jed real(REAL8), intent(IN ) :: ucI(is:ie,js:je,1:FV_Atm(1)%flagstruct%npz) real(REAL8), intent(IN ) :: vcI(is:ie,js:je,1:FV_Atm(1)%flagstruct%npz) real(REAL8), intent(IN ) :: ple(is:ie,js:je,1:FV_Atm(1)%flagstruct%npz+1) diff --git a/fv_regrid_c2c.F90 b/fv_regrid_c2c.F90 index 2f3fd1631..2742ec859 100644 --- a/fv_regrid_c2c.F90 +++ b/fv_regrid_c2c.F90 @@ -320,6 +320,8 @@ subroutine get_geos_cubed_ic( Atm_i, Atm, grid_i, grid, Arrdes_i, extra_rst ) call prt_maxmin(' V_geos', v0, is_i, ie_i+1, js_i, je_i , Atm_i(1)%ng, km, 1.0_FVPRC) allocate ( ud(isd:ied ,jsd:jed+1,km) ) allocate ( vd(isd:ied+1,jsd:jed ,km) ) + ud = 0. + vd = 0. !------------------------------------------------------------------! ! D->A : regrid : A-> D interpolation for U and V components !------------------------------------------------------------------! @@ -986,6 +988,8 @@ subroutine d2a2d(ui, vi, uo, vo, Atm_i, Atm, regridder) integer :: i,j,n integer :: is, ie, js, je + va_xyz_o = 0.d0 + tmp_o = 0. is = Atm_i%bd%is ie = Atm_i%bd%ie js = Atm_i%bd%js diff --git a/interp_restarts.F90 b/interp_restarts.F90 index 22a500fc0..e92e53cf1 100755 --- a/interp_restarts.F90 +++ b/interp_restarts.F90 @@ -39,7 +39,6 @@ program interp_restarts real(ESMF_KIND_R8), allocatable :: r8_ak(:) real(ESMF_KIND_R8), allocatable :: r8_bk(:) - real(ESMF_KIND_R8), allocatable :: r8_akbk(:) real(ESMF_KIND_R4), pointer :: r4_local(:,:,:) real(ESMF_KIND_R8), pointer :: r8_local(:,:,:), pt_local(:,:,:) @@ -302,7 +301,6 @@ program interp_restarts call set_eta(npz,ks,ptop,pint,r8_ak,r8_bk) Atm(1)%ak = r8_ak Atm(1)%bk = r8_bk - deallocate ( r8_ak,r8_bk ) nq = nmoist Atm(1)%ncnst = nq/km if( is_master() ) then @@ -503,12 +501,8 @@ program interp_restarts ! AK and BK - allocate ( r8_akbk(npz+1) ) - r8_akbk = Atm(1)%ak - if (AmWriter) call MAPL_VarWrite(OutFmt,"AK",r8_akbk) - r8_akbk = Atm(1)%bk - if (AmWriter) call MAPL_VarWrite(OutFmt,"BK",r8_akbk) - deallocate ( r8_akbk ) + if (AmWriter) call MAPL_VarWrite(OutFmt,"AK",r8_ak) + if (AmWriter) call MAPL_VarWrite(OutFmt,"BK",r8_bk) allocate(r4_local(is:ie,js:je,npz+1)) allocate(r8_local(is:ie,js:je,npz+1))