From 1008e83a494d9700c9c2b4e8bd50ef196b60ac1a Mon Sep 17 00:00:00 2001 From: Spencer Clark Date: Wed, 5 Jun 2024 17:59:56 -0400 Subject: [PATCH] Implement t_dt_diabatic and qv_dt_diabatic diagnostics --- tools/coarse_grained_diagnostics.F90 | 66 ++++++++++++++++++++++++++-- tools/fv_diagnostics.F90 | 25 +++++++++++ tools/fv_diagnostics.h | 1 + 3 files changed, 88 insertions(+), 4 deletions(-) diff --git a/tools/coarse_grained_diagnostics.F90 b/tools/coarse_grained_diagnostics.F90 index 432fd79e1..83957ab18 100644 --- a/tools/coarse_grained_diagnostics.F90 +++ b/tools/coarse_grained_diagnostics.F90 @@ -44,6 +44,8 @@ module coarse_grained_diagnostics_mod type data_subtype real, dimension(:,:), pointer :: var2 => null() real, dimension(:,:,:), pointer :: var3 => null() + real, dimension(:,:,:), pointer :: var3_sum_a => null() + real, dimension(:,:,:), pointer :: var3_sum_b => null() end type data_subtype type coarse_diag_type @@ -787,6 +789,24 @@ subroutine populate_coarse_diag_type(Atm, coarse_diagnostics) coarse_diagnostics(index)%reduction_method = AREA_WEIGHTED coarse_diagnostics(index)%data%var2 => Atm(tile_count)%va(is:ie,js:je,npz) + index = index + 1 + coarse_diagnostics(index)%axes = 3 + coarse_diagnostics(index)%module_name = DYNAMICS + coarse_diagnostics(index)%name = 't_dt_diabatic_coarse' + coarse_diagnostics(index)%description = 'coarse-grained diabatic temperature tendency (t_dt_phys_coarse + t_dt_gfdlmp_coarse)' + coarse_diagnostics(index)%units = 'K/s' + coarse_diagnostics(index)%reduction_method = MASS_WEIGHTED + coarse_diagnostics(index)%special_case = 'sum_3d' + + index = index + 1 + coarse_diagnostics(index)%axes = 3 + coarse_diagnostics(index)%module_name = DYNAMICS + coarse_diagnostics(index)%name = 'qv_dt_diabatic_coarse' + coarse_diagnostics(index)%description = 'coarse-grained diabatic specific humidity tendency (qv_dt_phys_coarse + qv_dt_gfdlmp_coarse)' + coarse_diagnostics(index)%units = 'K/s' + coarse_diagnostics(index)%reduction_method = MASS_WEIGHTED + coarse_diagnostics(index)%special_case = 'sum_3d' + ! iv =-1: winds ! iv = 0: positive definite scalars ! iv = 1: temperature @@ -1125,6 +1145,24 @@ subroutine maybe_allocate_reference_array(Atm, coarse_diagnostic) Atm(tile_count)%sg_diag%qv_dt(is:ie,js:je,1:npz) = 0.0 endif coarse_diagnostic%data%var3 => Atm(tile_count)%sg_diag%qv_dt(is:ie,js:je,1:npz) + elseif (trim(coarse_diagnostic%name) .eq. 't_dt_diabatic_coarse') then + if (.not. allocated(Atm(tile_count)%phys_diag%phys_t_dt)) then + allocate(Atm(tile_count)%phys_diag%phys_t_dt(is:ie,js:je,1:npz)) + endif + if (.not. allocated(Atm(tile_count)%inline_mp%t_dt)) then + allocate(Atm(tile_count)%inline_mp%t_dt(is:ie,js:je,1:npz)) + endif + coarse_diagnostic%data%var3_sum_a => Atm(tile_count)%phys_diag%phys_t_dt(is:ie,js:je,1:npz) + coarse_diagnostic%data%var3_sum_b => Atm(tile_count)%inline_mp%t_dt(is:ie,js:je,1:npz) + elseif (trim(coarse_diagnostic%name) .eq. 'qv_dt_diabatic_coarse') then + if (.not. allocated(Atm(tile_count)%phys_diag%phys_qv_dt)) then + allocate(Atm(tile_count)%phys_diag%phys_qv_dt(is:ie,js:je,1:npz)) + endif + if (.not. allocated(Atm(tile_count)%inline_mp%qv_dt)) then + allocate(Atm(tile_count)%inline_mp%qv_dt(is:ie,js:je,1:npz)) + endif + coarse_diagnostic%data%var3_sum_a => Atm(tile_count)%phys_diag%phys_qv_dt(is:ie,js:je,1:npz) + coarse_diagnostic%data%var3_sum_b => Atm(tile_count)%inline_mp%qv_dt(is:ie,js:je,1:npz) endif endif end subroutine maybe_allocate_reference_array @@ -1315,25 +1353,35 @@ subroutine coarse_grain_3D_field_on_model_levels(is, ie, js, je, is_coarse, ie_c real, intent(in) :: omega(is:ie,js:je,1:npz) real, intent(out) :: result(is_coarse:ie_coarse,js_coarse:je_coarse,1:npz) + real, allocatable, target :: var3_sum(:,:,:) + real, pointer, dimension(:,:,:) :: var3 => null() character(len=256) :: error_message + if (trim(coarse_diag%special_case) .eq. 'sum_3d') then + allocate(var3_sum(is:ie,js:je,1:npz)) + var3_sum = coarse_diag%data%var3_sum_a + coarse_diag%data%var3_sum_b + var3 => var3_sum + else + var3 => coarse_diag%data%var3 + endif + if (trim(coarse_diag%reduction_method) .eq. AREA_WEIGHTED) then call weighted_block_average( & area(is:ie,js:je), & - coarse_diag%data%var3, & + var3, & result & ) elseif (trim(coarse_diag%reduction_method) .eq. MASS_WEIGHTED) then call weighted_block_average( & mass(is:ie,js:je,1:npz), & - coarse_diag%data%var3, & + var3, & result & ) elseif (trim(coarse_diag%reduction_method) .eq. EDDY_COVARIANCE) then call eddy_covariance_2d_weights( & area(is:ie,js:je), & omega(is:ie,js:je,1:npz), & - coarse_diag%data%var3, & + var3, & result & ) else @@ -1356,12 +1404,22 @@ subroutine coarse_grain_3D_field_on_pressure_levels(is, ie, js, je, is_coarse, i real, intent(out) :: result(is_coarse:ie_coarse,js_coarse:je_coarse,1:npz) real, allocatable, dimension(:,:,:) :: remapped_field, remapped_omega + real, allocatable, target :: var3_sum(:,:,:) + real, pointer, dimension(:,:,:) :: var3 => null() character(len=256) :: error_message + if (trim(coarse_diag%special_case) .eq. 'sum_3d') then + allocate(var3_sum(is:ie,js:je,1:npz)) + var3_sum = coarse_diag%data%var3_sum_a + coarse_diag%data%var3_sum_b + var3 => var3_sum + else + var3 => coarse_diag%data%var3 + endif + allocate(remapped_field(is:ie,js:je,1:npz)) call vertically_remap_field( & phalf, & - coarse_diag%data%var3, & + var3, & upsampled_coarse_phalf, & ptop, & remapped_field) diff --git a/tools/fv_diagnostics.F90 b/tools/fv_diagnostics.F90 index 3697ff1ff..6f6a33d42 100644 --- a/tools/fv_diagnostics.F90 +++ b/tools/fv_diagnostics.F90 @@ -778,6 +778,26 @@ subroutine fv_diag_init(Atm, axes, Time, npx, npy, npz, p_ref) Atm(n)%nudge_diag%nudge_v_dt(isc:iec,jsc:jec,1:npz) = 0.0 endif + id_t_dt_diabatic = register_diag_field ( trim(field), 'T_dt_diabatic', axes(1:3), Time, & + 'temperature tendency from diabatic processes (t_dt_phys + t_dt_gfdlmp)', 'K/s', missing_value=missing_value ) + if (id_t_dt_diabatic > 0) then + if (.not. allocated(Atm(n)%phys_diag%phys_t_dt)) then + allocate(Atm(n)%phys_diag%phys_t_dt(isc:iec,jsc:jec,npz)) + endif + if (.not. allocated(Atm(n)%inline_mp%t_dt)) then + allocate(Atm(n)%inline_mp%t_dt(isc:iec,jsc:jec,npz)) + endif + endif + id_qv_dt_diabatic = register_diag_field ( trim(field), 'qv_dt_diabatic', axes(1:3), Time, & + 'temperature tendency from diabatic processes (qv_dt_phys + qv_dt_gfdlmp)', 'kg/kg/s', missing_value=missing_value ) + if (id_qv_dt_diabatic > 0) then + if (.not. allocated(Atm(n)%phys_diag%phys_qv_dt)) then + allocate(Atm(n)%phys_diag%phys_qv_dt(isc:iec,jsc:jec,npz)) + endif + if (.not. allocated(Atm(n)%inline_mp%qv_dt)) then + allocate(Atm(n)%inline_mp%qv_dt(isc:iec,jsc:jec,npz)) + endif + endif endif ! @@ -1811,6 +1831,11 @@ subroutine fv_diag(Atm, zvir, Time, print_freq) if (idiag%id_v_dt_sg > 0) used=send_data(idiag%id_v_dt_sg, Atm(n)%sg_diag%v_dt(isc:iec,jsc:jec,1:npz), Time) if (idiag%id_qv_dt_sg > 0) used=send_data(idiag%id_qv_dt_sg, Atm(n)%sg_diag%qv_dt(isc:iec,jsc:jec,1:npz), Time) + if (id_t_dt_diabatic > 0) used=send_data(id_t_dt_diabatic, Atm(n)%phys_diag%phys_t_dt(isc:iec,jsc:jec,1:npz) + & + Atm(n)%inline_mp%t_dt(isc:iec,jsc:jec,1:npz), Time) + if (id_qv_dt_diabatic > 0) used=send_data(id_qv_dt_diabatic, Atm(n)%phys_diag%phys_qv_dt(isc:iec,jsc:jec,1:npz) + & + Atm(n)%inline_mp%qv_dt(isc:iec,jsc:jec,1:npz), Time) + if(id_c15>0 .or. id_c25>0 .or. id_c35>0 .or. id_c45>0) then call wind_max(isc, iec, jsc, jec ,isd, ied, jsd, jed, Atm(n)%ua(isc:iec,jsc:jec,npz), & Atm(n)%va(isc:iec,jsc:jec,npz), ws_max, Atm(n)%domain) diff --git a/tools/fv_diagnostics.h b/tools/fv_diagnostics.h index d745cd2e6..ddaafc687 100644 --- a/tools/fv_diagnostics.h +++ b/tools/fv_diagnostics.h @@ -95,6 +95,7 @@ integer :: id_qr_dt_phys, id_qg_dt_phys, id_qs_dt_phys integer :: id_liq_wat_dt_phys, id_ice_wat_dt_phys integer :: id_intqv, id_intql, id_intqi, id_intqr, id_intqs, id_intqg + integer :: id_t_dt_diabatic, id_qv_dt_diabatic ! ESM/CM 3-D diagostics integer :: id_uq, id_vq, id_wq, id_iuq, id_ivq, id_iwq, & ! moisture flux & vertical integral