Merge pull request #343 from spencerkclark/diagnostics/diabatic-tende…

…ncies

Implement fine and coarse `t_dt_diabatic` and `qv_dt_diabatic` diagnostics

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)

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)

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