Fix rounding error in G cloud-sampling test. Add diagnostics for clou…

…d microphysics
SamuelTrahanNOAA · Dec 19, 2019 · b2d42f3 · b2d42f3
1 parent 4d3515d
commit b2d42f3
Show file tree

Hide file tree

Showing 4 changed files with 112 additions and 5 deletions.
diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90
@@ -10,6 +10,7 @@ module GFS_rrtmg_pre
 !! \section arg_table_GFS_rrtmg_pre_init Argument Table
 !!
       subroutine GFS_rrtmg_pre_init ()
+        open(77,file='dump.rrtmg.cloudprops.txt',status='unknown')
       end subroutine GFS_rrtmg_pre_init
 
 !> \section arg_table_GFS_rrtmg_pre_run Argument Table
@@ -820,6 +821,58 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein,   & ! input
          enddo
        enddo
 
+    write(77,*) "####################"
+    write(77,*) im,Model%levs
+    do i=1,im
+       write(77,*) i, grid%xlon(i), grid%xlat(i)
+       !
+       write(77,*) "p_lay"
+       write(77,*) plyr(i,:)
+       !
+       write(77,*) "t_lay"
+       write(77,*) tlyr(i,:)
+       !
+       write(77,*) "tv_lay"
+       write(77,*) tvly(i,:)
+       !
+       write(77,*) "relhum"
+       write(77,*) rhly(i,:)
+       !
+       write(77,*) "qs_lay"
+       write(77,*) qstl(i,:)
+       !
+       write(77,*) "q_lay"
+       write(77,*) qlyr(i,:)
+       !
+       write(77,*) "cld_frac"
+       write(77,*) clouds1(i,:)
+       !
+       write(77,*) "cld_lwp"
+       write(77,*) clouds2(i,:)
+       !
+       write(77,*) "cld_reliq"
+       write(77,*) clouds3(i,:)
+       !
+       write(77,*) "cld_iwp"
+       write(77,*) clouds4(i,:)
+       !
+       write(77,*) "cld_reice"
+       write(77,*) clouds5(i,:)
+       !
+       write(77,*) "cld_rwp"
+       write(77,*) clouds6(i,:)
+       !
+       write(77,*) "cld_rerain"
+       write(77,*) clouds7(i,:)
+       !
+       write(77,*) "cld_swp"
+       write(77,*) clouds8(i,:)
+       !
+       write(77,*) "cld_resnow"
+       write(77,*) clouds9(i,:)
+    enddo
+
+
 
 ! mg, sfc-perts
 !  ---  scale random patterns for surface perturbations with
@@ -840,6 +893,7 @@ end subroutine GFS_rrtmg_pre_run
 !> \section arg_table_GFS_rrtmg_pre_finalize Argument Table
 !!
       subroutine GFS_rrtmg_pre_finalize ()
+        close(77)
       end subroutine GFS_rrtmg_pre_finalize
 
 !! @}

diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90
@@ -112,6 +112,9 @@ subroutine GFS_rrtmgp_pre_init(Model, Radtend, active_gases_array, errmsg, errfl
           active_gases_array(ij) = Model%active_gases(gasIndices(ij,1):gasIndices(ij,2))
        enddo
     endif
+
+    open(77,file='dump.rrtmgp.cloudprops.txt',status='unknown')
+
   end subroutine GFS_rrtmgp_pre_init
 
   ! #########################################################################################
@@ -322,14 +325,66 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop,
     cld_rwp    = clouds(:,:,6)  
     cld_rerain = clouds(:,:,7)  
     cld_swp    = clouds(:,:,8)  
-    cld_resnow = clouds(:,:,9)    
+    cld_resnow = clouds(:,:,9)  
+
+    write(77,*) "####################"
+    write(77,*) ncol,Model%levs
+    do iCol=1,NCOL
+       write(77,*) iCol, grid%xlon(iCol), grid%xlat(iCol)
+       !
+       write(77,*) "p_lay"
+       write(77,*) p_lay(iCol,:)/100.
+       !
+       write(77,*) "t_lay"
+       write(77,*) t_lay(iCol,:)
+       !
+       write(77,*) "tv_lay"
+       write(77,*) tv_lay(iCol,:)
+       !
+       write(77,*) "relhum"
+       write(77,*) relhum(iCol,:)
+       !
+       write(77,*) "qs_lay"
+       write(77,*) qs_lay(iCol,:)
+       !
+       write(77,*) "q_lay"
+       write(77,*) q_lay(iCol,:)
+       !
+       write(77,*) "cld_frac"
+       write(77,*) cld_frac(iCol,:)
+       !
+       write(77,*) "cld_lwp"
+       write(77,*) cld_lwp(iCol,:)
+       !
+       write(77,*) "cld_reliq"
+       write(77,*) cld_reliq(iCol,:)
+       !
+       write(77,*) "cld_iwp"
+       write(77,*) cld_iwp(iCol,:)
+       !
+       write(77,*) "cld_reice"
+       write(77,*) cld_reice(iCol,:)
+       !
+       write(77,*) "cld_rwp"
+       write(77,*) cld_rwp(iCol,:)
+       !
+       write(77,*) "cld_rerain"
+       write(77,*) cld_rerain(iCol,:)
+       !
+       write(77,*) "cld_swp"
+       write(77,*) cld_swp(iCol,:)
+       !
+       write(77,*) "cld_resnow"
+       write(77,*) cld_resnow(iCol,:)
+    enddo
 
   end subroutine GFS_rrtmgp_pre_run
 
   ! #########################################################################################
   ! SUBROUTINE GFS_rrtmgp_pre_finalize
   ! #########################################################################################
   subroutine GFS_rrtmgp_pre_finalize ()
+    close(77)
   end subroutine GFS_rrtmgp_pre_finalize
 
   ! #########################################################################################

diff --git a/physics/radlw_main.f b/physics/radlw_main.f
@@ -1014,6 +1014,7 @@ subroutine rrtmg_lw_run                                           &
 
         if ( lcf1 ) then
 
+          cldfrc = ceiling(cldfrc)
           call cldprop                                                  &
 !  ---  inputs:
      &     ( cldfrc,clwp,relw,ciwp,reiw,cda1,cda2,cda3,cda4,            &
@@ -1022,8 +1023,6 @@ subroutine rrtmg_lw_run                                           &
      &       cldfmc, taucld                                             &
      &     )
 
-          cldfmc = ceiling(cldfmc)
-
 !  --- ...  save computed layer cloud optical depth for output
 !           rrtm band-7 is apprx 10mu channel (or use spectral mean of bands 6-8)
 

diff --git a/physics/radsw_main.f b/physics/radsw_main.f
@@ -1077,6 +1077,7 @@ subroutine rrtmg_sw_run                                           &
 
         if (zcf1 > f_zero) then     ! cloudy sky column
 
+           cfrac = ceiling(cfrac)
           call cldprop                                                  &
 !  ---  inputs:
      &     ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4,     &
@@ -1085,8 +1086,6 @@ subroutine rrtmg_sw_run                                           &
      &       taucw, ssacw, asycw, cldfrc, cldfmc                        &
      &     )
 
-          cldfmc = ceiling(cldfmc)
-
 !  --- ...  save computed layer cloud optical depth for output
 !           rrtm band 10 is approx to the 0.55 mu spectrum