Merge pull request #116 from dalesteam/dev_radtimer

Dev radtimer and fix a reading outside array range in RRTMGP (result of which wasn't used anyway).
dalesteam · Sep 5, 2024 · 3617cc1 · 3617cc1
2 parents 6ce6c13 + 50b4851
commit 3617cc1
Showing 1 changed file with 16 additions and 1 deletion.
diff --git a/src/modradrte_rrtmgp.f90 b/src/modradrte_rrtmgp.f90
@@ -25,6 +25,7 @@
 module modradrte_rrtmgp
   use modraddata
   use modprecision, only : field_r
+  use modtimer
   ! RTE-RRTMGP modules
   use mo_optical_props,      only: ty_optical_props, &
                                    ty_optical_props_arry, ty_optical_props_1scl, ty_optical_props_2str
@@ -157,8 +158,10 @@ subroutine init_radrte_rrtmgp
     end if
 
     ! Set up pressure layer and interface values (pressures in SI units, i.e. Pa)
-    do k=1,nlay
+    do k=1,nlay-1
       layerP(:,k) = presf_input(k)*100.00
+    enddo
+    do k=1,nlay
       interfaceP(:,k) = presh_input(k)*100.00
     enddo
     layerP(:,nlay) = 0.5*presh_input(nlay)*100.00
@@ -342,12 +345,14 @@ subroutine radrte_rrtmgp
 
       if(rad_longw) then
         ! Compute optical properties and source
+        call timer_tic('modradrte_rrtmgp/lwgasoptics', 0)
         call stop_on_err(k_dist_lw%gas_optics(layerP, interfaceP, & ! p_lay, p_lev (in, Pa)
                                               layerT, tg_slice, & ! t_lay, t_sfc (in, K)
                                               gas_concs, & ! gas volume mixing ratios (in)
                                               atmos_lw, & ! Optical properties (inout)
                                               sources_lw, & ! Planck source (inout)
                                               tlev = interfaceT)) ! t_lev (optional input, K)
+        call timer_toc('modradrte_rrtmgp/lwgasoptics')
 
         ! Solve clear sky radiation transport if required
         if(doclearsky) then
@@ -359,19 +364,23 @@ subroutine radrte_rrtmgp
         endif
 
         ! Compute and add cloud properties
+        call timer_tic('modradrte_rrtmgp/lwcloudsoptics', 0)
         call stop_on_err(cloud_optics_lw%cloud_optics(LWP_slice, & ! cloud liquid water path (in, g/m2)
                                                       IWP_slice, & ! cloud ice water path (in, g/m2)
                                                       liquidRe, & ! cloud liquid particle effective size (in, microns)
                                                       iceRe, & ! cloud ice particle effective radius (in, microns)
                                                       clouds_lw)) ! cloud optical properties lw (inout)
         call stop_on_err(clouds_lw%increment(atmos_lw))
+        call timer_toc('modradrte_rrtmgp/lwcloudsoptics')
 
         ! Solve radiation transport
+        call timer_tic('modradrte_rrtmgp/lwrtesolve', 0)
         call stop_on_err(rte_lw(atmos_lw, & ! optical properties (in)
                                 top_at_1, & ! Is the top of the domain at index 1? (in)
                                 sources_lw, & ! source function (in)
                                 emis, & ! emissivity at surface (in)
                                 fluxes_lw)) ! fluxes (W/m2, inout)
+        call timer_toc('modradrte_rrtmgp/lwrtesolve')
       endif
 
       if(rad_shortw) then
@@ -381,11 +390,13 @@ subroutine radrte_rrtmgp
 
         if(sunUp) then
           ! Compute optical properties and incoming shortwave flux
+          call timer_tic('modradrte_rrtmgp/swgasoptics', 0)
           call stop_on_err(k_dist_sw%gas_optics(layerP, interfaceP, & ! p_lay, p_lev (in, Pa)
                                                 layerT, & ! t_lay (in, K)
                                                 gas_concs, & ! gas volume mixing ratios (in)
                                                 atmos_sw, & ! Optical properties (inout)
                                                 inc_sw_flux)) ! Incoming shortwave flux (inout)
+          call timer_toc('modradrte_rrtmgp/swgasoptics')
 
           ! Solve clear sky radiation transport if required
           if(doclearsky) then
@@ -398,21 +409,25 @@ subroutine radrte_rrtmgp
           endif
 
           ! Compute and add cloud properties
+          call timer_tic('modradrte_rrtmgp/swcloudsoptics', 0)
           call stop_on_err(cloud_optics_sw%cloud_optics(LWP_slice, & ! cloud liquid water path (in, g/m2)
                                                         IWP_slice, & ! cloud ice water path (in, g/m2)
                                                         liquidRe, & ! cloud liquid particle effective size (in, microns)
                                                         iceRe, & ! cloud ice particle effective radius (in, microns)
                                                         clouds_sw)) ! cloud optical properties sw (inout)
           call stop_on_err(clouds_sw%delta_scale())
           call stop_on_err(clouds_sw%increment(atmos_sw))
+          call timer_toc('modradrte_rrtmgp/swcloudsoptics')
 
           ! Solve radiation transport
+          call timer_tic('modradrte_rrtmgp/swrtesolve', 0)
           call stop_on_err(rte_sw(atmos_sw, & ! optical properties (in)
                                   top_at_1, & ! Is the top of the domain at index 1? (in)
                                   solarZenithAngleCos, & ! cosine of the solar zenith angle (in)
                                   inc_sw_flux, & ! solar incoming flux (in)
                                   sfc_alb_dir, sfc_alb_dif, & ! surface albedos, direct and diffuse (in)
                                   fluxes_sw)) ! fluxes (inout, W/m2)
+          call timer_toc('modradrte_rrtmgp/swrtesolve')
 
         endif