From 5542acaf51a9460fab4723c20622bb6f97853656 Mon Sep 17 00:00:00 2001
From: Dustin Swales <dustin.swales@noaa.gov>
Date: Mon, 6 Jan 2020 11:22:38 -0700
Subject: [PATCH] Added diagnostics for LW clouds.

---
 physics/radlw_main.f                | 16 ++++++++++++++--
 physics/rrtmgp_lw_cloud_optics.F90  | 20 ++++++++++++++++++--
 physics/rrtmgp_lw_cloud_optics.meta |  9 +++++++++
 3 files changed, 41 insertions(+), 4 deletions(-)

diff --git a/physics/radlw_main.f b/physics/radlw_main.f
index 5d4e1b959..ca953c1c3 100644
--- a/physics/radlw_main.f
+++ b/physics/radlw_main.f
@@ -353,8 +353,9 @@ module rrtmg_lw
       contains
 ! ================
 
-         subroutine rrtmg_lw_init ()
-         end subroutine rrtmg_lw_init
+      subroutine rrtmg_lw_init ()
+      open(47,file='rrtmg_clds.txt',status='unknown')
+      end subroutine rrtmg_lw_init
 
 !> \defgroup module_radlw_main GFS RRTMG Longwave Module 
 !! \brief This module includes NCEP's modifications of the RRTMG-LW radiation
@@ -717,6 +718,9 @@ subroutine rrtmg_lw_run                                           &
 !     endif
 
 !  --- ...  loop over horizontal npts profiles
+      write(47,*) "In radlw_main: "
+      write(47,*),"nCol: ",npts
+      write(47,*),"nLay: ",nLay
 
       lab_do_iplon : do iplon = 1, npts
 
@@ -1162,6 +1166,13 @@ subroutine rrtmg_lw_run                                           &
 
 !> -# Save outputs.
 
+
+        do k=1,nlay
+           write(47,"(21f8.2)")  plyr(iplon,k),clwp(k),relw(k),ciwp(k), &
+     &          reiw(k),taucld(:,k)
+        enddo
+        
+
         topflx(iplon)%upfxc = totuflux(nlay)
         topflx(iplon)%upfx0 = totuclfl(nlay)
 
@@ -1247,6 +1258,7 @@ end subroutine rrtmg_lw_run
 !-----------------------------------
 !> @}
       subroutine rrtmg_lw_finalize ()
+      close(47)
       end subroutine rrtmg_lw_finalize 
 
 
diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90
index aacecd6df..c7f5ee24c 100644
--- a/physics/rrtmgp_lw_cloud_optics.F90
+++ b/physics/rrtmgp_lw_cloud_optics.F90
@@ -99,6 +99,8 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d
     errmsg = ''
     errflg = 0
 
+    open(47,file='rrtmgp_clds.txt',status='unknown')
+
     if (cld_optics_scheme .eq. 0) return
 
     ! Filenames are set in the physics_nml
@@ -357,8 +359,8 @@ end subroutine rrtmgp_lw_cloud_optics_init
 !!
   subroutine rrtmgp_lw_cloud_optics_run(doLWrad, nCol, nLev, cld_optics_scheme, nrghice,    &
        cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp,      &
-       cld_rerain, lw_cloud_props, lw_gas_props, cldtaulw, lw_optical_props_cloudsByBand,   &
-       errmsg, errflg)
+       cld_rerain, p_lay, lw_cloud_props, lw_gas_props,                                     &
+       cldtaulw, lw_optical_props_cloudsByBand, errmsg, errflg)
     
     ! Inputs
     logical, intent(in) :: &
@@ -369,6 +371,7 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, nCol, nLev, cld_optics_scheme, nr
          nrghice,          & ! Number of ice-roughness categories
          cld_optics_scheme   ! Cloud-optics scheme
     real(kind_phys), dimension(ncol,nLev),intent(in) :: &
+         p_lay,            & ! Layer pressure (Pa)
          cld_frac,         & ! Total cloud fraction by layer
          cld_lwp,          & ! Cloud liquid water path
          cld_reliq,        & ! Cloud liquid effective radius
@@ -397,10 +400,12 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, nCol, nLev, cld_optics_scheme, nr
     logical,dimension(ncol,nLev) :: liqmask, icemask
     real(kind_phys), dimension(ncol,nLev,lw_gas_props%get_nband()) :: &
          tau_cld
+    integer :: iCol, iLay
 
     ! Initialize CCPP error handling variables
     errmsg = ''
     errflg = 0
+    tau_cld = 0.
 
     if (.not. doLWrad) return
     
@@ -438,6 +443,16 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, nCol, nLev, cld_optics_scheme, nr
           lw_optical_props_cloudsByBand%tau = tau_cld
        endif
     endif
+    
+    write(47,*) "In rrtmgp_lw_cloud_optics: "
+    write(47,*),"nCol: ",nCol
+    write(47,*),"nLay: ",nLev
+    do iCol=1,nCol
+       do iLay=1,nLev
+          write(47,"(21f8.2)") p_lay(iCol,iLay)/100.,cld_lwp(iCol,iLay),cld_reliq(iCol,iLay),&
+               cld_iwp(iCol,iLay),cld_reice(iCol,iLay),tau_cld(iCol,iLay,:)
+       enddo
+    enddo
 
     ! All-sky LW optical depth ~10microns
     cldtaulw = lw_optical_props_cloudsByBand%tau(:,:,7)
@@ -448,5 +463,6 @@ end subroutine rrtmgp_lw_cloud_optics_run
   ! SUBROUTINE rrtmgp_lw_cloud_optics_finalize()
   ! #########################################################################################
   subroutine rrtmgp_lw_cloud_optics_finalize()
+    close(47)
   end subroutine rrtmgp_lw_cloud_optics_finalize
 end module rrtmgp_lw_cloud_optics
diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta
index 81602c552..2582362d1 100644
--- a/physics/rrtmgp_lw_cloud_optics.meta
+++ b/physics/rrtmgp_lw_cloud_optics.meta
@@ -201,6 +201,15 @@
   type = real
   intent = in
   kind = kind_phys
+[p_lay]
+  standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa
+  long_name = air pressure layer
+  units = hPa
+  dimensions = (horizontal_dimension,vertical_dimension)
+  type = real
+  kind = kind_phys
+  intent = in
+  optional = F
 [lw_gas_props]
   standard_name = coefficients_for_lw_gas_optics
   long_name = DDT containing spectral information for RRTMGP LW radiation scheme